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

use strict;
use vars;

### 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     = "crypt.html";       # file with template
my $output_format = "result for <strong><#input></strong> 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 $input;                # input from HTTP request
my $output;               # crypted input

# 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

my $salt = join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64];
$input  = $data{'input'};
$output = crypt($input, $salt) if ($input);
$input  = secure_string($input);

# 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 ($input && $output);

$template =~ s|<#main>|$result|gi;
$template =~ s|<#input>|$input|gi;
$template =~ s|<#output>|$output|gi;
$template =~ s/<#scriptname>/$script_name/gi;
$template =~ s/<#filename>/$file_name/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 #######################################################################