#!/usr/bin/perl -w

###
###	This hasn't been checked out much with "use strict".
###
###	mark indicates that FIF-required isn't working when they
###	use <script>.  This could be a version skew problem, as
###	he was running an older version (0.07 FillInForm2).  I
###	don't see it from the diff listing.
###

#
#	FillInForm
#
#	Fill in a form and re-present the results.
#
#	This is a simple program which takes the results of
#	a form, and presents the form again with all of the
#	fields filled in as specified.  This allows the page
#	to be printed.
#
#	You can optionally have the form fields checked for
#	some sort of validity (Perl regular expressions), and
#	if the form isn't valid, present the form again with
#	messages.
#
#	Finally, when the form is complete, you can specify an
#	email address to send the form variables to, or some
#	other form completion CGI program.
#
#	Dave Regan
#	regan@peak.org
#	http://cornvalley.peak.org/FillInForm
#	23 September 1997
#
#	The official source for this is on mordred.ao.com.
#

#
#	Ideas from Bob Richardson <bob@PEAK.ORG>:
#
#	1. Substitutions
#	
#	(Or can this be done already using FIF-RE?) - The ability to predefine a
#	substitution that is done on a form field.  This would allow, for
#	example, removal of control characters (tab, newline, etc.) from
#	TEXTAREA fields.
#	
#	2. Negative Regular Expression (FIF-NRE?)
#	
#	Cause an error if the regular expression returns a match.  This would
#	allow a form to search for keywords that should NOT be included, and
#	notify the user.  Applications include stripping potential foul language
#	to searching for common mistakes like putting "www." in what should be
#	an email address, or "@" in what should be a URL.
#	
#	3. Multi-Stage Input Collection
#	
#	For longer forms, it is sometimes better for the user to break things up
#	into stages, and then combine it all into one email at the end.  For
#	example, and "order form" could start off with name/address/phone, then
#	proceed to a page of item #'s, and then finally to a method of payment
#	page.  Or can this be achieved already by using hidden fields and doing
#	the right things with the .FIF files?
#	
#	4. Conditional URL branching
#	
#	This could be done in the .FIF (for security reasons) - based on the
#	value of a field, select which URL comes next.
#
#
#	Ideas from Mark Fisher: (mark@proaxis.com)
#	In the form tag you should change from this:
#	
#	  <FORM  action="/cgi-bin/FillInForm/~labquest/NBEA/taaudit.html" method=POST>
#	
#	to this:
#	
#	  <FORM  action="/cgi-bin/FillInForm" method=POST>
#	and use the variable:
#	
#	HTTP_REFERER: http://www.peak.org/~labquest/NBEA/tapinfo.html
#	
#	in place of the required "/~labquest/NBEA/taaudit.html" or better yet,
#	default to the HTTP_REFERER if no reference is provided - that way you can
#	specify if you need to.
#
#	The same is true for the log file.  A log entry filename with no path
#	information (simply scan for "/") should by default be append the
#	PATH_TRANSLATED info.
#	
#	PATH_TRANSLATED: /nfs/users/u2/l/labquest/public_html/NBEA/tapinfo.html

#
#	Things that don't work
#	----------------------
#
#	The code for <select> is a little fragile.  I cannot seem to
#	get a useful value out of the "multiple" attribute.  The labels
#	must all appear on the same line after the <option>.  This shouldn't
#	be a problem in practice.
#

use strict;

###
### QuestWriter header
###
### This initial block is required for QuestWriter implementations.
### If you are not running in this environment, then comment out
### this block.
###
#BEGIN {
#    $configlib  = "/home/iq/package/alpha/lib/config.pl";
#    $pathconfig = "/home/iq/package/alpha/config/path.cfg";
#    require $configlib;
#    %PATH_CONFIG = ReadConfig($pathconfig);
#}
#
#BEGIN {
#    push ( @INC, $PATH_CONFIG{'libdir'} );
#    require "CGI.pm";       # CGI.pm -- our CGI routines
#    require "data.pl";      # For doing sql stuff
#    require "env.pl";       # For getting environment stuff (class/user)
#}
use vars qw($QW);
#$QW     = 1;

###
###	Configuration
###
use vars qw($Version $Home @Sendmail);
$Version	= "FillInForm v0.18 29 Nov 2005";
$Home		= "http://www.armoredpenguin.com/FillInForm";
@Sendmail       = ( "/usr/lib/sendmail", "/usr/sbin/sendmail" );

use vars qw(@Names %Vars $WebPage);

###
###	Main program
###

    my($command, $fname);

    # We are going to be presenting output.  In general that output
    # will be based upon the host form, so there is no need to put
    # out titles and such.

    print "Content-type: text/html\n\n";
