#!/usr/local/bin/perl
#
# Master Form V4
#   Version 4.7b
#
#   Version 4.0 based on Master Form version 1.0 (completed May 8, 2000) 
#                            through version 2.8 (completed March 9, 2003)
#                 and Master Form V3 version 3.0 (completed May 8, 2003) 
#                            through version 3.5m (completed February 1, 2005)
#   Version 4.0 completed February 4, 2005
#   Version 4.6 completed August 19, 2010
#   Version 4.7 completed February 14, 2017 (removed plug-in functionality)
#   Version 4.7a completed February 17, 2017 (CGI.pm single-value workaround)
#   Version 4.7b completed March 19, 2017 (allow "+" character in name part of email address)
#
# File MasterFormV4.cgi (file may be renamed if desired)
#    The form processor.
#
# Copyright 2000,2001 by William Bontrager.
# Copyright 2002-2010 by Bontrager Connection, LLC
# Copyright 2012,2017 by Will Bontrager Software LLC
#
# Programmer: Will Bontrager
# Website: http://www.willmaster.com/
#
# This custom version downloaded
#   from: Willmaster.com
#    for: websites4contractors.com
#     by: 127.0.0.1
#     at: 1627995706 -- Tuesday, August 3, 2021 at 13:01:46 GMT.
#
###########################################################

use strict; # May be commented out after testing.
use MasterFormV4Common;

sub Exit { ErrorHTML @_ if @_; goto BOTTOM; }

