#!/usr/local/bin/perl
###############################################################################
#                                                                             #
# Password                                                                    #
# v1.0                                                                        #
# (c) 2000 Anatoli Klassen                                                    #
#                                                                             #
###############################################################################

use strict;
use vars;
use Crypt::Random qw( makerandom ); 

### Settings ##################################################################

my $root_name;                      # root directory for all files, by default the directory
                                    # with the script, must finish with slash (for UNIX)
                                    # or backslash (for Windows)
my $view_name = "password.html";    # file with template
my $output_format = "result is <strong><#output></strong>";

### Main Part #################################################################

# Global variables declaration

my $file_name;            # name of file with the script
my $script_name;          # name of the script without directory
my %data;                 # data from HTTP request
my $output;               # result random string

# Form name of files and directories

$file_name = __FILE__;
$script_name = $file_name;
$script_name =~ s|(.*/)||;
$script_name =~ s|(.*\\)||;

if (!defined($root_name)) {
  if ($file_name =~ m|\\|) {
    ($root_name) = ($file_name =~ m|(.*\\)|);
  }
  else {
    ($root_name) = ($file_name =~ m|(.*/)|);
  }
}

# Parse data

parse_data(\%data);

# Process

eval {
  my @letters;
  @letters = (@letters, 0..9)     if ($data{'use_digits'} ne "");
  @letters = (@letters, 'A'..'Z') if ($data{'use_big'}    ne "");
  @letters = (@letters, 'a'..'z') if ($data{'use_small'}  ne "");
  @letters = (@letters, '!', '$', '%', '&', '/', '(', ')', '=', '?', 
      '{', '[', ']', '}', '\\', '+', '*', '~', '#', ',', '.', '-', ';', ':', '_') 
    if ($data{'use_meta'}  ne "");

  my $exclude = $data{'exclude'};
  if($exclude ne "") {
    @letters = grep { (index $exclude, $_) == -1; } @letters;
  }

  my $n = $data{'number'};
  $n = 8 if (!defined($n));
  $n = 1000 if ($n > 1000);

  my $len = scalar(@letters);

  $output = "";
  if ($len > 0) {
    my $len2 = int(log($len)/log(2)) + 1;
    for (my $i = 0; $i < $n; $i++) {
      my $n2;
      do { $n2 = makerandom(Size=>$len2, Strength=>1, Uniform=>1); } while($n2 >= $len);
      $output .= $letters[$n2];
    }
  }
};

# Create HTML header

print "Content-type: text/html\nPragma: no-cache\n\n";

# Form and output the page

my $template_name;
my $template = "";

$template_name = $root_name . $view_name;

if (open (TEMPLATEFILE, "<$template_name")) {
  while (my $line = <TEMPLATEFILE>) {
    $template .= "$line";
  }
  close (TEMPLATEFILE);
}

if (!$template) {
  $template = "Internal server error.";
}

my $result;
$result = $output_format if ($output);

$template =~ s|<#main>|$result|gi;
$template =~ s|<#output>|$output|gi;
$template =~ s|<#scriptname>|$script_name|gi;
$template =~ s|<#filename>|$file_name|gi;

my ($use_digits, $use_big, $use_small, $use_meta, $exclude, $second_call, $number);

if ($data{'second_call'} ne '') {
  $use_digits = $data{'use_digits'} ? 'checked' : '';
  $use_big    = $data{'use_big'}    ? 'checked' : '';
  $use_small  = $data{'use_small'}  ? 'checked' : '';
  $use_meta   = $data{'use_meta'}   ? 'checked' : '';
  $exclude    = $data{'exclude'};
  $number     = $data{'number'};
}
else {
  $use_digits = 'checked';
  $use_big    = 'checked';
  $use_small  = 'checked';
  $use_meta   = '';
  $exclude    = 'lIO';
  $number     = 16;
}

$second_call = 1;

$template =~ s|<#number>|$number|gi;
$template =~ s|<#use_digits>|$use_digits|gi;
$template =~ s|<#use_big>|$use_big|gi;
$template =~ s|<#use_small>|$use_small|gi;
$template =~ s|<#use_meta>|$use_meta|gi;
$template =~ s|<#exclude>|$exclude|gi;
$template =~ s|<#second_call>|$second_call|gi;

print $template;

### Subroutines ###############################################################

# Parse input data.
#
# Input:  one reference to hash for result
# Output: none

sub parse_data
{
  my $input;
  my $name;
  my $value;
  my @pairs;
  my ($result) = shift @_;
  return if (!$result);

  if ($ENV{'REQUEST_METHOD'} eq "GET")
  {
    $input = $ENV{'QUERY_STRING'};
  }
  else {
    read(STDIN, $input, $ENV{'CONTENT_LENGTH'});
  }

  @pairs = split /&/, $input;

  foreach my $pair (@pairs) {
    ($name, $value) = split /=/, $pair;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $value =~ s/~!/ ~!/g;
    $value =~ s/\+/ /g;
    ${$result}{$name} = $value;
  }
}

# Lock file to avoid shared access. Wait until it is unlock.
#
# Input:  one file handle
# Output: none

sub lock_file
{
  my $handle = shift;
  return if (!$handle);
  until (flock($handle, 2)) {
    sleep .20;
  }
}

# Unlock file.
#
# Input:  one file handle
# Output: none

sub unlock_file
{
  my $handle = shift;
  return if (!$handle);
  flock($handle, 8);
}

# Substitute in given string symbols " < > & to their HTML equivalents.
# If second parameter is true then symbols ASCII 13 will convert to <br>.
#
# Input:  the string
#         is new lines allowed in the string (optional)
# Output: string without the symbols

sub secure_string
{
  my $string = shift @_;
  return $string if (!$string);
  my $new_lines = shift @_;

  $string =~ s/&/&amp\;/g;
  $string =~ s/"/&quot\;/g;
  $string =~ s/</&lt\;/g;
  $string =~ s/>/&gt\;/g;
  $string =~ s/\015/<br>/g if ($new_lines);
  $string =~ s/[\000-\037]/ /g;

  return $string;
}

__END__

### EOF #######################################################################