#!/usr/bin/perl -wT
#!/usr/local/bin/taintperl
# (This program is designed to be securely run )
# (with Perl taint-checking in force.          )
# (The second directive is preferred for Perl 5)
# (for Perl 4 taint protection, use taintperl  )
# 
# guestnik - Forms processor for various web forms
#
$VERSION = '1.03';
($Prog = $0) =~ s:.*/::;
#
#         Required files:  guestnik.cfg   (Documentation in file)
#
# Mike Heins 
# Copyright 1995 Mike Heins and Internet Robotics - ALL RIGHTS RESERVED
#

########################################################################
########## Configurable variables ######################################
#
# The location of your sendmail binary

$SENDMAIL	= '/usr/lib/sendmail';

#
# The directory you want to put all configuration files in,
# can be defined in the environment variable GUESTNIK

$BASEDIR     = $ENV{'GUESTNIK'} || '';
$BASEDIR 	.= '/' if $BASEDIR;


#
# The guestnik configuration file.  Defaults to <progname>.cfg,
# where <progname> is the script name.
#

$CFGFILE	= "$BASEDIR$Prog.cfg";

#
## Also, make sure the first line of this script points
## to your PERL binary

########## Nothing else to change ######################################
########################################################################

# Make sure our path and field sep are secure
$ENV{'PATH'} = '/bin:/usr/bin';
$ENV{'IFS'} = ' ';

$SCRIPT = $ENV{'SCRIPT_NAME'};

# Read our configuration file
&read_config($CFGFILE);

#### Do standard HTTP stuff ####
&cgi_decode();

# Read our environment
&read_env;

# Check the form for validity and completeness, based on form type
# and our configuration
&check_form();

&send_the_mail;

&thank_the_user;

exit 0;