#PrintHash("Environment variables", \%ENV);

    # Read form information
    ParseFormVariables();
    AddEnvironment();
    AddConfigFile();
#PrintHash("Form variables:", \%Vars);

    # Find out the command to perform.
    # Email is performed before even reading the file, and just
    # sends the data to the named recipient.  This means that this
    # program can be used in a simple fashion.
    $command = $ENV{'QUERY_STRING'} || "";
    ProcessFinal($command) if ($command ne "");

    # Read the source web page
    $WebPage = ReadWebPage(ValidateName($ENV{'PATH_TRANSLATED'}, ".html"));
    #!!! Do this modification based upon something from the config file.
#    WebPage =~ s#(<\s*script(.|\n)*?>)(.|\n)*?(<\s*/script\s*>)#$1$4#mig;      # Remove java

    # Check for errors
    if (CheckAnyErrors($WebPage))
    	{
#print STDERR "There are errors\n";
	HandleErrors($WebPage);
	exit 0;
	}

    # Present the form without the form elements
    if (defined($Vars{'FIF-ReviewWork'}))
	{
	ProcessFinal($Vars{'FIF-NextAction'})
			if ($Vars{'FIF-ReviewWork'} =~ /^none$/i);

    	$fname = ValidateName(WebName($Vars{'FIF-ReviewWork'}), ".html");
	$WebPage = SubVariables(ReadWebPage($fname));
    	}
    PresentForm($WebPage);

    exit 0;