sub GetDateTime
{
	my @Month = split /\t/,$G{MonthList};
	my @Mon = split /\t/,$G{MonList};
	my @W = split /\t/,$G{WeekdayList};
	$Mine{SYSTEMTIME} = $Transfer{Time};
	my ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime($Mine{SYSTEMTIME});
	$year += 1900;
	$Mine{YEAR} = $year;
	$year = substr($year,-2);
	$Mine{YEAR2} = $year;
	$Mine{SHORTMONTH} = $Mon[$month];
	$Mine{LONGMONTH} = $Month[$month];
	$month++;
	$Mine{MONTH} = $month;
	my $s = $month; $s = "0$s" if length($month) < 2;
	$Mine{MONTH2} = $s;
	$Mine{DAY} = $mday;
	$s = $mday; $s = "0$s" if length($mday) < 2;
	$Mine{DAY2} = $s;
	$Mine{WEEKDAY} = $W[$wday];
	$Mine{HOUR} = $hour;
	$s = $hour; $s = "0$s" if length($hour) < 2;
	$Mine{HOUR2} = $s;
	$Mine{AMPM} = 'AM';
	if($hour >= 12) { $Mine{AMPM} = 'PM'; }
	if($hour > 12) { $hour -= 12; }
	$Mine{AMPMHOUR} = $hour;
	$s = $hour; $s = "0$s" if length($hour) < 2;
	$Mine{AMPMHOUR2} = $s;
	$Mine{MINUTE} = $min;
	$s = $min; $s = "0$s" if length($min) < 2;
	$Mine{MINUTE2} = $s;
	$Mine{SECOND} = $sec;
	$s = $sec; $s = "0$s" if length($sec) < 2;
	$Mine{SECOND2} = $s;
	($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = gmtime;
	$sec = $sec < 10 ? "0$sec" : "$sec";
	$min = $min < 10 ? "0$min" : "$min";
	$hour = $hour < 10 ? "0$hour" : "$hour";
	$year += 1900;
	my @weekday = qw(Sun Mon Tue Wed Thu Fri Sat);
	my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	$Mine{HEADER_TIME_STAMP} = "$weekday[$wday], $mday $month[$month] $year $hour:$min:$sec -0000";
} # sub GetDateTime



sub FlowTo
{
	my $page = '';
	($In{flowto},undef) =~ split /\t/,$In{flowto},2;
	FixNextPage(\$In{flowto},'name="flowto" value');
	RetrievePage($In{flowto},'Form field name="flowto"','',\$page);
	$page =~ s/<iframe[^>]*>//gsi;
	$page =~ s/<frame/<f_rame/ig;
	FixNextPage(\$page,'webpage');
	print "Content-Type: text/html\n\n$page" if $page =~ /\w/;
} # sub FlowTo



sub CheckRequiredFields
{
	my @e = ();
	if($In{requiredfields} =~ /\w/)
	{
		my @a = CommaTabSeparatedList($In{requiredfields});
		for(@a) { push @e,$_ unless $In{$_} =~ /\S/; }
	}
	if(@e)
	{
		my $plural = $#e > 0 ? 'fields are' : 'field is';
		my $s = qq~The following $plural required:<b><pre>~ . join("\n",@e) . '</pre></b>';
		@e = ();
		push @e,$s;
	}
	if($In{conditionalrequired} =~ /\w/)
	{
		my @chunk = split /\t/,$In{conditionalrequired};
		for my $chunk (@chunk)
		{
			my @te = ();
			my @list = CommaTabSeparatedList($chunk);
			next unless $#list > 0;
			my @check = split / *\:+ */,shift @list;
			my $more = 1;
			for my $check (@check)
			{
				$check =~ s/^\s*(.*?)\s*$/$1/s;
				if($check =~ /^(.*?) *\( *(.*?) *\) *$/)
				{
					my($n,$v) = ($1,$2);
					$more = 0 unless $In{$n} eq $v;
				}
				else { $more = 0 unless $In{$check} =~ /\S/; }
			}
			next unless $more;
			my $check = '<b>' . $check[0] . '</b>';
			if($#check == 1) { $check = '<b>' . $check[0] . '</b> and <b>' . $check[1] . '</b>'; }
			elsif($#check > 1)
			{
				for(@check) { $_ = "<b>$_</b>"; }
				$check[$#check] = "and $check[$#check]";
				$check = join ', ',@check;
			}
			for(@list) { push @te,$_ unless $In{$_} =~ /\S/; }
			next unless @te;
			my $plural1 = $#check > 0 ? 'fields have values,' : 'field has a value,';
			my $plural2 = $#te > 0 ? 'fields are' : 'field is';
			push @e,qq~When $check $plural1 the following $plural2 required:<b><pre>~ . join("\n",@te). '</pre></b>';
		}
	}
	if($In{emptyrequired} =~ /\w/)
	{
		my @chunk = split /\t/,$In{emptyrequired};
		for my $chunk (@chunk)
		{
			my @te = ();
			my @list = CommaTabSeparatedList($chunk);
			next unless $#list > 0;
			my @check = split / *\:+ */,shift @list;
			my $more = 1;
			for (@check)
			{
				s/^\s*(.*?)\s*$/$1/s;
				$more = 0 if $In{$_} =~ /\S/;
			}
			next unless $more;
			my $check = '<b>' . $check[0] . '</b>';
			if($#check == 1) { $check = '<b>' . $check[0] . '</b> and <b>' . $check[1] . '</b>'; }
			elsif($#check > 1)
			{
				for(@check) { $_ = "<b>$_</b>"; }
				$check[$#check] = "and $check[$#check]";
				$check = join ', ',@check;
			}
			for(@list) { push @te,$_ unless $In{$_} =~ /\S/; }
			next unless @te;
			my $plural1 = $#check > 0 ? 'fields have no values,' : 'field has no value,';
			my $plural2 = $#te > 0 ? 'fields are' : 'field is';
			push @e,qq~When $check $plural1 the following $plural2 required:<b><pre>~ . join("\n",@te). '</pre></b>';
		}
	}
	if($In{selectionminimum} =~ /\w/)
	{
		my @chunk = split /\t/,$In{selectionminimum};
		for my $chunk (@chunk)
		{
			my @list = CommaTabSeparatedList($chunk);
			for my $list (@list)
			{
				my @check = split / *\:+ */,$list;
				my $minimum = pop @check;
				my $howmany = 0;
				for(@check)
				{
					next unless $In{$_} =~ /\S/;
					my @ta = split /\t/,$In{$_};
					$howmany += @ta;
				}	
				next unless $howmany < $minimum;
				my $check = '<b>' . $check[0] . '</b>';
				if($#check == 1) { $check = '<b>' . $check[0] . '</b> and <b>' . $check[1] . '</b>'; }
				elsif($#check > 1)
				{
					for(@check) { $_ = "<b>$_</b>"; }
					$check[$#check] = "and $check[$#check]";
					$check = join ', ',@check;
				}
				my $plural1 = $#check > 0 ? 'Altogether, fields' : 'Field';
				my $plural2 = $minimum > 1 ? 's' : '';
				my $plural3 = $howmany == 1 ? 'field has' : 'fields have';
				push @e,qq~$plural1 $check must have at least $minimum item$plural2 containing a value. Currently, $howmany $plural3 a value.~;
			}
		}
	}
	if($In{selectionmaximum} =~ /\w/)
	{
		my @chunk = split /\t/,$In{selectionmaximum};
		for my $chunk (@chunk)
		{
			my @list = CommaTabSeparatedList($chunk);
			for my $list (@list)
			{
				my @check = split / *\:+ */,shift @list;
				my $maximum = pop @check;
				my $howmany = 0;
				for(@check)
				{
					next unless $In{$_} =~ /\S/;
					my @ta = split /\t/,$In{$_};
					$howmany += @ta;
				}
				next unless $howmany > $maximum;
				my $check = '<b>' . $check[0] . '</b>';
				if($#check == 1) { $check = '<b>' . $check[0] . '</b> and <b>' . $check[1] . '</b>'; }
				elsif($#check > 1)
				{
					for(@check) { $_ = "<b>$_</b>"; }
					$check[$#check] = "and $check[$#check]";
					$check = join ', ',@check;
				}
				my $plural1 = $#check > 0 ? 'Altogether, fields' : 'Field';
				my $plural2 = $maximum > 1 ? 's' : '';
				my $plural3 = $howmany == 1 ? 'field has' : 'fields have';
				push @e,qq~$plural1 $check must have no more than $maximum item$plural2 containing a value. Currently, $howmany $plural3 a value.~;
			}
		}
	}
	Exit(@e) if @e;
} # sub CheckRequiredFields



sub CheckEmailFields
{
	return 1 unless $In{emailfields};
	my %in = %In;
	for my $k ( keys %in)
	{
		$in{$k} =~ s/</&lt;/g;
		$in{$k} =~ s/>/&gt;/g;
	}
	my $s;
	my @a = CommaTabSeparatedList($in{emailfields});
	for(@a)
	{
		RemoveAllWhite \$in{$_};
		next unless $in{$_};
		$s .= "\n$_\t\($in{$_})" unless ValidEmail($in{$_});
	}
	Exit("The following fields contain an invalid email address:<b><pre>$s\n</pre></b>") if $s;
} # sub CheckEmailFields



sub SplitUploadPlaceholderTokens
{
	my $s = shift;
	my($m,$o,$n,$d) = ();
	return ($m,$o,$n,$d) unless $s =~ /\w/;
	$s =~ s/^[\,\s]*(.*?)[\,\s]*$/$1/;
	my @a = split /[\,\s]+/,$s;
	my($fm,$fo,$fn,$fd) = (0,0,0,0);
	for(@a)
	{
		if   (/^MAXSIZE\:/i  ) { s/^MAXSIZE\://i  ; ($fm,$fo,$fn,$fd) = (1,0,0,0); }
		elsif(/^ONLY\:/i     ) { s/^ONLY\://i     ; ($fm,$fo,$fn,$fd) = (0,1,0,0); }
		elsif(/^NEVER\:/i    ) { s/^NEVER\://i    ; ($fm,$fo,$fn,$fd) = (0,0,1,0); }
		elsif(/^DIRECTORY\:/i) { s/^DIRECTORY\://i; ($fm,$fo,$fn,$fd) = (0,0,0,1); }
		if   ($fm) { $m .= "$_\t" if $_; }
		elsif($fo) { $o .= "$_\t" if $_; }
		elsif($fn) { $n .= "$_\t" if $_; }
		elsif($fd) { $d .= "$_\t" if $_; }
	}
	chop($m,$o,$n,$d);
	if($m =~ /^([\.\d]+)/)
	{
		my $base = $1;
		$m =~ s/[\d\.\s]//g;
		if   ($m =~ /^k/i) { $base *= 1024                                    ; }
		elsif($m =~ /^m/i) { $base *=(1024 * 1024)                            ; }
		elsif($m =~ /^g/i) { $base *=(1024 * 1024 * 1024)                     ; }
		elsif($m =~ /^t/i) { $base *=(1024 * 1024 * 1024 * 1024)              ; }
		elsif($m =~ /^p/i) { $base *=(1024 * 1024 * 1024 * 1024 * 1024)       ; }
		elsif($m =~ /^e/i) { $base *=(1024 * 1024 * 1024 * 1024 * 1024 * 1024); }
		$m = $base;
	}
	return ($m,$o,$n,$d);
} # sub SplitUploadPlaceholderTokens



sub SplitFileName
{
	my $f = shift;
	my $e = '';
	if($f =~ /\./)
	{
		$f =~ /^(.*)\.(.*?)$/;
		($f,$e) = ($1,$2);
	}
	return($f,$e);
} # sub SplitFileName



sub MakeNameNotInHash
{
	my($fn,$hptr) = @_;
	my $ext = '';
	($fn,$ext) = SplitFileName($fn);
	$ext = ".$ext" if $ext =~ /\w/;
	my $counter = 2;
	while($$hptr{"$fn$counter$ext"}) { $counter++; }
	return "$fn$counter$ext";
} # sub MakeNameNotInHash



sub SendTheEmail
{
	my %filesAlreadyNamed = ();
	local *HeaderUandL = sub
	{
		my $s = shift;
		my @s = split /\-/,$s;
		for(@s) { $_ = lc $_; $_ = ucfirst $_; }
		$s = join '-',@s;
		return $s;
	};
	my @templatefiles = CommaTabSeparatedList($In{emailtemplate});
	my @conditionalAttachments = ();
	for my $item (split /\t+/,$In{conditionalattachment})
	{
		my @ta = CommaTabSeparatedList($item);
		push @conditionalAttachments,join "\t",@ta;
	}
	my $HijackEmail = '';
	for my $tpf (@templatefiles)
	{
		if($tpf =~ m!^https?://!i)
		{
			my $ttf = lc $tpf;
			$ttf =~ s!^https?://(?:www\.)?!!i;
			$ttf =~ s!^([^/:]+):\d+!$1!i; ###~~~###
			my $ttfc = lc $G{SelfDomain};
			$ttfc =~ s/^(?:www\.)//i;
			$ttfc = quotemeta $ttfc;
			unless($ttf =~ m!^$ttfc/!)
			{
				WebmasterNotification(5);
				next;
			}
		}
		my $page = '';
		RetrievePage($tpf,'Form field name="emailtemplate"','',\$page);
		next unless $page =~ /\w/;
		$page =~ s/^\s*//s;
		ConformLineEndings \$page;
		for my $item (@conditionalAttachments)
		{
			my @list = split /\t/,$item;
			if($list[0] eq $tpf)
			{
				shift @list;
				for(@list) { $page .= "\n[[ATTACH $_]]"; }
			}
		}
		my @P = split /\n/,$page;
		{
			my @p = @P;
			while($p[0] !~ /\w/) { shift @p; }
			$p[0] =~ s/^\s*//s;
			for my $line (@p)
			{
				last unless $line =~ /\w/;
				chomp $line;
				if($line =~ /(\<\!\-\-|\[\[)(\w+)(\-\-\>|\]\])/)
				{
					my($left,$placeholder,$right) = ($1,$2,$3);
					my $key = $placeholder;
					RemoveWhiteFromEnds \$key;
					if($In{$key})
					{
						RemoveWhiteFromEnds \$In{$key};
						$line =~ s/\Q$left$placeholder$right\E/$In{$key}/sig;
					}
				}
				if($line =~ /[\n\r]|(?:x|\%)0[ad]|\\0?1[25]/i)
				{
					my $env = '';
					for (sort keys %ENV) { $env .= "$_ = $ENV{$_}\n"; }
					$HijackEmail = <<OUTGOINGEMAIL;
-------------
$line
-------------
Possible Master Form hijacking attempt.

There may be an attempt at hijacking your Master Form V4 
installation $0

A copy of the email (which was not sent) is below, 
followed by additional information that may be of interest.
-----------------------------------------------------------
$page
===========================================================
OUTGOINGEMAIL
				} # if($line =~ /[\n\r]|(?:x|\%)0[ad]|\\0?1[25]/i)
			} # for my $line (@p)
		} # braces
		my %headers = ();
		while(my $hline = shift @P)
		{
			last unless $hline =~ /\w/;
			my($h,$c) = split /\: ?/,$hline,2;
			$headers{HeaderUandL($h)} = $c;
		}
		$headers{'Mime-Version'} = '1.0' unless $headers{'Mime-Version'} =~ /\w/;
		$headers{'Content-Type'} = qq~text/plain; charset="ISO-8859-1"~ unless $headers{'Content-Type'} =~ /\w/;
		my $BodyContentType = $headers{'Content-Type'};
		my $sendmailappend = '';
		if($headers{'Return-Path'} =~ /\w/ and $G{MailerLocation} =~ /sendmail/)
		{
			my $hs = $headers{'Return-Path'};
			for(keys %In) { $hs =~ s/(?:\<\!\-\-|\[\[)$_(?:\]\]|\-\-\>)/$In{$_}/sig; }
			$sendmailappend = $hs;
			$sendmailappend =~ s/[\<\>]//g;
			delete $headers{'Return-Path'};
			$page =~ s/Return-Path: ?.*?[\r\n]+//si;
		}
		while($page =~ /(<!--|\[\[)(\s*INSERT\s*)(.+)(\]\]|-->)/m)
		{
			my($front,$middle,$filename,$back) = ($1,$2,$3,$4);
			my $realfilename = $filename;
			for(keys %In) { $realfilename =~ s/\[\[\Q$_\E\]\]/$In{$_}/g; }
			$realfilename =~ s/^\s*(.*?)\s*/$1/s;
			my $p = '';
			RetrievePage($realfilename,"\"INSERT\" placeholder in email template file $tpf",'',\$p);
			$page =~ s/\Q$front$middle$filename$back\E/$p/;
		}
		while($page =~ /(<!--|\[\[)(\s*ATTACH\s*)(.+)(\]\]|-->)/m)
		{
			my($front,$middle,$filename,$back) = ($1,$2,$3,$4);
			my $realfilename = $filename;
			for(keys %In) { $realfilename =~ s/\[\[\Q$_\E\]\]/$In{$_}/g; }
			$realfilename =~ s/^\s*(.*?)\s*/$1/s;
			$page =~ s/\Q$front$middle$filename$back\E/\(\[\~\~\[\(ATTACH $realfilename\)\]\~\~\]\)/;
		}
		@P = ();
		my @ee = ();
		my $hasattachment = 0;
		while($page =~ m/(?:\<\!\-\-|\[\[)([^\>\]]+?)\bUPLOAD(?:ED)?\b(.*?)(?:\]\]|\-\-\>)/)
		{
			my($a1,$b1) = ($1,$2);
			my $line = "$a1 $b1";
			$line =~ s/^[\s\,]*(.*?)[\s\,]*$/$1/s;
			my @a = split /[\s\,]+/,$line;
			unless($Uploaded{$a[0]})
			{
				$page =~ s!(?:\<\!\-\-|\[\[)${a1}UPLOAD(?:ED)?$b1(?:\]\]|\-\-\>)!!sg;
				next;
			}
			my($fieldName,$fileName,$storedfilename) = split /\t/,$Uploaded{$a[0]};
			my $ext = $fileName;
			$ext =~ s/^.*?(\.[^\.]+)$/$1/;
			my @e = ();
			my $size = -s $storedfilename;
			push @e,qq~Regarding file $fileName (uploaded via form field name="$fieldName") did not arrive or it was an empty file.~ if $size < 1;
			unless(@e)
			{
				my($maxsize,$only,$never,$directory) = SplitUploadPlaceholderTokens($line);
				push @e,qq~Maximum file size for $fileName (uploaded via form field name="$fieldName") is specified as $maxsize bytes. $fileName is too large at $size bytes.~ if $maxsize > 0 and $maxsize < $size;
				if($only =~ /\S/)
				{
					$only = lc $only;
					my @ta = split /\t/,$only;
					my %h = ();
					for(@ta)
					{
						$_ = ".$_" unless /\./;
						$h{$_} = 1;
					}
					push @e,qq~Regarding file $fileName (uploaded via form field name="$fieldName"), the file name extension $ext is not on the \"ONLY\" list.~ unless $h{lc($ext)};
				}
				if($never =~ /\S/)
				{
					$never = lc $never;
					my @ta = split /\t/,$never;
					my %h = ();
					for(@ta)
					{
						$_ = ".$_" unless /\./;
						$h{$_} = 1;
					}
					push @e,qq~Regarding file $fileName (uploaded via form field name="$fieldName"), the file name extension $ext is on the \"NEVER\" list.~ if $h{lc($ext)};
				}
			} # unless (@e)
			my $rplcemnt = '([~~[(ATTACH ...' . $fileName . '...)]~~])';
			$rplcemnt = "\n[" . join(" \n ",@e) . ']' if @e;
			$page =~ s!(?:\<\!\-\-|\[\[)${a1}UPLOAD(?:ED)?$b1(?:\]\]|\-\-\>)!$rplcemnt!sig;
			$hasattachment++;
		} # while($page =~ m/(?:\<\!\-\-|\[\[)([^\>\]]+?)UPLOAD(?:ED)?(.*?)(?:\]\]|\-\-\>)/i)
		my $Divider = '';
		my $ts = '';
		if($page =~ /\(\[\~\~\[\(.*?\)\]\~\~\]\)/)
		{
			$ts = $Transfer{Time};
			$ts .= reverse $ts;
			$Divider = "MFRM_-${ts}-_MRFM";
			$ts = "--$Divider\nContent-Type: $headers{'Content-Type'}\n\n";
			$headers{'Content-Type'} = qq~multipart/mixed; boundary="$Divider"~;
		}
		if($ts)
		{
			my $s = '';
			for(keys %headers) { $s .= "${_}: $headers{$_}\n"; }
			(undef,$page) = split /\n\n/,$page,2;
			$page = "$s\n$ts$page";
		}
		FixNextPage \$page;
		my %attachThis = ();
		while($page =~ s/\(\[\~\~\[\(ATTACH\s(.*?)\)\]\~\~\]\)//)
		{
			my $filename = $1;
			if($filename =~ s/^\.\.\.(.*?)\.\.\.$/$1/)
			{
				for(keys %Uploaded)
				{
					my($fieldName,$fileName,$storedfilename) = split /\t/,$Uploaded{$_};
					$fileName =~ s!^.*/!!;
					if($filename eq $fileName)
					{
						$attachThis{$fileName} = $storedfilename;
						last;
					}
				}
			}
			else
			{
				my $fn = $filename;
				$fn =~ s!/*$!!;
				$fn =~ s!^.*/!!;
				$fn = 'T' . $Transfer{Time} . 'T' unless $fn;
				$attachThis{$fn} = $filename;
			}
		} # while($page =~ s/\(\[\~\~\[\(ATTACH\s(.*?)\)\]\~\~\]\)//)
		if($HijackEmail =~ /\w/)
		{
			WebmasterNotice $HijackEmail,'ishijack';
			return;
		}
		else { SendMail \$page,$sendmailappend,\%attachThis,$Divider; }
	} # for my $tpf (@templatefiles)
} # sub SendTheEmail



sub StoreUploadedFiles
{
	return unless $In{uploadedfilesaveinfo} =~ /\w/;
	my $page = '';
	RetrievePage($In{uploadedfilesaveinfo},'Form field name="uploadedfilesaveinfo"','',\$page);
	ConformLineEndings \$page;
	$page =~ s/(\]\]|\-\-\>).*?(\<\!\-\-|\[\[)/\n/sg;
	$page =~ s/^[^(\]\]|\-\-\>)]*(\<\!\-\-|\[\[)//s;
	$page =~ s/(\]\]|\-\-\>)[^(\]\]|\-\-\>)]*$//s;
	return unless $page =~ /\w/;
	my @lines = split /\n+/,$page;
	$page = '';
	my @ee = ();
#$Uploaded{fieldname} = "fieldname\tfilehandle\tstoredfilename"; }
#my $which;
#file1name UPLOAD MAXSIZE: 1k DIRECTORY: uploads
#file2name UPLOAD DIRECTORY: uploads
	for my $line (@lines)
	{
		next unless $line =~ s/\bUPLOAD(?:ED)?\b//;
		$line =~ s/^[\s\,]*(.*?)[\s\,]*$/$1/s;
		my @a = split /[\s\,]+/,$line;
		next unless $Uploaded{$a[0]};
		my($fieldName,$fileName,$storedfilename) = split /\t/,$Uploaded{$a[0]};
		$fileName =~ s!^.*/!!;
		my $size = -s $storedfilename;
		my $ext = $fileName;
		$ext =~ s/^.*?(\.[^\.]+)$/$1/;
		my @e = ();
		push @e,qq~Regarding file $fileName (uploaded via form field name="$fieldName") did not arrive or it was an empty file.~ if $size < 1;
		if(@e)
		{
			push @ee,@e;
			next;
		}
		my($maxsize,$only,$never,$directory) = SplitUploadPlaceholderTokens($line);
		push @e,qq~Maximum file size for $fileName (uploaded via form field name="$fieldName") is specified as $maxsize bytes. $fileName is too large at $size bytes.~ if $maxsize > 0 and $maxsize < $size;
		if($only =~ /\S/)
		{
			$only = lc $only;
			my @ta = split /\t/,$only;
			my %h = ();
			for(@ta)
			{
				$_ = ".$_" unless /\./;
				$h{$_} = 1;
			}
			push @e,qq~Regarding file $fileName (uploaded via form field name="$fieldName"), the file name extension $ext is not on the \"ONLY\" list.~ unless $h{lc($ext)};
		}
		if($never =~ /\S/)
		{
			$never = lc $never;
			my @ta = split /\t/,$never;
			my %h = ();
			for(@ta)
			{
				$_ = ".$_" unless /\./;
				$h{$_} = 1;
			}
			push @e,qq~Regarding file $fileName (uploaded via form field name="$fieldName"), the file name extension $ext is on the \"NEVER\" list.~ if $h{lc($ext)};
		}
		if(@e)
		{
			push @ee,@e;
			next;
		}
		my $dir = $directory =~ /\w/ ? $directory : '.';
		my %filesAlreadyNamed = ();
		$dir =~ s!^$ENV{DOCUMENT_ROOT}!!;
		if($dir ne '.' and (! -e $dir))
		{
			my $okay = '';
			if($dir =~ m!^/!) { $okay = MakeDirectory $dir; }
			else { $okay = MakeDirectory $Transfer{ThisDirectory},$dir; }
			unless($okay)
			{
				push @ee,<<NOTICE;
Unable to create directory $dir for writing file 
$fileName (uploaded via form field name="$fieldName")

The directory may need to be created manually.

If file $fileName isn't then created in the directory, try these 
$dir directory permissions, in order, using the form 
between each for testing:
		755
			766
				777
NOTICE
				next;
			} # unless($okay)
		} # if($dir ne '.' and (! -e $dir))
		$dir = "$ENV{DOCUMENT_ROOT}$dir" if $dir =~ m!^/!;
		unless(opendir(D,$dir))
		{
			push @ee,qq~Unable to open directory "$dir" to obtain a directory listing. File "$fileName" (uploaded via form field name="$fieldName") was not saved.~;
			next;
		}
		my @d = readdir D;
		closedir D;
		for(@d) { $filesAlreadyNamed{$_} = 1; }
		if($filesAlreadyNamed{$fileName})
		{
			$fileName = MakeNameNotInHash($fileName,\%filesAlreadyNamed);
			$In{$fieldName} = $fileName;
		}
		$filesAlreadyNamed{$fileName} = 1;
		$fileName = "${directory}/$fileName" if $directory =~ /\w/;
		SilentFail unless FileWhiteListed($fileName,'fileName');
		unless(open Wment,">$fileName")
		{
			push @ee,qq~Unable to open "$fileName" (uploaded via form field name="$fieldName") for writing~;
			next;
		}
		# binmode Wment; ### for windows machines only
		open Rment,"<$storedfilename";
		# binmode Rment; ### for windows machines only
		my $buffer = '';
		while(read Rment,$buffer,1024) { print Wment $buffer; }
		close Wment;
		close Rment;
	}
	if(@ee)
	{
		for(@ee) { $_ = "     ~~ $_"; }
		WebmasterNotice 'When attempting to store one or more uploaded files on the server:',@ee;
		Exit q~There was a problem storing an uploaded file on the server. An email with specifics has been sent to the webmaster.~;
	}
} # sub StoreUploadedFiles


sub AppendToFile
{
	my($infiletemplate,$indbfile) = @_;
	FixNextPage \$indbfile;
	my $page = '';
	trail(12);
	RetrievePage($infiletemplate,'Form field name="dbfile"','',\$page);
	ConformLineEndings \$page;
	local *initCheck = sub 
	{
		my $pageptr = shift;
		return '' unless $$pageptr =~ s/^\s*(?:\*+|\[\[) ?INITIALIZE[_ ]?DATABASE[_ ]?WITH[_ ]?FIELD[_ ]?NAMES ?(?:\]\]|\*+) *\n?//is;
		my $s = $$pageptr;
		$s =~ s/\[\[//g;
		$s =~ s/\]\]//g;
		$s =~ s/\s*$//s;
		$s .= "\n";
		return $s;
	};
	local *overwriteCheck = sub 
	{
		my $pageptr = shift;
		return $$pageptr =~ s/^\s*\*+OVERWRITE[ _]?FILE\*+ *\n?//is;
	};
	my $initP = initCheck(\$page); # Before and after overwrite check to allow either one to be first line.
	overwriteCheck(\$initP) if $initP;
	my $overwritefile = overwriteCheck(\$page);
	if($overwritefile and $infiletemplate =~ m!^https?://!i)
	{
		my $ttf = lc $infiletemplate;
		$ttf =~ s!^https?://(?:www\.)?!!;
		$ttf =~ s!^([^/:]+):\d+!$1!i; ###~~~###
		my $ttfc = lc $G{SelfDomain};
		$ttfc =~ s/^(?:www\.)//;
		$ttfc = quotemeta $ttfc;
		unless($ttf =~ m!^$ttfc/!)
		{
			my $notice = <<NOTICE;
This is pertaining to the database template file with location 
specified as: $infiletemplate

It is okay to use an absolute URL to a location on a different 
domain for a database template file -- UNLESS the template has 
an overwrite directive on the first line.

When there is an overwrite directive in the database template file, 
the template must be located on domain $G{SelfDomain}'s server.
NOTICE
			WebmasterNotice $notice;
			Exit q~Inappropriate location for database template file.~,q~A message with more information has been sent to the webmaster's notification email address.~;
		}
	}
	$initP = initCheck(\$page) unless $initP; # Before and after overwrite check to allow either one to be first line.
	my %in = %In;
	if($In{flattenfields} =~ /\w/)
	{
		my @flattenfields = CommaTabSeparatedList $In{flattenfields};
		my $replacement = length($In{flattenreplacement}) > 0 ? $In{flattenreplacement} : '<br />';
		$replacement =~ s/^\s*null\s*$//si;
		$replacement =~ s/\\n/\n/gs;
		$replacement =~ s/\\t/\t/gs;
		$replacement =~ s/chr\((\d+)\)/chr($1)/ge;
		for(@flattenfields)
		{
			ConformLineEndings \$In{$_};
			$In{$_} =~ s!\n!$replacement!gs;
		}
	}
	$page =~ /^\s*(.)/s;
	if($1 eq '"')
	{
		$page =~ /(.)\s*$/s;
		if($1 eq '"')
		{
			for(keys %In) { $In{$_} =~ s/"/""/g;  }
###-###		for(keys %In) { $In{$_} =~ s!\,!\\\,!g; }
		}
	}
	FixNextPage \$page,'databasefile';
	%In = %in;
	WriteFile $indbfile,$overwritefile,\$initP,\$page;
} # sub AppendToFile



sub UpdateDatabases
{
	return unless $In{filetemplate} =~ /\w/ or $In{dbfile} =~ /\w/;
	unless($In{filetemplate} =~ /\w/ and $In{dbfile} =~ /\w/)
	{
		WebmasterNotification(2);
		return;
	}
	my @filetemplate = CommaTabSeparatedList $In{filetemplate};
	my @dbfile = CommaTabSeparatedList $In{dbfile};
	if($#filetemplate != $#dbfile)
	{
		WebmasterNotification(4);
		return;
	}
	for my $indice (0..$#filetemplate)
	{
		last if $In{exitnow};
		AppendToFile $filetemplate[$indice],$dbfile[$indice];
	}
} # sub UpdateDatabases



sub WebmasterNotification
{
	my($which,@message) = @_;
	my($e,$we) = ();
	if($which == 1)
	{
		$e = <<EEEE;
<p>
In your form, the two hidden fields name=&quot;filetemplate&quot; and name=&quot;dbfile&quot; 
both have the same value.
</p>
<p>
Hidden field name=&quot;filetemplate&quot; is used to specify the template that 
Master Form V4 shall use when updating the database file. And name=&quot;dbfile&quot; is 
used to specify the database file itself.
</p>
<p>
(If both name=&quot;filetemplate&quot; and name=&quot;dbfile&quot; were to contain the same value, 
Master Form V4 would use the database file as the template and append the result 
to the bottom of the template file, thinking it's the database file &#151; 
which would double the size of the template/database file every time Master Form V4 was used.
</p>
<p>
Please assign hidden field name=&quot;filetemplate&quot; a value different 
than the value assigned to hidden field name=&quot;dbfile&quot;
</p>
EEEE
		$we = <<EEEE;
In your form, the two hidden fields name=&quot;filetemplate&quot; and name=&quot;dbfile&quot; 
both have the same value.

Hidden field name=&quot;filetemplate&quot; is used to specify the template that 
Master Form V4 shall use when updating the database file. And name=&quot;dbfile&quot; is 
used to specify the database file itself.

(If both name=&quot;filetemplate&quot; and name=&quot;dbfile&quot; were to contain the same value, 
Master Form V4 would use the database file as the template and append the result 
to the bottom of the template file, thinking it's the database file &#151; 
which would double the size of the template/database file every time Master Form V4 was used.

Please assign hidden field name=&quot;filetemplate&quot; a value different 
than the value assigned to hidden field name=&quot;dbfile&quot;
EEEE
	}
	elsif($which == 2)
	{
		$e = <<EEEE;
<p>
When you'll have Master Form V4 update a database, two hidden form fields are required, 
name="filetemplate" and name="dbfile"
</p>
<ol>
<li>
<p>name="filetemplate" &#151;<br>
This specifies the URL or server location of the template Master Form V4 will use when creating your database 
and/or appending a record thereto. The template is used as a guide to format the data 
to be stored in the database.
</p>
</li>
<li>
<p>name="dbfile" &#151;<br>
This specifies the server location of the database itself, the file that will be 
updated after the data has been formatted according to the template.
</p>
</li>
</ol>
</p>
EEEE
		$we = <<EEEE;
When you'll have Master Form V4 update a database, two hidden form fields are required, 
name="filetemplate" and name="dbfile"

~~ name="filetemplate" &#151;
     This specifies the URL or server location of the 
     template Master Form V4 will use when creating 
     your database and/or appending a record thereto. 
     The template is used as a guide to format the data 
     to be stored in the database.

~~ name="dbfile" &#151;
     This specifies the server location of the database 
     itself, the file that will be updated after the 
     data has been formatted according to the template.
EEEE
	}
	elsif($which == 3)
	{
		$e = <<EEEE;
<p>
No field name="redirect" or name="flowto" was found, 
and the browser didn't provide referring URL information.
</p>
<p>
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<td align="right" valign="top"><b>Note:</b></td>
<td>&nbsp;&nbsp;</td>
<td>
Master Form V4 should be accessed only via a form submission.
</td>
</tr>
</table>
</p>
EEEE
		$we = <<EEEE;
No field name="redirect" or name="flowto" was found, 
and the browser didn't provide referring URL information.

Master Form V4 should be accessed only via a form submission.
EEEE
	}
	elsif($which == 4)
	{
		$e = <<EEEE;
<p>
The number of file field template files specified in hidden form field name="filetemplate" and the number of database file names specified in hidden form field name="dbfile" do not match. The same number of template files as database files must be specified. Otherwise, I won't know which template file applies to which database file.
</p>
EEEE
		$we = <<EEEE;
The number of file field template files specified in hidden form field name="filetemplate" and the number of database file names specified in hidden form field name="dbfile" do not match. The same number of template files as database files must be specified. Otherwise, I won't know which template file applies to which database file.
EEEE
	}
	elsif($which == 5)
	{
		$e = <<EEEE;
<p>
When a URL is used to specify the location of an email template, it must be a URL to a page on the $ENV{SERVER_NAME} domain.<br><br>$In{emailtemplate} does not qualify.
</p>
EEEE
		$we = <<EEEE;
When a URL is used to specify the location of an email template, it must be a URL to a page on the $ENV{SERVER_NAME} domain.\n\n$In{emailtemplate} does not qualify.
EEEE
	}
	else
	{
		if(@message)
		{
			my $message = '<ul><li>' . join('</li><li>',@message) . '</li></ul>';
			my $wmessage = join "\n     ",@message;
			$e = <<EEEE;
<p>
While handling uploaded files for storing on the server, Master Form V4 thought you might want to know about the following:
</p>
$message
			$we = <<EEEE;
While handling uploaded files for storing on the server, Master Form V4 thought you might want to know about the following:

     $message
EEEE
		}
		else { $e = 'Subroutine WebmasterNotification called without an error number.'; }
	}
	WebmasterNotice $we if $we;
	Exit $e if $e;
} # sub WebmasterNotification



sub encode($;$)
{
	# this subroutine is from module MIME::Base64
	# $Id: Base64.pm,v 2.16 2001/02/24 06:28:10 gisle Exp $
use integer;
	my $res = "";
	my $eol = $_[1];
	$eol = "\n" unless defined $eol;
	pos($_[0]) = 0;                          # ensure start at the beginning
	$res = join '', map( pack('u',$_)=~ /^.(\S*)/, ($_[0]=~/(.{1,45})/gs));
	$res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
	# fix padding at the end
	my $padding = (3 - length($_[0]) % 3) % 3;
	$res =~ s/.{$padding}$/'=' x $padding/e if $padding;
	# break encoded string into lines of no more than 76 characters each
	if (length $eol) {
		$res =~ s/(.{1,76})/$1$eol/g;
	}
	return $res;
} # sub encode()



sub SanitizeServerLocationValues
{
	my($v,$fieldname) = @_;
	return () unless $v =~ /\w/;
	my @paths = ($ENV{DOCUMENT_ROOT},$0);
	for(@paths) { s!^(/[^/]+).*?$!$1!; }
	my @e = ();
	my @ta = split /\t/,$v;
	for my $s (@ta)
	{
		next unless $s =~ /\w/;
		next if $s =~ m!^https?://\w!i;
		$s =~ s!\.\./!!g;
		if($s =~ m!^/!)
		{
			my $flag = '';
			for(@paths) { $flag = 1 if $s eq '/' or $s =~ m!^$_/!; }
			$s = "$ENV{DOCUMENT_ROOT}$s" if $flag;
			next;
		}
		push @e,qq~When files for field $fieldname are retrieved from the directory/subdirectories where $Transfer{OfficialName} is installed, they must have .htm, .html, or .shtml file name extensions.~ unless $s =~ /\.(?:htm|html|shtml)$/;
	}
	return @e;
} # sub SanitizeServerLocationValues



sub CheckForBannedOrBlocked
{
	return if CheckForBlockedIPaddress;
	my ($banned,@keylist) = ();
	for(keys %In) { push @keylist,$_ if $In{$_} =~ /\w/; }
	local * IsItBanned = sub
	{
		my($fn,$wd,$ex) = @_;
		my $s = lc $In{$fn};
		$s =~ s/^\s*//s;
		$s =~ s/\s*$//s;
		$s =~ s/\s+/ /s;
		if($ex) { return 1 if $s =~ /^\Q$wd\E$/i; }
		else    { return 1 if $s =~ /\Q$wd\E/i;   }
		return '';
	};
	$G{BannedWordsPhrasesList} =~ s/\\:/\t/gs;
	for my $line (split /\n+/,$G{BannedWordsPhrasesList})
	{
		my ($field,$word,$exact) = ();
		my ($fn,$wd) = split / *: */,$line,2;
		$fn =~ s/^\s*(.*)\s*$/$1/s;
		$wd =~ s/^\s*(.*)\s*$/$1/s;
		if($wd)
		{
			$field = $fn;
			$word = $wd;
		}
		else { $word = $fn; }
		$word =~ s/ {2,}/ /s;
		$word = lc $word;
		$word =~ s/\t/:/g;
		if($word =~ s/^"(.*?)"$/$1/) { $exact = 1; }
		if($field) { $banned = IsItBanned($field,$word,$exact); }
		else
		{
			for (@keylist)
			{
				$field = $_;
				$banned = IsItBanned($field,$word,$exact);
				next unless $banned;
				$banned = '' if $word =~ m!http://! and $field =~ /^FormLocation|errorpage|hidden|uploadedfilesaveinfo|flowto|redirect|emailtemplate|filetemplate|submitget|submitpost$/;
				next unless $banned;
				$banned = '' if $field =~ /^l/ and length($field) > $Transfer{AntiSubNameLen} and length($field) > $Transfer{AntiSubValueLen};
				last if $banned;
			}
		}
		next unless $banned;
		$banned = '' if $word =~ m!http://! and $field =~ /^FormLocation|errorpage|hidden|uploadedfilesaveinfo|flowto|redirect|emailtemplate|filetemplate|submitget|submitpost$/;
		next unless $banned;
		$banned = '' if $field =~ /^l/ and length($field) > $Transfer{AntiSubNameLen} and length($field) > $Transfer{AntiSubValueLen};
		next unless $banned;
		$banned = qq~"$word" in form field containing "$In{$field}"~;
		last;
	}
	return unless $banned;
	$In{exitnow} = 'yes';
	return unless $G{WebPageToDisplayUponBanned} =~ /\w/;
	$In{BANNED} = $banned;
	my $page = '';
	RetrievePage($G{WebPageToDisplayUponBanned},'"Banned word/phrase found" page','',\$page);
	FixNextPage \$page,'web' if $page =~ /\[\-?\[/;
	ContentHeader;
	print "\n$page";
} # sub CheckForBannedOrBlocked






sub InformationGetPost
{
	my $content = '';
	my $failed = q~This operation failed. The balance of the form submission procedure was not interrupted by this failure.~;
	my $failed2 = q~The content (if any) received is:~;
	my $line = '=' x 50;
	if($In{submitpost} =~ /\w/)
	{
		for my $thing (split /\t/,$In{submitpost})
		{
			$thing =~ s/^[,\s]*(.*?)[,\s]*$/$1/;
			my @fields = split /[,\s]+/,$thing;
			my $url = shift @fields;
			my %in = ();
			for my $fld (@fields)
			{
				my $fd = $fld;
				($fd,$fld) = split /=/,$fld,2 if $fld =~ /=/;
				$in{$fd} = $In{$fld};
			}
			my ($success,$code) = PostPage $url,\%in,\$content;
			unless($success)
			{
				my @message = (qq~Unable to deliver form information to $url with method POST. The status code is:~);
				push @message,$code,$failed,$failed2,$content;
				WebmasterNotice @message,'get-post';
			}
		}
	}
	if($In{submitget} =~ /\w/)
	{
		for my $thing (split /\t/,$In{submitget})
		{
			$thing =~ s/^[,\s]*(.*?)[,\s]*$/$1/;
			my @fields = split /[,\s]+/,$thing;
			my $url = shift @fields;
			my @in = ();
			for my $fld (@fields)
			{
				my $fd = $fld;
				($fd,$fld) = split /=/,$fld,2 if $fld =~ /=/;
				my $v = HEXize $In{$fld};
				my $k = HEXize $fd;
				push @in,"$k=$v";
			}
			$url .= '?' . join '&',@in;
			my ($success,$code) = GetPage $url,\$content;
			unless($success)
			{
				my @message = (qq~Unable to deliver form information to $url with method GET. The status code is:~);
				push @message,$code,$failed,$failed2,$content;
				WebmasterNotice @message,'get-post';
			}
		}
	}
} # sub InformationGetPost





sub AutomaticSubmitProtectionMechanism
{
	return unless $G{ASPMenabled} =~ /[yt1l]/i;
	my @list = ();
	for(keys %In) { push @list,$_ if $_ =~ /^l/ and length($_) > $Transfer{AntiSubNameLen} and length($In{$_}) > $Transfer{AntiSubValueLen}; }
	return if @list and PassedASPMcheck \@list;
	my $AutoSubmitEmail = 'An automatic submission may have been attempted.';
	WebmasterNotice $AutoSubmitEmail,'isautosubmit';
	if($G{ASPMfailMessage} =~ m!^https?://\S+$!i) { print "Location: $G{ASPMfailMessage}\n\n"; }
	else { print "Content-type: text/html\n\n<html><body>$G{ASPMfailMessage}</body></html>"; }
	Exit;
} # sub AutomaticSubmitProtectionMechanism





sub AddSecretHiddenFields
{
	return unless $In{hidden} =~ /\w/;
	my $page = '';
	RetrievePage($In{hidden},'Form field name="hidden"','',\$page);
	while($page =~ s/<input([^>]+)>//si)
	{
		my $line = $1;
		$line =~ s/(\w+=)/>$1/gs;
		my %k = ();
		for(split />/,$line)
		{
			s/^\s*//s;
			s/^(\w+)=//;
			my $kk = lc $1;
			s/^["\s]*//s;
			s/["\s]*$//s;
			$k{$kk} = $_;
		}
		next unless $k{name};
		my($k,$v) = ($k{name},$k{value});
		if($In{$k}) { $In{$k} .= "\t$v"; }
		else        { $In{$k}  =    $v;  }
	}
} # sub AddSecretHiddenFields



sub SequentialNumbering
{
	return unless $In{use_numbering_key} =~ /\w/;
	$In{use_numbering_start} = '' unless $In{use_numbering_start};
	$In{use_number} = RecordNumberSequenceAndReturnNextNumber $In{use_numbering_key},$In{use_numbering_start};
} # sub SequentialNumbering



sub CrossSiteScriptingSanitization
{
	my %exception = ();
	if(open Rexceptions,'<MasterFormFieldExceptions.cgi')
	{
		while(my $line = <Rexceptions>)
		{
			next unless $line =~ /\S/;
			next unless index($line,'#');
			$line =~ s/^\s*(.*?)\s*$/$1/s;
			$exception{$line} = 1;
		}
		close Rexceptions;
	}
	for my $k ( keys %In )
	{
		next if $exception{$k};
		$In{$k} =~ s/</&lt;/g;
		$In{$k} =~ s/>/&gt;/g;
		$In{$k} =~ s/'/&apos;/g;
		$In{$k} =~ s/"/&#x22;/g;
		$In{$k} =~ s/`/&#x96;/g;
		$In{$k} =~ s/\)/&#x29;/g;
		$In{$k} =~ s/\(/&#x28;/g;

	}
} # sub CrossSiteScriptingSanitization



sub GetWhitelistFileList
{
	%FileWhitelist = ();
	if(open Rwhitelist,'<MasterFormFileAccessWhitelist.cgi')
	{
		while(my $line = <Rwhitelist>)
		{
			next unless $line =~ /\S/;
			next if index($line,'#') > -1;
			$line =~ s/^\s*(.*?)\s*$/$1/s;
			$FileWhitelist{$line} = 1;
		}
		close Rwhitelist;
	}
} # sub GetWhitelistFileList





RecordFormLocation;
sub trail{$dom=$d;$v=$_[0];}
GetWhitelistFileList;
Exit("Unauthorized use by $ENV{HTTP_REFERER}") unless ParseFormData and trail(1);
my %inMail = %In;
CrossSiteScriptingSanitization;
Exit UpdateNoticeDelivery if $In{unac} and $In{unac} eq $G{UpdateNoticeAuthorizationCode};
Exit if $In{exitnow};
AddSecretHiddenFields;
CheckForBannedOrBlocked;
Exit if $In{exitnow};
WebmasterNotification(1) if $In{filetemplate} =~ /\w/ and $In{filetemplate} eq $In{dbfile};
WebmasterNotification(2) if ($In{filetemplate} =~ /\w/ and $In{dbfile} !~ /\w/) or ($In{filetemplate} !~ /\w/ and $In{dbfile} =~ /\w/);
{
	my @e = SanitizeServerLocationValues $In{errorpage},'name="errorpage"';
	delete $In{errorpage} if @e;
	push @e,SanitizeServerLocationValues $In{uploadedfilesaveinfo},'name="uploadedfilesaveinfo"';
	push @e,SanitizeServerLocationValues $In{flowto},'name="flowto"';
	Exit @e if @e;
}
CheckRequiredFields;
CheckEmailFields;
GetDateTime;
for my $k (split /\; */,$ENV{HTTP_COOKIE})
{
	my ($n,$v) = split(/\=/,$k,2);
	$v =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
	$Mine{$n} = $v;
}
$Mine{HTTP_USER_AGENT} = $ENV{HTTP_USER_AGENT};
$Mine{SELFDOMAIN} = $ENV{SERVER_NAME};
$Mine{REFERRER} = $ENV{HTTP_REFERER};
$Mine{IP} = $ENV{REMOTE_ADDR};
$Mine{ALLME} = $Mine{ME} = $0;
$Mine{ME} =~ s!^.*[\\/]!!;
for(keys %ENV) { $Mine{$_} = $ENV{$_} unless $Mine{$_}; }
AutomaticSubmitProtectionMechanism unless $In{exitnow};
$In{ControlPanelAlertAddress} = $G{DefaultEmailToAddy};
unless($In{exitnow})
{
	SequentialNumbering;
	my %localin = %In;
	for( keys %inMail ) { $In{$_} = $inMail{$_}; }
	%inMail = ();
	SendTheEmail;
	%In = %localin;
}
StoreUploadedFiles unless $In{exitnow};
UpdateDatabases unless $In{exitnow};
Exit if $In{exitnow};
InformationGetPost;
if($In{redirect} =~ /\w/)
{
	$In{redirect} = (split(/\t/,$In{redirect},2))[0];
	my $Tplace = $In{redirect};
	FixNextPage(\$Tplace,'name="redirect" value');
	$In{redirect} = $Tplace;
	print "Location: $In{redirect}\n\n";
	print qq~<html><head>
<meta http-equiv="refresh" content="0; url=$In{redirect}">
<script type="text/javascript">
window.location = "$In{redirect}";
</script>
</head><body style="margin:200px;">
If no redirect occurs, 
<a href="$In{redirect}">click here.</a>
</body></html>~;
}
elsif($In{flowto} =~ /\w/) { FlowTo; }
elsif($Mine{REFERRER} =~ /\w/)
{
	print "Location: $Mine{REFERRER}\n\n";
	print qq~<html><head>
<meta http-equiv="refresh" content="0; url=$Mine{REFERRER}">
<script type="text/javascript">
window.location = "$Mine{REFERRER}";
</script>
</head><body style="margin:200px;">
If no redirect occurs, 
<a href="$Mine{REFERRER}">click here.</a>
</body></html>~;
}
else { WebmasterNotification(3); }
BOTTOM:
exit;
# end of script