sub is_yes {
	return( defined($_[$[]) && ($_[$[] =~ /^[yYtT1]/));
}

sub is_no {
	return( !defined($_[$[]) || ($_[$[] =~ /^[nNfF0]/));
}

sub read_env {
	for(keys %GetInfo) {
		$GotInfo{$_} = $ENV{$_} || "blank";
	}
}

sub check_form {

	local($msg,$num,$sug,@errors);
	@errors = ();

	$Form = $FORM{'form_type'} || 'default';

	# Check if we are a legal form
	unless (defined $ValidForm{$Form}) {
		&errorbox("Not a valid form!", "Please contact the webmaster.\n");
	}

	# Check if we have a place to send it
	unless ($Destination{$Form}) {
		&errorbox("No place to send this form!", "Please contact the webmaster.\n");
	}

	# Make sure all required fields are filled in correctly
	foreach $field (@Required) {
		unless ( defined $FORM{$field} && $FORM{$field}) {
			if (defined $BlankError{$field}) {
				$msg = $BlankError{$field};
			}
			else {
				$msg = "$field: field blank\n";
			}
			push(@errors, $msg);
		}
		elsif (defined $Standards{$field} &&
			(! &check_field($field, $FORM{$field}, $Standards{$field}))
			) {
			if (defined $FormatError{$field} && $FormatError{$field}) {
				$msg = "$FormatError{$field}\n";
			}
			else {
				$msg = "$field: field in wrong format\n";
			}
			push(@errors, $msg);
		}
	}
	if($num = scalar(@errors)) {
		if($num == 1) {
			$msg = "We noticed something...\n";
			$sug = "\nPlease click <B>Back</B> and make a change.\n"
		}
		elsif($num == 2) {
			$msg = "We noticed a couple of things...\n",
			$sug = "\nPlease click <B>Back</B> and make the changes.\n"
		}
		else {
			$msg = "We noticed a few things...\n",
			$sug = "\nPlease click <B>Back</B> and make the changes.\n"
		}
		&errorbox(	"Need some more input!",
					$msg,
					@errors,
					$sug,
					"Thank You!"
				);
	}
}

sub send_the_mail {
	local($ampm,$mailto,$name,$reply,$subject);
	local($date,$day,$hour,$hr,$min,$mon,$time,$year);

	# Untaint the mailto address
	unless ( defined $Destination{$Form} ) {
		&errorbox("Configuration Error!", "Please contact the webmaster.");
	}
	$Destination{$Form} =~ /(.*)/;
	$mailto = $1;

	unless (defined $FORM{'mail_subject'} &&
		($subject = $FORM{'mail_subject'})) {
		$subject = "Input from $Form form";
	}

	unless (defined $FORM{'email'} && 
			($reply = $FORM{'email'}))  {
		$reply = "A_user_at_$ENV{'REMOTE_HOST'} ($ENV{'REMOTE_ADDR'})";
	}

	open (MAIL, "| $SENDMAIL -t -oi") ||
		die ("$SCRIPT: Can't open $SENDMAIL: $!\n");

	$name = " ($FORM{'name'})"
		if (defined $FORM{'name'} && $FORM{'name'});
	
	($min,$hr,$day,$mon,$year) = (localtime(time))[1..5];
	if($Config{'datestyle'} =~ /euro/i) {
		$date = sprintf("%02d/%02d/%d", $day, $mon + 1, $year);
	}
	else {
		$date = sprintf("%02d/%02d/%d", $mon + 1, $day, $year);
	}
	$ampm = $hr > 11 ? "PM" : "AM";
	$hour = $hr > 12 ? $hr - 12 : $hr;
	$time = sprintf("%d:%02d %s", $hour, $min, $ampm);

# Assuming we got here, all is well.
	print MAIL <<EOF ;
Reply-to: $reply$name
To: $mailto
Subject: $FORM{'mail_subject'}

-------------------------------------------------------------
Mailed form input processed by Guestnik V$VERSION
Date: $date   Time: $time
-------------------------------------------------------------
Remote Host:     $ENV{'REMOTE_HOST'}
Remote IP No:    $ENV{'REMOTE_ADDR'}
EOF

print MAIL "\nOther info we received that you asked for:\n"
	if scalar(keys %GetInfo);
for(sort keys %GetInfo) {
	if(defined $WhatInfo{$_}) {
		$msg = $WhatInfo{$_};
	}
	else {
		$msg = $_;
	}
	printf MAIL ("%30s: %s\n", $msg, $GotInfo{$_});
}
print MAIL <<EOF ;
_____________________________________________________________

          Form Title: $FORM{'title'}
_____________________________________________________________

EOF
	for (@FORM) {
		next if ($Config{'deleteblank'} && !$FORM{$_});
		next if (&is_yes($IgnoreOutput{$_}));
		printf MAIL ("%20s: %s\n", $_, $FORM{$_});
	}
	print MAIL "\n";
	if(scalar(@Errors)) {
		printf MAIL ("\n%50s\n", "THERE WERE PROCESSING ERRORS");
		for(@Errors) { print "$_\n" }
	}
	close (MAIL);

	if($?) {
		&errorbox("Mail Error!",
			"There was an unspecified error in forwarding the form.\n",
			"Please contact the webmaster.");
	}

	1;

}

sub thank_the_user {
	#### Now, redirect if "next_url" is included
	if (defined $FORM{'next_url'}) {
		print "Status: 302 Re-direct\n";
    	print "Location: $FORM{'next_url'}\n\n";
    	exit;
	}

	#### Output thankyou message ####

	if(defined $Thanks{$Form}) {
		&content_html;
		print $Thanks{$Form};
		print "\n";
		exit;
	}
	if(defined $Thanks{'generic'}) {
		&content_html;
		print $Thanks{'generic'};
		print "\n";
		exit;
	}
	# else
	&html_header("Thank You!");
	print qq|<H1>Form Sent. Thank You!</H1>\n|;
	print qq|<HR>\n|;
	print qq|The form has been sent.\n|;
	print qq|You can now return to <A HREF="$FORM{'previous_url'}">| .
		  qq|where you were</A>.\n|
	  if ($FORM{'previous_url'});
	print qq|<HR>\n|;
	&html_trailer($Config{'toolbar'});
	exit;

}

#####################################################################
#### SUBROUTINES ####################################################

sub errorbox {
    local($title,@message) = @_;
	&html_header($title);
	print "<H1>$title</H1>\n";
    for(@message) {
		s/\n/<BR>\n/g;
		print;
	}
	&html_trailer();
    exit;
}

sub cgi_decode {
	undef $FORM;
	unless (defined $ENV{'REQUEST_METHOD'}) {
		$FORM = '';
		#warn "Unrecognized request type";
		return undef;
	}
	if ($ENV{'REQUEST_METHOD'} eq "GET") {
		$FORM = $ENV{'QUERY_STRING'};
	}
	elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
		read(STDIN,$FORM,$ENV{'CONTENT_LENGTH'});
	} 
	elsif ($ENV{'REQUEST_METHOD'} eq "SHELL") {
		undef $/;
		$FORM = <>;
		chop($FORM);
		$/ = "\n";
	} 
	else {
		$FORM = '';
		warn "Unrecognized request type";
		return undef;
	}

  for (split(/&/,$FORM)) {
    s/\+/ /g;
    s/%(..)/pack("c",hex($1))/ge;
    ($key, $val) = split(/=/,$_,2);
	$key = "\L$key";
	if (defined $FORM{$key}) {
    	$FORM{$key} .= '\0';
	}
	else {
		push(@FORM,$key);
		$FORM{$key} = '';
	}
    $FORM{$key} .= $val;
  }
  return 1; 
}

sub read_config {

	local($file) = shift(@_);
	open(CONFIG, $file) 
		|| die "Couldn't read configuration file $file: $!\n";

	local($ref,$name,$found_one);
	local(*ary);

	%Config = ();
	local(%recognized) = (
					'blankerror',	'BlankError',	
					'destination',	'Destination',	
					'deleteblank',	'DeleteBlank',	
					'datestyle',	'DateStyle',
					'formaterror',	'FormatError',	
					'getinfo',		'GetInfo',		
					'ignoreoutput',	'IgnoreOutput',		
					'required',		'Required',		
					'standards',	'Standards',	
					'thanks',		'Thanks',		
					'validform',	'ValidForm',	
					'whatinfo',		'WhatInfo',		
					'debug',		'DEBUG',		
					);
	local(%arraytype) = (
					'BlankError',	'hash',
					'DateStyle',	'scalar',
					'DeleteBlank',	'scalar',
					'Destination',	'hash',
					'FormatError',	'hash',
					'FormatError',	'hash',
					'GetInfo',		'HASH',
					'IgnoreOutput',	'hash',
					'Required',		'array',
					'Standards',	'hash',
					'Thanks',		'hash',
					'ValidForm',	'hash',
					'WhatInfo',		'HASH',
					'DEBUG',		'scalar',
					);


	$lookahead = <CONFIG>;
	while(<CONFIG>) {
		unless (s/^\s+//) {
			$prev = $lookahead;
			$lookahead = $_;
			$_ = $prev;
		}
		else {
			$lookahead .= $_;
			next;
		}
		next unless /\S/ || eof(CONFIG);
		chop;
		s/^\s*(\w+)\s+(\w+)\s*//;
		$name = $1;
		$ref = $2;
		next unless $name;
		$val = &regularize($_);
		unless($type = $recognized{"\L$name"}) {
			warn "Unknown define in config file $file: $name";
		}
		elsif ($arraytype{$type} eq 'hash') {
			*ary = $type;
			$ary{"\L$ref"} = $val;
		}
		elsif ($arraytype{$type} eq 'HASH') {
			*ary = $type;
			$ary{$ref} = $val;
		}
		elsif ($arraytype{$type} eq 'array') {
			*ary = $type;
			$ref = "\L$ref";
			$ref = "$ref $val";
			$ref =~ s/^\s+//;
			$ref =~ s/\s+$//;
			push(@ary, split(/\s+/,$ref) );
		}
		elsif ($arraytype{$type} eq 'scalar') {
			undef *ary;
			$ref .= " $val" if $val;
			$Config{"\L$type"} = "$ref";
		}
		elsif ($arraytype{$type} eq 'SCALAR') {
			undef *ary;
			$ref .= " $val" if $val;
			$Config{$type} = "$ref";
		}
		else {
			die "Unrecognized type! This shouldn't happen.";
		}
	}
	close CONFIG;
	for (keys %Destination) {
		$found_one++;
		unless( /[-A-z0-9_ !.%]@?[-A-z0-9_ !.%]/ ) {
			warn <<EOF ;
Found invalid destination address for form type $_ in 
in config file: $Destination{$_}
EOF
			undef $Destination{$_};
			next;
		}
	}
	die "No valid email addresses" unless $found_one;
	unless (&is_yes($Config{'DEBUG'}) ) {
		*ary = '';
		return 1;
	}
	for(values %recognized) {
			if ($arraytype{$_} eq 'hash') {
				*ary = $_;
				print "%$_:\n";
				for(keys %ary) {
					print "\t$_: $ary{$_}\n";
				}
			}
			elsif ($arraytype{$_} eq 'array') {
				*ary = $_;
				next unless defined @ary;
			}
			elsif ($arraytype{$_} eq 'scalar') {
				next unless defined $Config{$_};
			}
			else {
				die "Unrecognized type $_! This shouldn't happen.";
			}
	}
	*ary = '';
}

sub regularize {
	for (@_) {
			s/[\\]\n//g;
			s/\n\s+/ /g;
			s/\s+$//g;
	}
	wantarray ? @_ : $_[0];
}

sub dontwarn {
	&dontwarn;
	&is_no;
	%ValidForm + @Required + %IgnoreOutput;
}

sub html_trailer {
	local($toolbar) = shift;

	print <<EOF ;
$toolbar
</body></html>
EOF
}

sub html_header {
	local($title) = $_[0];

	print <<EOF ;
Content-type: text/html

<HEAD><TITLE>
$title
</title></head>
<HTML><BODY>
EOF
}

sub content_html {
	print "Content-type: text/html\n\n";
}

sub check_field {

	local($field,$value,$standard) = @_;
	eval '/$standard/';
	if ($@) {
		push(@Errors,"$field standards error: $@");
		return 1;
	}
	else {
		return 1 if $value =~ /$standard/;
	}
	return 0;
}

__END__

=head1 NAME

guestnik - configurable guest book program

=head1 SYNOPSIS

   <FORM METHOD=[POST|GET] ACTION="http://SERVER_NAME/cgi-bin/guestnik"
                  ENCTYPE="x-applictation-www-urlencoded">

=head1 DESCRIPTION

The guestnik program accepts postings from various HTML forms.  It can
reside as several links to the same script, and read a different
configuration file for each link.  It is designed to be secure, using
no user-supplied text to produce email addresses, never calling
the UNIX/NT shell directly, and running with Perl taint checking.
It can be run by either Perl 4.036 or Perl 5.

It requires only one HTML form variable to work properly, I<form_type>,
which is normally set as a hidden field in the HTML form. The I<form_type>
is used as the basis for all configuration file settings, including
the address which the form output will be mailed to.  If it
is not set an error message will be displayed.

There are two optional variables which are used in the mail header. The
variable I<mail_subject> is used as the Subject: line for the mailed
message, and the variable I<title> is used in the message header as the
title of the form.  Omission of either of these is non-fatal, but means
that there will be no Subject line or Title display.

This is a valid guestnik form:

    <FORM METHOD=POST ACTION="/cgi-bin/guestnik">
    <INPUT TYPE=HIDDEN NAME="form_type"
       VALUE="sample">
    <INPUT TYPE=HIDDEN NAME="mail_subject"
       VALUE="Output of Sample Form">
    <INPUT TYPE=HIDDEN NAME="title"
       VALUE="Sample Form">
    Enter your name:<INPUT NAME="name">
    </FORM>

It will take the results of the variable and send mail to the location
defined by the destination setting in the configuration file.  If the
destination was defined to be userC<@>company.com, and the user input the
name "Mike Heins" in the form, the following mail (or something like it)
would be sent.

 Return-Path: http
 Date: Wed, 3 Jan 1996 11:33:06 -0500
 Reply-to: mikeh@iac.net
 To: user@company.com
 Subject: Output of Sample Form
 
 -------------------------------------------------------------
 Mailed form input processed by Guestnik V1.03
 Date: 01/03/96   Time: 11:33 AM
 -------------------------------------------------------------
 Remote Host:     localhost
 Remote IP No:    127.0.0.1
 
 Other info we received that you asked for:
      The browser email address: blank
              The script called: /cgi-bin/guestnik
 _____________________________________________________________
 
           Form Title: Sample Form
 _____________________________________________________________
 
                 name: Mike Heins

The standard header information that is sent with every form output
includes the date and time of submission, the version of the program
used to process it, the remote host/ip address of the submitter, and
any information asked for with a I<GetInfo> configuration file entry.  In
this example, the GetInfo entries include HTTP_FROM (the browser's idea
of the submitters email address) and the SCRIPT_NAME called.
Unfortunately, Netscape does not usually send the header needed for
HTTP_FROM, so the browser email address is often blank.

=head2 Options

None, other than those in the configuration file.

=head2 Configuration File Format

The configuration file is scanned at program startup.  There are three
variable types -- simple (scalar) variables, arrays, and hashes.  The
standard types are:
  
                BlankError        hash
                DateStyle         scalar
                DeleteBlank       scalar
                Destination       hash
                FormatError       hash
                GetInfo           hash
                IgnoreOutput      hash
                Required          array
                Standards         hash
                Thanks            hash
                ValidForm         hash
                WhatInfo          hash
                DEBUG             scalar
 
The configuration file entries are like this:

       Hash:     Name    key     value
       Array:    Name    value1  [value 2 ...]
       Scalar:   Name    value

An entry must be on the first space of the line -- no indenting is 
allowed.  If a line begins with a space (or tab), it is assumed to be
a continuation of the previous line.  Lines that are blank are skipped.
Lines beginning with a C<#> are comments, which are ignored.  The keys
and names are not case-sensitive.

The sample I<guestnik.cfg> file gives an example of the format as it
is used in practice.

=over 4

=item BlankError fieldname value

The message that you wish to send to the user if the field is a required
field, and is blank.  An example would be:

 blankerror name Your name was blank - please go
                 back and put it in the form.

=item DateStyle [Europe|US]


Controls the order in which the day and month are printed in
the date.  The default is US-style MM/DD/YY; if you need European
style DD/MM/YY put europe in the field.

=item DeleteBlank yes


If this parameter is defined, blank fields from the form will not 
be included in the emailed output.

=item Destination form <email address>

The place where the form is mailed to.  The form is the 'form_type'
specified in the HTML form.  Can contain any number of addresses.  An example:

 destination orderform  sales@company.com,accounting@company.com
 destination registry   marketing@company.com,webmaster

=item FormatError fieldname value

The message that you wish to send to the user
if the field is a required field, had a Standards entry, and did
not pass the Standards check. An example would be:

 formaterror phone Your phone number didn't have enough numbers in it.

=item GetInfo HTTP_VARIABLE yes

Fill this in if you wish to get information that may be captured by the
web server.  Examples of the common ones are in the sample configuration
file.  Here is one that gets the browser used in the transaction:

 GetInfo        HTTP_USER_AGENT     yes

=item IgnoreOutput field  yes

Set a field so that it will not be listed in the output section of the
mailed form. If the value is used in one of the header fields (such as
mail_subject), it will still be used for that purpose. It is not case
sensitive.  Example:

 IgnoreOutput        form_author     yes

The value of the HTML fill-out form variable named I<form_author> will not
be printed in the mail message.

=item Required field1 field2 [fieldn ...]

This is an array of field names which are required to be filled out before
the user is allowed to submit the form.  If there is a corresponding
Standards entry, the field will also be checked to conform to it.  If
the checks fail, the BlankError and FormatError entries will be checked
to see if they exist, and that message (or messages, in the case of
multiple failures) will be returned to the user along with a polite
request to go back and correct the problem.  A default message is
displayed if there are not BlankError or FormatError messages. Example:

  required name phone email company

This would require that the HTML form entries with the names of I<name>,
I<phone>, I<email>, and I<company> are not blank.  They may be checked
for format if a Standards entry is present.

=item Standards field  standard-spec

This is a format checking entry which takes the form of a Perl regular
expression.  A couple of standard entries (phone numbers and email
addresses) are supplied in the sample configuration file -- contact
the author if you need a special one and are not comfortable with 
regular expressions.  Here is the example phone number check:

    standards phone (\+?\d+[-/. ]\s*\d+|\d{7,})

Here is a standard that checks to see if a single-letter answer
is put in:

    standards question1  ^\s*[ABCDabcd]\s*$

A small script, checkstd, is supplied with the I<guestnik> distribution.
It will test the Standards entries in your configuration file for
syntax, as well as test it against entries that you want to try against
the standard.

=item ValidForm formname yes

This entry is checked to see if the hidden variable named form_type
matches.  If the form_type is not in the configuration file, the
user will not be allowed to submit the entry.  This is a 
check to make sure that the right form is being submitted, and
is used to check the email destination address.
B<IMPORTANT:> This must be filled in properly, and the form_type
I<must> match.  To do this, just make sure that you have this entry
in your guestnik.cfg:

    ValidForm  orderform  yes

And this as a line in your HTML form:

    <INPUT TYPE="hidden" NAME="form_type" VALUE="orderform">

=item Thanks formtype valid_html

This allows you to have a different thank-you message for each form
supported.  The I<valid_html> entry can be any valid HTML for display,
and can span multiple lines I<as long as each line begins with a space>.
Example:

    thanks orderform
      <H1>Thanks for the Order!<H1>
      <IMG SRC="/images/handshak.gif" ALT="Shake Hands Icon">
      <P>
      Thanks for placing an order with Internet Robotics.  We will
      be sending a confirmation by return email or FAX as soon
      as possible.<BR>
      <A HREF="/index.html">Go to Home Page</A>

B<IMPORTANT:> Note that the lines below the first begin with a space.

=item WhatInfo HTTP_VARIABLE description

Fill this in if you wish to have a description of the  information 
that may have been captured as a result of the GotInfo directive.  It will
be put in the mailed form output.  Example that matches the GetInfo
entry above:

     whatinfo   HTTP_USER_AGENT  The browser used by the customer

=back

=head2 Author

I<Mike Heins>, B<Internet Robotics>, mikehC<@>iac.net

=cut
:q