###
###	AddConfigFile
###
###	Find the configuration file associated with this html file.
###	The config file is the same name, except .html is replaced
###	with .fif.
###
###	The values in this file are added to the variable list,
###	and are thus available for processing.  These are added
###	after the form variables are processed, and will thus overwrite
###	any values which were specified in the form.
###
###	To discourage "experimenting", all variables of the
###	form "Mail-*" and "FIF-*" are deleted before these are
###	added.  Hmm.  Well, let the user pick some.
###
sub AddConfigFile
    {
    my($fname, $name, $value);

    # Remove unfortunate values
    for $name (keys %Vars)
    	{
    	next if ($name eq "Mail-From" || $name eq "Mail-Reply-To");
    	print STDERR "Delete $name\n" if ($name =~ /^(Mail|FIF)-/);
    	delete $Vars{$name} if ($name =~ /^(Mail|FIF)-/);
    	}

    # Read in the information from the file
    $fname = $ENV{'PATH_TRANSLATED'} || "no PATH_TRANSLATED in %ENV";
    Error("$0: $fname does not end in .html") if ($fname !~ /\.html/);
    $fname =~ s/\.html/.fif/;
    Error("$0: Cannot open $fname: $!") if (!open(CNF, "<$fname"));
    while (<CNF>)
    	{
    	chomp;
    	next if (/^\s*$/ || /^\s*#/);
	s/\s+$//;		# Remove trailing spaces
    	if (/^\s+(.*)/ && defined($name))
    	    {
    	    $Vars{$name} .= "\n$1";
    	    }
    	else
    	    {
	    ($name, $value) = split(/\s*:\s*/, $_, 2);
	    next unless defined($value);
	    $Vars{$name} = SubVariables($value);
	    push(@Names, $name);
	    }
    	}
    close CNF;
    }


###
###	AddEnvironment
###
###	Add the environment variables to the variables.
###	This will make them available to the program.
###
sub AddEnvironment
    {
    my($name);

    for $name (sort keys %ENV)
    	{
    	$Vars{$name} = $ENV{$name};
    	push(@Names, $name);
    	}
    $Vars{'__DATE__'} = scalar(localtime());
    push(@Names, '__DATE__');
    }


###
###	CheckAnyErrors
###
###	Make a pass through the form looking at the various checks.
###	If there are any errors return 1, else 0.
###
sub CheckAnyErrors
    {
    my($form) = @_;
    my($count, $item, $max, $min, $name, $re, @seg);

    @seg = split("<", $form);
    for ($count = 1; $count < scalar(@seg); $count++)
    	{
    	# Accumulate a full expression.  This means that we
    	# expect there to be the same number of "<" as ">", or
    	# we will allow more ">".  Note that this can be a problem
    	# if there are "<" or ">" in the text.
    	$item = "<$seg[$count]";
    	while (countkey($item, "<") > countkey($item, ">"))
    	    {
    	    last if (++$count >= scalar(@seg));
    	    $item .= "<$seg[$count]";
    	    }
	if ($item =~ /<!--\s*FIF-Required\s+(\S+)/s)
	    {
	    $name = $1;
	    return 1 if (!defined($Vars{$name}) || $Vars{$name} =~ /^$/);
	    }
	if ($item =~ /<!--\s*FIF-Range\s+(\S+)\s+(\S+)\s+(\S+)/s)
	    {
	    ($name, $min, $max) = ($1, $2, $3);
	    return 2 if (!defined($Vars{$name}) || $Vars{$name} =~ /^$/);
	    return 3 if ($Vars{$name} =~ /[^\d\.-]/);
	    return 4 if ($Vars{$name} < $min || $Vars{$name} > $max);
	    }
	if ($item =~ /<!--\s*FIF-RE\s+(\S+)\s+(.*)/s)
	    {
	    ($name, $re) = ($1, $2);
	    $re =~ s#/##;		# Simple r.e.  must be in //
	    $re =~ s#/.*##s;		#  and "/" must not be in the pattern
	    return 5 if (!defined($Vars{$name}) || $Vars{$name} =~ /^$/);
	    return 6 if ($Vars{$name} !~ /$re/);
	    }
    	}
    return 0;
    }


###
###	countkey
###
###	Count the number of key characters in the string.
###	There must be a better way to do this.
###
###	Don't pass a key of newline.
###
sub countkey
    {
    my($str, $key) = @_;

    $str =~ s/\n//mg;
    $str =~ s/[^$key]//mg;
    return length($str);
    }


###
###	DisplayFinalPage
###
###	Display the final page for the web user to see.
###
###	If the value FIF-AfterEmail is specified, it is emitted towards
###	the bottom of the page presented.  This is intended to be used
###	to make a link to the next page in the flow of control:
###	    <input name="FIF-AfterEmail" type="text" value=
###		"When done, hit <a href=index.html>continue</a> to resume">
###
sub DisplayFinalPage
    {
    my($title, $msg) = @_;
    my($fname, $key, $text);

    # Generate a page on the screen for the user to see
    if (defined($Vars{'FIF-WorkAccepted'}) &&
    		$Vars{'FIF-WorkAccepted'} ne "none")
    	{
    	$fname = ValidateName(WebName($Vars{'FIF-WorkAccepted'}), ".html");
	$text = SubVariables(ReadWebPage($fname));
	print $text;
    	}
    else
    	{
	print "<html><head><title>$title</title></head>
	       <body>
	       <h3><center>$title</center></h3>
	       $msg.
	       The values look like:
	       <table>";
	for $key (@Names)
	    {
	    next if ($key =~ /^Mail-/ || $key =~ /^FIF-/);
	    print "<tr><td>$key:</td><td>$Vars{$key}</td></tr>\n";
	    }
	print "</table><p>";
	print "$Vars{'FIF-AfterEmail'}<p>\n"
		    if (defined($Vars{'FIF-AfterEmail'}) &&
				$Vars{'FIF-AfterEmail'} ne "");
	print "<center>Sent by $Version<br>
	       <a href=\"$Home\">$Home</a></center></body></html>\n";
    	}
    }


###
###	Error
###
###	Something failed.  Say so and bail out.
###
sub Error
    {
    my($msg) = @_;

    print STDERR "FillInForm has an error of $msg\n";
    print "<html><head><title>Error</title></head>
    	   <body>
    	   <h3><center>Error</center></h3>
    	   There has been an error:<br>
    	   <code>$msg</code><br>
    	   Please fix the problem and resume.
    	   </body></html>\n";
#PrintHash("Environment variables", \%ENV);
    exit 0;
    }


###
###	ExplodeTag
###
###	Take an HTML tag and break it into fields.
###	Return a hash with the information.
###
sub ExplodeTag
    {
    my($tag) = @_;
    my(%attr, $name, $value);
    my($count) = 0;

#print STDERR "Parse $tag\n";

    $tag =~ s/^.*?<\s*([^\s>]+)\s*//m;
    $attr{'TagName'} = lc($1);
    $tag =~ s/>[^>]*$//;

#print STDERR "Tag name is \"$attr{'TagName'}\"\n";
    $attr{'type'} = "UNKNOWN";
    while ($tag !~ /^\s*$/)
    	{
#print STDERR "Looking at \"$tag\"\n";
	last if ($count++ > 20);		# pure paranoia
    	if ($tag =~ s/\s*(\S+)\s*=\s*(['"])(.*?)\2\s*//m)
    	    {
    	    $attr{lc($1)} = $3;
#print STDERR "1 Tag $1 is $3\n";
    	    }
    	elsif ($tag =~ s/\s*(\S+)\s*=(\S*)\s*//m)
    	    {
    	    $attr{lc($1)} = $2;
#print STDERR "2 Tag $1 is $2\n";
    	    }
    	elsif ($tag =~ s/\s*([^\s>]+)\s*//m)
    	    {
    	    $attr{lc($1)} = undef;
#print STDERR "3 Tag $1 exists\n";
    	    }
    	}

    return %attr;
    }


###
###	ImplodeTag
###
###	Create a new tag from a hash.
###
sub ImplodeTag
    {
    my(%attr) = @_;
    my($key, $tag);

    $tag = "<$attr{'TagName'}";
    for $key (sort keys(%attr))
    	{
    	next if ($key eq "TagName");
    	$tag .= " $key";
	$tag .= "=\"$attr{$key}\"" if (defined($attr{$key}));
    	}
#print STDERR "Reconstituted tag: $tag>\n";
    return "$tag>";
    }


###
###	FormatReport
###
###	Format a report to be sent via email or to a log file.
###
sub FormatReport
    {
    my($key, $text);

    if (defined($Vars{'FIF-EmailTemplate'}))
    	{
    	$fname = ValidateName(WebName($Vars{'FIF-EmailTemplate'}), ".email");
	$text = SubVariables(ReadWebPage($fname));
	$text =~ s/[ \t]+\n/\n/gm;
	print MAIL $text;
    	}
    else
    	{
	print MAIL "You have mail from FillInForm with the following\n";
	print MAIL "information:\n\n";
	for $key (@Names)
	    {
	    next if ($key =~ /^Mail-/ || $key =~ /^FIF-/);
	    print MAIL "\t$key: ", SubVariables($Vars{$key}), "\n";
	    }
	print MAIL "\n\n";
	print MAIL "Sent by $Version\n";
	print MAIL "        $Home\n";
    	}
    }


###
###	gettag
###
###	Take an item and split it into the HTML tag and parameters,
###	and the rest of the stuff.  Then convert all of the name=
###	to ensure that all of the values have quote marks.
###
###	There should be a better way of dealing with this as well.
###
sub gettag
    {
    my($item) = @_;
    my($attr, $c1, $count, $extra, @fields, $tag);
    my(@attributes) = ("name", "size", "type", "value");

    # Separate the tag from the text following the tag
#print STDERR "Separate $item into: ";
    $count = countkey($item, "<");	# This is what we need
    @fields = split(/>/, $item);
    $tag = $extra = "";
    for ($c1 = 0; $c1 < $count; $c1++)
    	{
    	$tag .= "$fields[$c1]>";
    	}
    for (; $c1 < scalar(@fields); $c1++)
    	{
    	$extra .= "$fields[$c1]>";
    	}
    $extra =~ s/>$//;

    # Fix up attribute values
    # This will fail if "attribute=" is within a value of an attribute.
    for $attr (@attributes)
    	{
    	# Remove spaces after an attribute name
    	$tag =~ s/\b($attr)[\s\n]*=[\s\n]*/$1=/mig;

    	# Add quotes around unquoted values
    	$tag =~ s/\b($attr=)([^'"][^\s>]*)/$1"$2"/mig;
    	}
#print STDERR "(tag $tag)(extra $extra)\n";
    return ($tag, $extra);
    }


###
###	HandleErrors
###
###	We know that one or more items has an error.
###	Present the old data with the user's current value
###	for each of the variables specified.
###	Also, insert error messages as appropriate.
###
sub HandleErrors
    {
    my($form) = @_;
    my(%attributes, $count, $extra, $item, $max, $min, $msg);
    my($name, $re, @seg, $selected, $tag);

    # Remove the previous textarea text.
    # This can be spoofed if /textarea is within a value.
    # I am not too concerned about this.
    $form =~ s#(<\s*textarea(.|\n)*?>)(.|\n)*?(<\s*/textarea\s*>)#$1$4#mig;

    $selected = "";
    @seg = split("<", $form);
    $form = $seg[0];
    for ($count = 1; $count < scalar(@seg); $count++)
    	{
    	# Accumulate a full expression.  This means that we
    	# expect there to be the same number of "<" as ">", or
    	# we will allow more ">".  Note that this can be a problem
    	# if there are "<" or ">" in the text.
    	$item = "<$seg[$count]";
    	while (countkey($item, "<") > countkey($item, ">"))
    	    {
    	    last if (++$count >= scalar(@seg));
    	    $item .= "<$seg[$count]";
    	    }
	if ($item =~ /<!--\s*FIF-ContainsErrors\s+(.*)-->/s)
	    {
	    # There were errors (that is why we are here).  So put out the
	    # error text.
	    $form .= $1;
	    }
	if ($item =~ /<!--\s*FIF-Required\s+(\S+)\s+(.*)-->/s)
	    {
	    ($name, $msg) = ($1, $2);
	    $form .= $msg if (!defined($Vars{$name}) || $Vars{$name} =~ /^$/);
	    }
	if ($item =~ /<!--\s*FIF-Range\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*)-->/s)
	    {
	    ($name, $min, $max, $msg) = ($1, $2, $3, $4);
	    if ((!defined($Vars{$name}) || $Vars{$name} =~ /^$/) ||
	        ($Vars{$name} =~ /[^\d\.-]/) ||
	        ($Vars{$name} < $min || $Vars{$name} > $max))
	        {
	        $form .= $msg;
	        }
	    }
	if ($item =~ /<!--\s*FIF-RE\s+(\S+)\s+(.*)-->/s)
	    {
	    ($name, $re) = ($1, $2);
	    $re =~ s#/##;		# Simple r.e.  must be in //
	    $re =~ s#(/.*)##s;		#  and "/" must not be in the pattern
	    ($msg = $1) =~ s#/##;
	    if ((!defined($Vars{$name}) || $Vars{$name} =~ /^$/) ||
	        ($Vars{$name} !~ /$re/))
	        {
	        $form .= $msg;
	        }
	    }
	($tag, $extra) = gettag($item);		# Make fields canonical

        # Set the current value of variables, and mark (as empty) variables
        # which should exist.
        %attributes = ExplodeTag($tag);
        if ($attributes{'TagName'} eq "input" &&
	    defined($attributes{'name'}) &&
	    $attributes{'type'} =~ /^(text|password|checkbox|radio)$/i)
            {
            $Vars{$attributes{'name'}} = ""
            	if (!defined($Vars{$attributes{'name'}}));
            if ($attributes{'type'} =~ /^(text|password)$/i)
            	{
		$attributes{'value'} = $Vars{$attributes{'name'}};
		}
	    elsif ($attributes{'type'} =~ /^(checkbox)$/i)
	    	{
	    	delete $attributes{'checked'};
	    	$attributes{'checked'} = undef
	    	    if ($Vars{$attributes{'name'}} ne "");
	    	}
	    elsif ($attributes{'type'} =~ /^(radio)$/i)
	    	{
	    	delete $attributes{'checked'};
	    	$attributes{'checked'} = undef
	    	    if ($Vars{$attributes{'name'}} eq $attributes{'value'});
	    	}
	    $tag = ImplodeTag(%attributes);
	    }
	if ($attributes{'TagName'} eq "textarea")
	    {
	    $tag .= $Vars{$attributes{'name'}};
	    }
	if ($attributes{'TagName'} eq "select")
	    {
	    if (defined($Vars{$attributes{'name'}}))
		{
		$selected = $Vars{$attributes{'name'}};
		}
	    else
		{
		print STDERR
		    "FillInForm: There is no 'name' attribute in '$tag'\n";
		}
	    }
	if ($attributes{'TagName'} eq "option")
	    {
	    delete($attributes{'selected'});
	    if (defined($attributes{'value'}))
	    	{
		$attributes{'selected'} = undef
			    if ($attributes{'value'} eq $selected);
		}
	    else
	    	{
	    	my($cmp) = $extra;
	    	$cmp =~ s/\n(.|\n)*//mi;
	    	$cmp =~ s/^\s*//;
	    	$cmp =~ s/\s*$//;
#print STDERR "Compare \"$cmp\" to \"$selected\"\n";
	    	$attributes{'selected'} = undef if ($cmp eq $selected);
	    	}
	    $tag = ImplodeTag(%attributes);
	    }
	$form .= "$tag$extra";
    	}
    print $form;
    }


###
###	OpenMail
###
###	Find out where sendmail is on this computer, and start up
###	the mailer.
###
sub OpenMail
    {
    my($sendmail);

    for $sendmail (@Sendmail)
    	{
    	if (-x $sendmail)
    	    {
    	    return if (open(MAIL, "| $sendmail -t"));
    	    Error("$0: Cannot open $sendmail\n");
    	    }
    	}

    Error("$0: Cannot find sendmail\n");
    }


###
###	ParseFormVariables
###
###	The variables from a CGI FORM come in on standard input.
###	Read this string, and break it up into the Vars associative
###	array.
###
sub ParseFormVariables
    {
    my($data, $item, $name, @tbl, $val);

    return if (($ENV{'REQUEST_METHOD'} || "") !~ /^POST$/i);
    $data = <STDIN>;
#    print STDERR "The raw data is $data<br>\n";
#    $data =~ s/query..=//g;
    $data =~ s/&*\s*$//;
    @tbl = split(/&/, $data);		# Vars separated by &
    for $item (@tbl)
    	{
    	# Process the variables.  Be careful to avoid removing needed characters.
    	chomp($item = unquote($item));
    	($name, $val) = split(/=/, $item, 2);
    	$val =~ s/"/'/g;		# Ugly hack
    	$Vars{$name} = $val;
    	push(@Names, $name);
    	}
    }


###
###	PresentForm
###
###	Take the original web page and redisplay it after replacing
###	all of the form elements with verbatim copies of the current
###	value.  This allows for a nice clean form suitable for printing.
###	Keep all of the original items as hidden fields.
###
###	It wouldn't surprise me if the parser can be confused.  If
###	you go out of your way to cause problems, you get what you
###	deserve.  Put the NAME and TYPE early, don't embed things
###	like "NAME=" inside of other attributes.
###
###	It is possible for the user to put stuff in a textarea that
###	won't live as a value in a hidden text variable.  Quotes and
###	comment characters come to mind.
###
###	This routine is really too long.
###
sub PresentForm
    {
    my($form) = @_;
    my(%attr, %attr2, $count, $extra, $foundaction, $item, $name);
    my($optionvalue, @seg, $tag, $value, $win);

    @seg = split("<", $form);
    $form = $seg[0];
    $foundaction = 0;
    for ($count = 1; $count < scalar(@seg); $count++)
    	{
    	# Accumulate a full expression.  This means that we
    	# expect there to be the same number of "<" as ">", or
    	# we will allow more ">".  Note that this can be a problem
    	# if there are "<" or ">" in the text.
    	$item = "<$seg[$count]";
    	while (countkey($item, "<") > countkey($item, ">"))
    	    {
    	    last if (++$count >= scalar(@seg));
    	    $item .= "<$seg[$count]";
    	    }
	$item = "$1$3$5" if ($item =~
	    /((.|\n)*?)<!--\s*FIF-AfterGeneration\s*((.|\n)*)-->((.|\n)*)/s);
#	$item = "<$1>" if ($item =~ /<!--\s*FIF-NextAction\s*((.|\n)*)-->/s);
	($tag, $extra) = gettag($item);		# Make fields canonical
	%attr = ExplodeTag($tag);
	if ($attr{'TagName'} eq "input" &&
	    defined($attr{'name'}) &&
	    defined($attr{'type'}) &&
	    $attr{'type'} =~ /^(text|password)$/i)
	    {
	    $Vars{$attr{'name'}} = "" if (!defined($Vars{$attr{'name'}}));
	    if ($attr{'type'} =~ /password/i)
	    	{
		$form .= "<i>" . ("*" x length($Vars{$attr{'name'}})) . "</i>";
		}
	    else
	    	{
		$form .= "<i>$Vars{$attr{'name'}}</i>";    # Display the current value
	    	}
	    $attr{'type'} = "hidden";
	    $attr{'value'} = $Vars{$attr{'name'}};
	    $tag = ImplodeTag(%attr);
	    }
	if ($attr{'TagName'} eq "input" &&
	    defined($attr{'name'}) &&
	    defined($attr{'type'}) &&
	    $attr{'type'} =~ /^(checkbox)$/i)
	    {
	    $Vars{$attr{'name'}} = "" if (!defined($Vars{$attr{'name'}}));
	    $form .= "<i>";
	    $form .= (defined($Vars{$attr{'name'}}) && $Vars{$attr{'name'}} ne "") ? "X" : "-";
	    $form .= "</i>";
	    delete $attr{'checked'};
	    $attr{'type'} = "hidden";
	    $attr{'value'} = $Vars{$attr{'name'}};
	    $tag = ImplodeTag(%attr);
	    }
	if ($attr{'TagName'} eq "input" &&
	    defined($attr{'name'}) &&
	    defined($attr{'type'}) &&
	    $attr{'type'} =~ /^(radio)$/i)
	    {
	    $Vars{$attr{'name'}} = "" if (!defined($Vars{$attr{'name'}}));
	    $value = $Vars{$attr{'name'}};
	    $value = "" if (!defined($value));
	    $form .= "<i>";
	    $win = 0;
	    if (defined($attr{'value'}))
	    	{
	    	$win = $attr{'value'} eq $value;
	    	}
	    else
	    	{
	    	$win = $extra eq $value;
	    	}
	    $form .= ($win) ? "X " : "- ";
	    $form .= "</i>";
	    delete $attr{'checked'};
	    $attr{'type'} = "hidden";
	    $attr{'value'} = $Vars{$attr{'name'}};
	    $tag = "";
	    $tag = ImplodeTag(%attr) if ($win);
	    }
	if ($attr{'TagName'} eq "textarea" && defined($attr{'name'}))
	    {
	    $attr2{'TagName'} = "input";
	    $attr2{'type'} = "hidden";
	    $attr2{'name'} = $attr{'name'};
	    ($attr2{'value'} = $Vars{$attr{'name'}}) =~ s/"/'/g;
#	    $extra =~ s/"/'/g;			# Not really sufficient
#	    $attr2{'value'} = $extra;
	    $extra = "<i>$attr2{'value'}</i>";  # Replace default value
	    $tag = ImplodeTag(%attr2);
	    }
	if ($attr{'TagName'} eq "/textarea" || $attr{'TagName'} eq "/select")
	    {
	    $tag = "";
	    }
	if ($attr{'TagName'} eq "select" && defined($attr{'name'}))
	    {
	    $attr2{'TagName'} = "input";
	    $attr2{'type'} = "hidden";
	    $attr2{'name'} = $attr{'name'};
	    $value = $Vars{$attr{'name'}};
	    $value = "" if (!defined($value));
	    $attr2{'value'} = $optionvalue = $value;
	    $tag = ImplodeTag(%attr2);
	    }
	if ($attr{'TagName'} eq "option")
	    {
	    if (defined($attr{'value'}))
	    	{
	    	$extra = "" unless $attr{'value'} eq $optionvalue;
	    	}
	    else
	    	{
		$extra =~ s/^(\s|\n)*//m;
		$extra =~ s/(\s|\n)*$//m;
	    	$extra = "" unless $extra eq $optionvalue;
	    	}
	    }
	if ($attr{'TagName'} eq "form")
	    {
#!!!	    undef $attr if ($foundaction++ != 0);	# What was this to do?
	    $attr{'action'} .= "?$Vars{'FIF-NextAction'}";
	    $tag = ImplodeTag(%attr);
	    }
	$form .= "$tag$extra";
    	}
    print $form;
    }


###
###     PrintHash
###
###     Print the contents of a hash.
###
sub PrintHash
    {
    my($name, $hash) = @_;
    my($key);

    print "$name:<br>\n";
    for $key (sort(keys(%$hash)))
        {
        print "$key = ", UnEntity($$hash{$key}), "<br>\n";
        }
    }


###
###	ProcessFinal
###
###	Process the final information.
###
sub ProcessFinal
    {
    my($cmd) = @_;

    if ($cmd =~ /mail/)
    	{
    	SendEmail($cmd);
    	}
    elsif ($cmd =~ /log/)
    	{
    	SendLog($cmd);
    	}
    }


###
###	ReadWebPage
###
###	The name of the original web page is passed in as
###	part of the form action.  Read in that page, and use
###	it as a base for future actions.  Return the information
###	as a single long string.
###
###	Note that somebody playing can cause this to read any file
###	in web space.  This really isn't all that interesting, as
###	those files can be read anyway.  We attempt to keep it
###	somewhat in check by requiring that the file to be read
###	be a *.html file.
###
sub ReadWebPage
    {
    my($fname) = @_;
    my($data);

#    Error("The source file must end in .html.") if ($fname !~ /\.html?$/i);
    Error("Cannot open $fname: $!") if (!open(DATA, "<$fname"));

    $data = "";
    while (<DATA>)
    	{
    	$data .= $_;
    	}
    close DATA;
    return $data;
    }


###
###	SendEmail
###
###	Send email to the intended recipient.
###
###	All of the variables in the form with the form:
###	    Mail-*
###	are email header lines.  For instance, the following might
###	be reasonable to have in your form:
###	    <input name="Mail-Subject" type="text" value="Trip plan">
###	    <input name="Mail-Reply-To" type="text" value="regan@ao.com">
###	    <input name="Mail-From" type="text" value="regan@ao.com">
###
###	Due to abuse considerations, the From and Reply-To fields are
###	the only mail header fields that can be set in the form.
###
###	In addition, variables of the form:
###	    FIF-*
###	are used in different ways to control FillInForm, and are
###	not sent to the user.
###
###	All other variables are alphabetized by symbol name and sent
###	to the user, and presented on the screen.
###
###	Note that there is no checking that any of the email addresses
###	look reasonable.
###
sub SendEmail
    {
    my($cmd) = @_;
    my($addr, $hdr, $key, $reply);

    $addr = $Vars{'Mail-To'};
    Error("$0: No value defined for Mail-To\n") if (!defined($addr));

    DisplayFinalPage("FillInForm sends email",
    		     "FillInForm has sent email to $addr");

    # Send mail to the intended recipient.
    OpenMail();

    # Use all of the "Mail-*" variables as mail headers.
    for $key (@Names)
	{
	next unless ($key =~ /^Mail-(.*)/);
	$hdr = $1;
	print MAIL "$hdr: $Vars{$key}\n";
	$reply = $Vars{$key} if ($hdr =~ /^from$/i && !defined($reply));
	$reply = "" if ($hdr =~ /^reply-to$/);
	}
    print MAIL "Reply-To: $reply\n" if (defined($reply) && $reply ne "");

    print MAIL "\n";		# Separate headers from body
    FormatReport();
    close MAIL;
    exit 0;
    }


###
###	SendLog
###
###	Send the results to the named file or directory named by FIF-LogName.
###	If the name is a directory, create a unique name.
###
###	The variables of the form Mail-* and FIF-* are not sent
###	through by default.
###
sub SendLog
    {
    my($cmd) = @_;
    my($addr, $count);

    $addr = $Vars{'FIF-LogName'};
    Error("$0: No value defined for FIF-LogName\n") if (!defined($addr));

    if (-d $addr)
    	{
    	for ($count = 0; -f "$addr/$count"; $count++)
    	    {
    	    }
    	$addr = "$addr/$count";
    	}
    Error("$0: Cannot open $addr: $!") if (!open(MAIL, ">>$addr"));
    flock(MAIL, 2);
    seek(MAIL, 0, 2);

    DisplayFinalPage("FillInForm logs data",
    		     "FillInForm has logged to $addr");
    FormatReport();
    close MAIL;
    exit 0;
    }


###
###	SubVariables
###
###	Introduce all of the variables into place.
###
sub SubVariables
    {
    my($text) = @_;
    my($class, $name, $sym, %user, $user, $val);

    # Substitute all of the variables in
    for $name (keys %Vars)
    	{
        $Vars{$name} = ($Vars{$name} =~ /(on|yes)/i) ? 'Yes' : 'No'
                if ($name =~ /YES_NO/);
    	$sym = "\\\$$name\\\$";
    	$val = $Vars{$name};
#    	$val =~ s/"/\&quot;/g;
    	$text =~ s/$sym/$val/g;
    	}

    if (defined($QW))
    	{
    	while ($text =~ /QW\s*\((.*)\)/)
    	    {
    	    ($name, $sym) = split(/\s*,\s*/, $1, 2);
#    	    print STDERR "QW with $name and $sym\n";
    	    ($class, $user) = GlobalVars();	# user not used
    	    %user = GetUser($class, $name);	# Take the specified user
    	    $text =~ s/QW\s*\((.*)\)/$user{$sym}/;
    	    }
    	}

    $text =~ s/\$[-\w]+YES_NO\$/No/sg;
    $text =~ s/\$[-\w]+\$//sg;
    return $text;
    }


###
###	UnEntity
###
###	Massage a string so that it will print.
###
sub UnEntity
    {
    my($text) = @_;

    $text =~ s/&/&amp;/g;
    $text =~ s/</&lt;/g;
    $text =~ s/>/&gt;/g;
    return $text;
    }


###
###	unquote
###
###	Unescape a CGI form variable.
###
sub unquote
    {
    my($raw) = @_;
    my($code, @pieces, $piece);

    $raw =~ s/\+/ /mg;
    @pieces = split(/%/, $raw);
    for ($piece = 1; $piece <= $#pieces; $piece++)
    	{
    	$pieces[$piece] =~ s/^%//;
    	$code = substr($pieces[$piece], 0, 2);
    	$code = hex($code);
    	$pieces[$piece] = sprintf("%c%s", $code, substr($pieces[$piece], 2));
    	}
    return join("", @pieces);
    }


###
###	ValidateName
###
###	Ensure that the filename is reasonable.
###
sub ValidateName
    {
    my($fname, $type) = @_;

    Error("$0: Cannot find $fname\n") if (! -f $fname);
    Error("$0: Filename <i>$fname</i> does not end in <i>$type</i>")
    					if ($fname !~ /$type$/);
    return $fname;
    }


###
###	WebName
###
###	Given a filename, turn it into a file name for reading.
###
sub WebName
    {
    my($fname) = @_;
    my($dir, $tail);

    1 while $fname =~ s#/\.\./#/#g;
    1 while $fname =~ s#^../##g;
    $fname =~ s#^/+##;
    if ($fname =~ m#^~([^/]+)(.*)#)
    	{
    	$fname = $2;
    	$dir = (getpwnam($1))[7];
	Error("$0: Cannot find home directory for $1") if (!defined($dir));
	$fname = "$dir/public_html/$fname";
    	}
    else
    	{
    	$fname = "$ENV{'DOCUMENT_ROOT'}/$fname";
    	}
    return $fname;
    }