package MasterFormV4Common;
###########################################################
#
# 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 MasterFormV4Common.pm
#    Variables and subroutines common to both from processor and control panel.
#
# 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: hobbyline.com
#     by: 24.92.168.170
#     at: 1587562305 -- Wednesday, April 22, 2020 at 13:31:45 GMT.
#
###########################################################

use strict; # May be commented out after testing.
use LWP::UserAgent;
use HTTP::Request::Common;
use MIME::Base64 qw(encode_base64);
use Fcntl qw(:DEFAULT :flock);
use CGI;
use Cwd;

use vars qw(
	@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
	%In %TmpDldFile %Transfer %G $V $P %Mine $dom $d $v %Uploaded %FileWhitelist 
);

require Exporter;
$VERSION = 1.00;
@ISA = qw( Exporter );

@EXPORT = qw(
	@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION
	%In %TmpDldFile %Transfer %G $V $P %Mine $dom $d $v %Uploaded %FileWhitelist 

	FileWhiteListed
	SilentFail
	SendMail
	WebmasterNotice
	UpdateNoticeDelivery
	NoCanCreateDirectories
	ParseForUpload
	ParseFormData
	MakeDirectory
	RemoveDirectory
	ContentHeader
	PageTop
	PageBottom
	ErrorHTML
	HTMLize
	HEXize
	RemoveWhiteFromEnds
	RemoveAllWhite
	ConformLineEndings
	ValidEmail
	GetRandomString
	LockFile
	UnLockFile
	WriteConfig
	CommaTabSeparatedList
	ExtractEmails
	PresentTemporaryDownloadPage
	FixNextPage
	GetPage
	PostPage
	RetrievePage
	WriteFile
	RecordFormLocation
	RetrieveFormLocations
	DeleteFormLocationRecords
	DeleteFormLocationDatabase
	RecordNumberSequenceAndReturnNextNumber
	RetrieveNumberSequences
	DeleteNumberSequenceRecords
	DeleteNumberSequenceDatabase
	RecordFormLoadInformation
	GetAllFormLoadInformation
	PassedASPMcheck
	DeleteFormLoadDatabase
	CheckForBlockedIPaddress 
	RemoveExpiredLinks
	RemoveTemporaryDownloadFiles
);

$Transfer{OfficialName}     = 'Master Form V4';
$Transfer{Version}          = '4.7b';
$Transfer{Perl}             = '/usr/bin/perl';
$Transfer{CopyrightLine}    = qq~Copyright 2000,2001 <a href="http://www.willmaster.com/">William Bontrager</a><br>
                                 Copyright 2002-2010 <a href="http://www.willmaster.com/">Bontrager Connection, LLC</a><br>
                                 Copyright 2012,2017 <a href="http://www.willmaster.com/">Will Bontrager Software LLC</a>~;
$Transfer{DataDirectory}    = 'MFv4Data';
$Transfer{FormName}         = 'MFv4FormName';
$Transfer{AntiSubNameLen}   = 20;
$Transfer{AntiSubValueLen}  = 27;
$Transfer{Time}             = time;
$Transfer{CurrentYear}      = (localtime($Transfer{Time}))[5] + 1900;
$Transfer{Query}            = $ENV{QUERY_STRING};
$Transfer{TempFileName}     = 'TEMP_okay.to.delete_' . $Transfer{Time} . '{randomnumber}-{FILENAME}.tmp';
$Transfer{FlatLineBreakSub} = chr(2);
$Transfer{RecordSeparator}  = chr(7); ###~~~###
$Transfer{NoticePokeURL}    = 'http://www.willmaster.com/software/formV4/generator/MFv4UpdateNudge.cgi';
$Transfer{SetupURL}         = 'http://www.willmaster.com/software/formV4/generator/MFv4DeliverSetup.cgi';
$Transfer{GetFileURL}       = 'http://www.willmaster.com/software/formV4/generator/MFv4DeliverFile.cgi';
$Transfer{TDLpluginGETurl}  = 'http://www.willmaster.com/software/formV4/generator/MFv4DeliverTDLplugin.cgi';
$Transfer{TechSupportLink}  = 'http://www.willmaster.com/software/formV4/support/';

my $FormTracksFileName        = 'FormTracks';
my $SequencialNumbersFileName = 'SequencialNumbers';
my $FormLoadInformation       = 'FormLoadInfo';
my $ConfigurationFile         = "$Transfer{DataDirectory}/MFv4Configuration.cgi";
my %TiedDBtracker             = ();

my %RecordFormLoadInformation = ();
my @RecordFormLoadInformation = qw(
	fieldname
	fieldvalue
	loadtime
	loadip
	submittime
	submitip
	JSseconds
	loadreferrer
	submitreferrer
	loadua
	submitua
	JSpageURL
);
for(0..$#RecordFormLoadInformation) { $RecordFormLoadInformation{$RecordFormLoadInformation[$_]} = $_; }


$Transfer{ME} = $0; $Transfer{ME} =~ s!^.*[/\\](.*?)$!$1!;
$Transfer{ThisDirectory} = cwd();
my($HeaderPrinted,$I,$S) = ();


sub LocalExit { print "Content-type: text/html\n\n" . join "<br>",@_; exit; }


#################################################

$Transfer{Query} = new CGI;
&ReadConfig;
$G{whichDB} = 'SDBM_File' unless $G{whichDB} =~ /\w/;
eval "use $G{whichDB}";
&DoDaily;
srand;

#################################################



sub SilentFail
{
	print "Content-type:text/html\n\n";
	exit;
} # sub SilentFail



sub FileWhiteListed
{
	my ($file,$activity) = @_;
	return 1 if length($file) < 1;
	my $data = 0;
	for my $k (keys %FileWhitelist)
	{
		return 1 if $k eq $file;
		$data = 1;
	}
	return 1 unless $data;
	for my $k (keys %FileWhitelist)
	{
		next unless $k =~ /\*$/;
		return 1 if index($file,substr($k,0,length($k)-1)) == 0;
	}
	my $notice = "Attempt to $activity unwhite-listed file: $file";
	WebmasterNotice($notice,$data.'--'.'nonwhitelistfile');
	return 0;
} # sub FileWhiteListed




sub SendMail
{
	my($email,$minusf,$attachptr,$divider) = @_;
	$minusf = $minusf =~ /\@/ ? " -f$minusf" : '';
	ConformLineEndings($email);
	my $message = '';
	open MAIL,"|$G{MailerLocation}$minusf";
	print MAIL $$email;
	if($attachptr and $divider)
	{
		my $appendchar = $$email =~ /\n$/ ? '' : "\n";
		my $somethingwrongfilename = '_Something_Wrong_' . $Transfer{Time} . '.txt';
		for (keys %$attachptr)
		{
			my $fn = $_;
			my $file = $$attachptr{$_};
			my $ct = 'application/octet-stream';
			print MAIL "$appendchar\n";
			$appendchar = '';
			my $temppage = '';
			if($file =~ m!^http://\w!i)
			{
				RetrievePage($file,"\"ATTACH\" placeholder with URL $file for file name",'',\$temppage);
				my $temppage = "Unable to read URL $file and, thus, unable to attach it." unless $temppage;
			}
			else { $fn = $somethingwrongfilename unless open Rsm,"<$file" or open Rsm,"<$ENV{DOCUMENT_ROOT}$file" or open Rsm,"<$ENV{DOCUMENT_ROOT}/$file"; }
			print MAIL qq~-\-$divider\nContent-Type: $ct\nContent-Transfer-Encoding: base64\nContent-Disposition: attachment; filename="$fn"\n\n~;
			if($temppage) { print MAIL encode_base64($temppage); }
			elsif($fn eq $somethingwrongfilename)
			{
				$message = "Unable to read file $file and, thus, unable to attach it.";
				print MAIL encode_base64($message);
			}
			else
			{
				my $buffer = '';
				while(read Rsm,$buffer,60*57) { print MAIL encode_base64($buffer); }
			}
		} # for(keys %$attachptr)
		print MAIL "\n-\-$divider\--";
	} # if($attachptr)
	close MAIL;
	WebmasterNotice($message) if $message;
} # sub SendMail




sub DoDaily
{
	my $yd = (localtime())[7];
	return if $G{YearDay} == $yd;
	RemoveTemporaryFilesAndSuch();
	$G{YearDay} = $yd;
	&WriteConfig;
} # sub DoDaily




sub MakeWebmasterMessageFormAndEnvronmentFieldValuesList
{
	return if $In{WebmasterMessageFormAndEnvronmentFieldValuesList};
	my $s = "\n\n\n" . '*' x 60 . "\n" . '*' x 60 . "\n\n\n";
	$s .= "*** *** *** Additional items that might or might not be of interest *** *** ***\n";
	$s .= '      (This information is included in each webmaster notification email)';
	$s .= "\n\nScript used:\n\t$0\n";
	$s .= "\n\nForm field names and values list:\n";
	for(sort keys %In)
	{
		next unless $In{$_} =~ /\S/;
		$s .= "\t$_ =\n\t\t$In{$_}\n";
	}
	$s .= "\n\n\nEnvironment variables:\n";
	for(sort keys %ENV) { $s .= "\t$_ =\n\t\t$ENV{$_}\n"; }
	$In{WebmasterMessageFormAndEnvronmentFieldValuesList} = $s;
} # sub MakeWebmasterMessageFormAndEnvronmentFieldValuesList


sub WebmasterNotice
{
	return unless ValidEmail($G{DefaultEmailToAddy});
	my $urgent = '';
	if($_[$#_] eq 'ishijack' or $_[$#_] eq 'get-post' or $_[$#_] eq 'isoversized' or $_[$#_] eq 'isautosubmit')
	{
		$urgent = 1;
		pop @_;
	}
	if($G{EmailOnlyUrgentNotices} =~ /[y1l]/i) { return unless $urgent; }
	my $message = join "\n\n",@_;
	MakeWebmasterMessageFormAndEnvronmentFieldValuesList;
	my $emailheader = 'To: ';
	if($G{DefaultEmailToName} =~ /\w/) { $emailheader .= qq~"$G{DefaultEmailToName}" <$G{DefaultEmailToAddy}>\n~; }
	else                               { $emailheader .= "$G{DefaultEmailToAddy}\n"; }
	$emailheader .= "Subject: $G{DefaultEmailToSubject}\n" if $G{DefaultEmailToSubject} =~ /\w/;
	$emailheader .= qq~From: "$Transfer{OfficialName}" <$G{DefaultEmailToAddy}>\n\n~;
	SendMail \"$emailheader$message$In{WebmasterMessageFormAndEnvronmentFieldValuesList}",$G{DefaultEmailToReturnPath};
} # sub WebmasterNotice



sub UpdateNoticeDelivery
{

	return '' unless ValidEmail($G{UpdateNoticeEmailToAddy});
	my $emailheader = 'To: ';
	if($G{UpdateNoticeEmailToName} =~ /\w/) { $emailheader .= qq~"$G{UpdateNoticeEmailToName}" <$G{UpdateNoticeEmailToAddy}>\n~; }
	else                                    { $emailheader .= "$G{UpdateNoticeEmailToAddy}\n"; }
	$emailheader .= "Subject: $G{UpdateNoticeEmailToSubject}\n" if $G{UpdateNoticeEmailToSubject} =~ /\w/;
	$emailheader .= qq~From: "Master Form V4 Upgrade Notice Initiation Software" <if.then.else\@flowto.info>\n\n~;
	my $message = $G{UpdateNoticeMessage};
	$message = q~A Master Form V4 update is available.

To install the updated version, please see the "Automatic Submission Protection with Master Form V4" section at the "Auto-Submit Protection" control panel page.

If you wish to read about the update before initiating the automatic update installation, see http://www.willmaster.com/software/formV4/support/

Thank you!~ unless $message =~ /\w/;
	SendMail \"$emailheader$message",$G{UpdateNoticeEmailToReturnPath};
	return 1;
} # sub UpdateNoticeDelivery



sub NoCanCreateDirectories
{
	my $dir = shift;
	my $notice = <<NOTICE;
<p>
I could not create directory $dir just now. <nobr>Error message: $!</nobr>
</p>
<p>
Subdirectory $dir must be created manually with your FTP program. 
This directory is a subdirectory to the directory where $Transfer{OfficialName} is 
installed.
</p>
<p>
When you create the directory, try it with the default permissions, 
which is probably 755. If no information is stored, try 766 
permissions. If still no information is stored in the $dir 
directory, try 777 permissions.
</p>
<p>
Because $Transfer{OfficialName} can not create driectories on your 
server, any directories you need for data files will need to be created 
manually &#151; like the $dir directory needs to be created.
</p>
NOTICE
	ErrorHTML($notice);
} # sub NoCanCreateDirectories



sub ParseForUpload
{
	return ErrorHTML('Form\'s method must be POST') unless $ENV{'REQUEST_METHOD'} =~ /POST/i;
	my @names = $Transfer{Query}->param;
	for(@names) { $In{$_} = join("\t",($Transfer{Query}->param($_))); }
	my @e = ();
	my $buffer;
	for(keys %In)
	{
		my $filehandle = $Transfer{Query}->upload($_);
		next unless $filehandle;
		my $rnumber = rand 9999;
		$rnumber =~ s/\D//g;
		my $storefile = "$Transfer{DataDirectory}/$Transfer{TempFileName}";
		$storefile =~ s/\{randomnumber\}/$rnumber/;
		$storefile =~ s/\{FILENAME\}/$_/;
		SilentFail unless FileWhiteListed($storefile,'upload');
		open Wpfu,">$storefile";
		binmode Wpfu;
		while(read $filehandle,$buffer,1024) { print Wpfu $buffer; }
		close Wpfu;
		$filehandle =~ s!^.*[/\\]!!;
		$Uploaded{$_} = "$_\t$filehandle\t$storefile";
	}
	ErrorHTML(@e) if @e; }
	sub trail { $dom=$d; $v=$_[0];
} # sub ParseForUpload




sub ParseFormData
{
	$S = lc $ENV{HTTP_REFERER};
	$S =~ s/\A.*\/\///;
	$S =~ s/\Awww\.//;
	$S =~ s/\A(.*?)(\/.*)/$1/;
	my $ts = uc(reverse("}x_" . 'revres{vne$'));
	$ts =~ s/X/NAME/;
	my $ls = lc eval $ts;
	my $s = ucfirst 's'; $s = "\$$s=\$ls";
	unless($ls) { $ts =~ s/name/HOST/i; $ts =~ s/server/HTTP/i; $ls = lc eval $ts; }
	$ts = $s;
	eval $ts and $ts = '$' . uc 'i' . '=&P' . reverse 'esra';
	$ts = 'w' x 3 . '\.'; $S =~ s/^$ts//i;
	$I = substr($S,-7,1) =~ /i/i ? 1 : 0;
	trail($I) and $d = $S;
	{
		my $maxdata = $G{MaximumTotalUploadDataSize};
		$maxdata =~ s/\D//g;
		if($maxdata > 0 and $maxdata < 12 * 1024)
		{
			my $script = '';
			$script = $ENV{REQUEST_URI} or $script = $ENV{SCRIPT_FILENAME} or $script = $ENV{SCRIPT_NAME};
			$maxdata = 12*1024 if $script =~ /MasterFormV4CP\.(?:cgi|pl)$/i;
		}
		if($maxdata > 0 and $ENV{CONTENT_LENGTH} > $maxdata)
		{
			my $notice = <<NOTICE;
The maximum data size for information sent to $Transfer{OfficialName} 
during a file upload has been specified in the control panel 
to be $maxdata bytes.

A form submission was intercepted with $ENV{CONTENT_LENGTH} bytes if data.

No field names and values are available because the data was 
never processed.
NOTICE
			WebmasterNotice $notice,'isoversized';
			return ErrorHTML(q~Upload too large.~,q~A message with more information has been sent to the webmaster's notification email address.~);
		}
	}
	return i(ParseForUpload) if $ENV{CONTENT_TYPE} =~ m!^multipart/form-data!i;
	$S = $d;
	my @names = $Transfer{Query}->param();
	for(@names)
	{
		my @next = $Transfer{Query}->param($_);
		$In{$_} = join("\t",@next);
	}
	my @delkeys = ();
	for(keys %In) { push @delkeys,$_ if /[\<\>\'\"\`\(\)]/; }
	for(@delkeys) { delete $In{$_}; }
	return &i; }
	sub i { return substr($d,-6,1) =~ /n/i and substr($d,-5,1) =~ /e/i;
} # sub ParseFormData



sub MakeDirectory
{
	my($base,$dir) = @_;
	($dir,$base) = ($base,$ENV{DOCUMENT_ROOT}) unless $dir;
	if($base) { return '' unless -e $base; }
	$dir =~ s!/+$!!;
	$dir =~ s!^/+!!;
	if($base)
	{
		$base =~ s!/+$!!;
		return $dir if -e "${base}/$dir";
	}
	else { return $dir if -e $dir; }
	my $exists = '';
	my @dir = split /\/+/,$dir;
	my $path = '';
	for(@dir)
	{
		if($path) { $path .= "/$_"; }
		else { $path = $base ? "/$_" : $_; }
		next if -e "${base}$path";
		if(mkdir "${base}$path",0777) { $exists = 1; }
		else { $exists = ''; last; }
	}
	$path =~ s!^/!!;
	return $exists ? $path : '';
} # sub MakeDirectory



sub RemoveDirectory
{
	my $dir = shift;
	while(rmdir $dir) { $dir =~ s![/\\]+[^/\\]+$!!; }
} # sub RemoveDirectory










sub ContentHeader
{
	return if $HeaderPrinted;
	print "Content-type: text/html\n";
	$HeaderPrinted = 1;
} # sub ContentHeader



sub MessageToJavaScriptAlert
{
	my $jsmessage = shift;
	my $nonjsmessage = $jsmessage;
	$nonjsmessage =~ s/^\s*(.*?)\s$/$1/s;
	$nonjsmessage =~ s/\n/\<br\>/gs;
	$jsmessage =~ s/\\/\\\\/gs;
	$jsmessage =~ s/\"/\\\"/gs;
	$jsmessage =~ s/\n/\\n/gs;
	return <<MESSAGE;
<script type="text/javascript" language="JavaScript"><\!--
alert("$jsmessage");
//--></script>
<noscript>
<table bgcolor="#CCCCFF" width="50%" border="5" cellpadding="11" cellspacing="0"><tr>
<td class="likeh3">$nonjsmessage</p></table>
</noscript>
MESSAGE
} # sub MessageToJavaScriptAlert


sub Stretch
{
	my $line = shift;
	my $symbolholder = chr(3);
	$line =~ /(\&.*?\;)/;
	my $symbol = $1;
	$line =~ s/\Q$symbol\E/$symbolholder/ if $symbol;
	my @s = split //,$line;
	for(@s) { $_ = '&nbsp;' if / /; }
	$line = join ' ',@s;
	$line =~ s/\Q$symbolholder\E/$symbol/ if $symbol;
	return $line;
} # sub Stretch


sub PageCSS
{
	return <<PAGECSS;
<style type="text/css">
<\!--
BODY, TABLE,TR,TD,P,LI,OL,UL,BLOCKQUOTE,.normal
	{
		font-family: arial,helvetica,sans-serif; 
		font-size: 12px; 
		font-weight: normal;
		line-height: 18px;
	}
TH,.likeTH    { font-size: 10px; font-weight: bold;  line-height: 10px; }
H1            { font-size: 18px; font-weight: bold;   }
H2            { font-size: 18px; font-weight: normal; }
H3            { font-size: 14px; font-weight: bold;   }
H4            { font-size: 14px; font-weight: normal; }
H5            { font-size: 10px; font-weight: bold;   }
.italic       { font-style: italic; }
.bold         { font-weight: bold; }
.likeh2       { font-size: 18px; font-weight: normal; }
.likeh3       { font-size: 14px; font-weight: bold; }
.likeh5       { font-size: 10px; font-weight: bold; line-height: 10px; }
.big          { font-size: 22px; font-weight: bold; }
.small        { font-size: 10px; line-height: 12px; }
.top15        { margin-top: 15px; }
.top20        { margin-top: 20px; }
.top25        { margin-top: 25px; }
.extra9top    { margin-top: 9px; }
.extra5top    { margin-top: 5px; }
.halfspace    { font-size: 9px; line-height: 9px; }
.fivepixelsize{ font-size: 5px; line-height: 5px; }
.onepixelsize { font-size: 1px; line-height: 1px; }
.error        { color: red;    text-decoration: none; }
.nowrap       { white-space: nowrap; }
PRE,.inlinepre,.code{ font-family: courier new,courier,monospace; font-size: 14px; }
INPUT,TEXTAREA{ font-family: courier new,monospace,courier; font-size: 14px; }
.submitbutton { font-family: arial,helvetica,sans-serif; font-size: 14px; color: #993300; font-weight: normal; line-height: 18px; }
A:link        { color: #993300; text-decoration: none; }
A:visited     { color: #003366; text-decoration: none; }
A:active      { color: #003366; text-decoration: none; }
-->
</style>
PAGECSS
} # sub PageCSS



sub PageTop
{
	my $title = shift;
	my $css = PageCSS;
	my $stretchVersion = Stretch("Version $Transfer{Version}");
	my $stretchName = Stretch $Transfer{OfficialName};
	my $user_message = $In{user_message} =~ /\w/ ? MessageToJavaScriptAlert($In{user_message}) : '';
	ContentHeader;
	print "\n";
	print <<HTML;
<html>
<head>

<script type="text/javascript" language="JavaScript"><\!--
var AJAXcontent = new String();

function GrabContent(dest) {
try { AJAXxmlhttp = window.XMLHttpRequest ? new XMLHttpRequest(): new ActiveXObject("Microsoft.XMLHTTP"); }
catch (e) {
	alert("It seems your browser doesn't support AJAX.\\n\\nPlease click the control panel \\"Support\\" menu item \\nfor information about accomplishing the installation another way.");
	return;
	}
AJAXxmlhttp.onreadystatechange = triggered;
AJAXxmlhttp.open('GET',dest);
AJAXxmlhttp.send(null);
} // function GrabContent()

function triggered() {
if((AJAXxmlhttp.readyState == 4) && (AJAXxmlhttp.status == 200)) { AJAXcontent = AJAXxmlhttp.responseText; }
} // function triggered()

function ReverseContentDisplay(d) {
if(document.getElementById(d).style.display == "none") { document.getElementById(d).style.display = ""; }
else { document.getElementById(d).style.display = "none"; }
}

function HideContent(d) { document.getElementById(d).style.display = "none"; }

function ShowContent(d) { document.getElementById(d).style.display = ""; }

document.cookie = "TemporaryTestCookie=yes;";
if(document.cookie.indexOf("TemporaryTestCookie=") == -1) {
     alert("Cookies are required to use this control panel.");
     }
//--></script>

<title>($title) $Transfer{OfficialName} Control Panel</title>
$css
<script type="text/javascript" language="JavaScript"><\!--
//--></script>
</head>
<body bgcolor="white">
<form name="$Transfer{FormName}" method="POST" action="$Transfer{ME}">
<div align="center">
<a name="topofpage"></a>
<table border="0" cellpadding="0" cellspacing="0">
<tr>
<td width="200" valign="top" align="left"><a href="http://WillMaster.com/software/"><img src="http://www.willmaster.com/software/productimages/wmb_mseries.jpg" height="88" width="200" border="0"></a></td>
<td width="20">&nbsp;</td>
<td align="center" valign="bottom">
<nobr><span class="likeh3">$stretchName</span></nobr>
<br>
<span class="small"><nobr>$stretchVersion</nobr></span>
<h3>Control Panel</h3>
<h2><nobr>$title</nobr></h2>
</td>
<td width="20">&nbsp;</td>
<td width="200">&nbsp;</p>
</table>
$user_message
&nbsp;
<noscript>
<table bgcolor="pink" border="1" cellpadding="11" cellspacing="0"><tr><td class="likeh3">
JavaScript must be turned on for the control panel to function correctly.
</td></tr></table>
</noscript>
<TABLE WIDTH="500" BORDER="1" CELLPADDING="20" CELLSPACING="0"><TR><TD>
HTML
} # sub PageTop


sub PageBottom
{
	my $title = shift;
	print <<HTML;
</TD></TR></TABLE>
</form>
</div>
<p>
$Transfer{CopyrightLine}
</p>
<sc_ript type="text/javascript" language="JavaScript"><\!--
for (var i = 0; i < document.$Transfer{FormName}.elements.length; i++) { 
document.write(document.$Transfer{FormName}.elements[i].name + "<br>")
}
//--></script>
</body></html>
HTML
	$In{exitnow} = 1;
} # sub PageBottom




sub FPerror
{
	my $s = '<ul><li>' . join("</li>\n<li>",@_) . '</li></ul>';
	$s =~ s/(<[^>]*emb)(ed)/${1}_$2/gis;
	$s =~ s/(<[^>]*scr)(ipt)/${1}_$2/gis;
	$s =~ s/(<[^>]*ifr)(ame)/${1}_$2/gis;
	my $page = '';
	my @e = ();
	@e = RetrievePage($In{errorpage},'Form field name="errorpage"','yes',\$page);
	$s .= qq~<p>In addition, while attempting to retrieve error page template $In{errorpage}, the following was encountered:</p><ul><li>~ . join("</li>\n<li>",@e) . '</li></ul>' if @e;
	$s .= q~<script type="text/javascript" language="JavaScript"><!--
document.write('<div align="center"><form><input type="button" value="Return to form" onClick="javascript:history.go(-1)"></form></div>');
//--></script>~;
	$page = <<HTML unless $page =~ /\w/;
<html>
<head><title>Error message</title></head>
<body bgcolor="white" text="black" link="blue" vlink="blue">
<TABLE WIDTH="100%" HEIGHT="100%" BORDER="0" CELLPADDING="0" CELLSPACING="0"><TR>
<TD WIDTH="100%" HEIGHT="100%" VALIGN="MIDDLE" ALIGN="CENTER">
<table border="0" cellpadding="0" cellspacing="0"><tr>
<td><h4 align="center">Message</h4>[[ERROR_MESSAGE]]</td>
</tr></table>
</TD>
</TR></TABLE>
</body>
</html>
HTML
	$page =~ s/(?:<\!--|\[\[)\s*ERROR[_\-\s]*MESSAGE\s*(?:\]\]|-->)/$s/si;
	FixNextPage(\$page,'webpage');
	print "Content-Type: text/html\n\n$page";
	return 'exit';
} # sub FPerror

sub CPerror
{
	my $s = join qq~</li>\n<li class="error">~,@_;
	PageTop('Message for You');
	print <<HTML;
<p class="bold">Message for you:</p>
<ul><li class="error">$s</li></ul>
<script type="text/javascript" language="JavaScript"><!--
document.writeln('&nbsp;<div align="center"><form><input type="button" class="submitbutton" value="Return to previous page" onClick="javascript:history.go(-1);"></form></div>');
//--></script>
HTML
	PageBottom;
	return 'exit';
} # sub CPerror

sub ErrorHTML
{
	return if $In{exitnow};
	$In{exitnow} = 1;
	return FPerror @_ unless $Transfer{ME} =~ /V4CP\./i;
	return CPerror @_;
} # sub ErrorHTML




sub HTMLize
{
	my $sptr = shift;
	$$sptr =~ s/\&/\&amp;/g;
	$$sptr =~ s/>/\&gt;/g;
	$$sptr =~ s/</\&lt;/g;
	$$sptr =~ s/"/\&quot;/g;
} # sub HTMLize




sub HEXize
{
	my $s = shift;
	$s =~ s/(\W)/'%'.unpack('H2',$1)/ges;
	return $s;
} # sub HEXize




sub RemoveWhiteFromEnds
{
	my $sptr = shift;
	$$sptr =~ s/^\s*//gs;
	$$sptr =~ s/\s*$//gs;
} # sub RemoveWhiteFromEnds




sub RemoveAllWhite
{
	my $sptr = shift;
	$$sptr =~ s/\s*//gs;
} # sub RemoveAllWhite



sub ConformLineEndings
{
	my $sptr = shift;
	if($$sptr =~ /\n/) { $$sptr =~ s/\r//gs;   }
	else               { $$sptr =~ s/\r/\n/gs; }
} # sub ConformLineEndings



sub ValidEmail
{
	return 0 if $_[0] =~ /([\.\-]{2,}|@[\.\-\_])/;
	return 1 if $_[0] =~ /^[\w\.\-\_\&\+]+\@\[?[\w\.\-\_]+\.([\w\.\-\_]{2,}|[0-9])\]?$/;
	return 0;
} # sub ValidEmail





sub GetRandomString
{
	my $halflength = shift;
	my $charset = 'abcdefghkmnpqrstuvwxyz23456789';
	my $charsetlength = length($charset);
	my $choppoint = (int(rand($charsetlength - 3)) + 2);
	$charset = substr($charset,$choppoint) . substr($charset,0,$choppoint);
	my @charset = split //,$charset.'j';
	my $length = (int(rand($halflength)) + $halflength);
	my $base = join("\t",split(//,substr($Transfer{Time},5)));
	for(0..$length) { $base .= "\t" . int(rand($charsetlength)); }
	my $result = '';
	for(split /\t/,$base) { $result .= $charset[$_]; }
	return $result;
} # sub GetRandomString




sub LockFile
{
	my $f = "$_[0].lock";
	my $tm = $Transfer{Time};
	while((time - $tm) < 12)
	{
		last unless -e $f;
		sleep 2;
	}
	open LOCKFILE,">$f";
	close LOCKFILE;
} # sub LockFile
sub UnLockFile { unlink "$_[0].lock"; }



sub WriteConfig
{
	my $f = $ConfigurationFile;
	if(open Wwc,">$f")
	{
		flock Wwc,LOCK_EX;
		my %g = %G;
		for(keys %g)
		{
			$g{$_} =~ s/\n/$Transfer{FlatLineBreakSub}/gs;
			print Wwc "$_\t$g{$_}\n";
		}
		close Wwc;
	}
} # sub WriteConfig


sub ReadConfig
{
	my $f = $ConfigurationFile;
	unless(open Rrc,"<$f")
	{
		NoCanCreateDirectories $Transfer{DataDirectory} unless MakeDirectory $Transfer{ThisDirectory},$Transfer{DataDirectory};
		$G{SelfDomain} = $d = 'hobbyline.com';
		my $www = $G{SelfDomain} =~ /[a-zA-Z]/ ? 'www.' : '';
		for( qw(
			/usr/sbin/sendmail
			/usr/bin/sendmail
			/usr/slib/sendmail
			/usr/lib/sendmail
			/sbin/sendmail
			/bin/sendmail
			/slib/sendmail
			/lib/sendmail
			/usr/sendmail
			/sendmail
			sendmail
			))
		{
			if(-e $_)
			{
				$G{MailerLocation} = "$_ -t -i";
				last;
			}
		}
		$G{MailerLocation} = "/sendmail -t -i" unless $G{MailerLocation};
		$G{WeekdayList} = "Sunday\tMonday\tTuesday\tWednesday\tThursday\tFriday\tSaturday";
		$G{MonthList} = "January\tFebruary\tMarch\tApril\tMay\tJune\tJuly\tAugust\tSeptember\tOctober\tNovember\tDecember";
		$G{MonList} = "Jan\tFeb\tMar\tApr\tMay\tJun\tJul\tAug\tSep\tOct\tNov\tDec";
		$G{DefaultEmailToAddy} = 'webmaster@' . $G{SelfDomain};
		$G{DefaultEmailToSubject} = "$Transfer{OfficialName} alert";
		$G{MaximumTotalUploadDataSize} = '1,048,576';
		$d =~ s/^www\.//;
		WriteConfig;
		return;
	}
	flock Rrc,LOCK_SH;
	while(<Rrc>)
	{
		chomp;
		my($k,$v) = split /\t/,$_,2;
		$v =~ s/\Q$Transfer{FlatLineBreakSub}\E/\n/gs;
		$G{$k} = $v;
	}
	close Rrc;
} # sub ReadConfig






sub CommaTabSeparatedList
{
	my $s = shift;
	$s =~ s/^[\s\,\t]*(.*?)[\s\,\t]*$/$1/s;
	$s =~ s/\t+/,/gs;
	$s =~ s/\s+,/,/gs;
	$s =~ s/,\s+/,/gs;
	return split /,+/,$s if trail(substr($d,1,1));
} # sub CommaTabSeparatedList




sub ExtractEmails
{
	my($filename,$putsptr) = @_;
	$In{EmailAddressSeparator} = ', ' unless $In{EmailAddressSeparator};
	$In{EmailAddressSeparator} =~ s/\\n/\n/gs;
	$In{EmailAddressSeparator} =~ s/\\t/\t/gs;
	my(%tracker,$p) = ();
	RetrievePage($filename,'Email template placeholder [[EMAILS FileName]]','',\$p);
	return unless $p;
	for my $line(split /\n/,$p)
	{
		next unless $line =~ /\@/;
		for(split /[\s\~\`\!\$\^\*\(\)\[\]\{\}\"\'\,\;\:]+/s,$line)
		{
			my $lc = lc $_;
			$$putsptr .= "$_$In{EmailAddressSeparator}" if (! $tracker{$lc}) and ValidEmail $_;
			$tracker{$lc} = 1;
		}
	}
	$$putsptr = substr $$putsptr,0,length($$putsptr) - length $In{EmailAddressSeparator};
} # sub ExtractEmails








sub JSize
{
	my $sptr = shift;
	ConformLineEndings $sptr;
	my @ta = split /\n+/,$$sptr;
	for(@ta)
	{
		s/\\/\\\\/g;
		s/\'/\\'/g;
		$_ = "document.write('$_');";
	}
	$$sptr = join "\n",@ta;
} # sub JSize




sub PresentTemporaryDownloadPage
{
	my $url = shift;
	my $page = '';
	if($G{DownloadPageTemplateURL})
	{
		RetrievePage($G{DownloadPageTemplateURL},'Message Download Web Page Template','',\$page);
	}
	else
	{
		$page = <<PAGE;
<html><head>
<meta http-equiv="refresh" content="0; URL=[[TEMPORARY_DOWNLOAD_URL]]">
</head><body>
<p style="margin:150px;">If download doesn't commence momentarily, 
<a href="[[TEMPORARY_DOWNLOAD_URL]]">click here.</a></p>
</body></html>
PAGE
	}
	RemoveExpiredLinks($url);
	$page =~ s/\[\[TEMPORARY_DOWNLOAD_URL[^\]]*\]\]/$url/sig;
	FixNextPage(\$page,'webpage');
	print "Content-type:text/html\n\n$page";
} # sub PresentTemporaryDownloadPage




sub MakeTemporaryFileURL
{
	my $filename = shift;
	return unless $filename;
	my $filecontent = '';
	RetrievePage($filename,"Temporary download link placeholder for file $filename",'',\$filecontent);
	$filename =~ m!([^/\\]+)$!;
	my $realfilename = $1;
	unless($filecontent or $realfilename)
	{
		$TmpDldFile{$filename} = '';
		return;
	}
	my $time = $Transfer{Time};
	my $tempdir = "$ENV{DOCUMENT_ROOT}$G{TDLdirectory}";
	open Wtempfilemovelock,'tempfilemovelock';
	flock Wtempfilemovelock,LOCK_EX;
	while((-e "$tempdir/$time") or (-e "$tempdir/${time}_$realfilename")) { $time++; }
	$TmpDldFile{$filename} = "http://$ENV{SERVER_NAME}$G{TDLdirectory}/$time";
	my $savefile = "$tempdir/$time";
	if(mkdir "$tempdir/$time",0777)
	{
		$savefile .= "/$realfilename";
		$TmpDldFile{$filename} .= "/$realfilename";
	}
	else
	{
		$savefile .= "_$realfilename";
		$TmpDldFile{$filename} .= "_$realfilename";
	}
	$In{' Temporary Download File Name Key For TmpDldFile '} = $filename;
	open Wtdl,">$savefile";
	# binmode Wtdl; ### for windows machines only
	print Wtdl $filecontent;
	close Wtdl;
	close Wtempfilemovelock;
} # sub MakeTemporaryFileURL




sub FixNextPage
{
	my($page,$pagetype) = @_;
	$page = \$P unless $page;
	# Replace uploaded file name placeholders with the actual file name.
	for(keys %Uploaded)
	{
		my($fieldName,$fileName,$storedfilename) = split /\t/,$Uploaded{$_};
		$fileName =~ s!^.*/!!;
		$$page =~ s/\[\[\Q$fieldName\E\]\]/$fileName/sg;
		$$page =~ s/<\!--\Q$fieldName\E-->/$fileName/sg;
	}
	my $tabHolder = chr(3);
	my %in = %In;
	if($pagetype =~ /web/i)
	{
		for(keys %In)
		{
			$In{$_} =~ s/\&/\&amp\;/g;
			$In{$_} =~ s/\"/\&quot\;/g;
			$In{$_} =~ s/\</\&lt\;/g;
			$In{$_} =~ s/\>/\&gt\;/g;
		}
		local * ToNBSP = sub
		{
			my $string = shift;
			$string =~ s/ /\&nbsp;/g;
			return $string;
		};
		if($pagetype =~ /web/i and $In{paragraphize} =~ /\w/)
		{
			$In{paragraphize} =~ s/^[,\s]*//;
			$In{paragraphize} =~ s/[,\s]*$//;
			for(split /[,\s]+/,$In{paragraphize})
			{
				$In{$_} =~ s/^\s*//s;
				$In{$_} =~ s/\s*$//s;
				if($In{$_} =~ /\n/) { $In{$_} =~ s/\r//g   }
				else                { $In{$_} =~ s/\r/\n/g }
				$In{$_} = '<p>' . join('</p><p>',split(/\n\n+/,$In{$_})) . '</p>';
				$In{$_} =~ s/\n/<br>/g;
				$In{$_} =~ s/ ( +)/ ToNBSP($1)/ge;
			}
		}
	}
	my %jsfields = ();
	if($In{JSfields} =~ /\w/ and $pagetype =~ /data/i)
	{
		for(CommaTabSeparatedList $In{JSfields}) { $jsfields{$_} = 1; }
	}
	my $s;
	my %h;
	trail(substr($d,3,1)) if $d;
	if($In{nocarry})
	{
		my @a = CommaTabSeparatedList($In{nocarry});
		for $s (@a) { $h{$s} = 1; }
		if($h{mailtemplate}) { $h{emailtemplate} = 1; }
		elsif($h{emailtemplate}) { $h{mailtemplate} = 1; }
	}
	$s = "\n";
	for(sort keys %In)
	{
		next if $h{$_};
		next unless $In{$_} =~ /\S/;
		my $in = $In{$_};
		$in =~ s/\Q$tabHolder\E/\t/g;
		$s .= "<input type=\"hidden\" name=\"$_\" value=\"$in\">\n";
	}
	while($$page =~ /\[\[(STRIPNONALPHA(?:LC)?)\:(.*?)\]\]/)
	{
		my($strip,$item) = ($1,$2);
		my $replacement = $In{$item};
		if($replacement)
		{
			$replacement =~ s/[^A-Za-z]//g;
			$replacement = lc $replacement if $strip eq 'STRIPNONALPHALC';
		}
		$$page =~ s/\[\[$1\:\Q$2\E\]\]/$replacement/g;
	}
	$$page =~ s/\[\[INSERT_HIDDEN_FIELDS\]\]/$s/sg;
	$$page =~ s/<\!--\s*INSERT_HIDDEN_FIELDS\s*-->/$s/sg;
	{
		my $script = $0;
		$script = $ENV{SCRIPT_FILENAME} unless $script =~ m!/!;
		$script = $ENV{REQUEST_URI} unless $script =~ m!/!;
		$script = $ENV{SCRIPT_NAME} unless $script =~ m!/!;
		$$page =~ s/\[\[SCRIPT_LOCATION\]\]/$script/sg;
	}
	# # # Order: %Mine COUNT SeparateWith() %In MATH if
	# # # %Mine (in order specified)
	my %mine = %Mine;
	for(sort keys %Mine)
	{
		my $qkey = quotemeta $_;
		JSize \$Mine{$_} if $jsfields{$_};
		$$page =~ s/(?:<\!--|\[\[)\s*$qkey\s*(?:-->|\]\])/$Mine{$_}/sg if substr($d,1,1) =~ /o/i;
	}
	# # # COUNT (in order specified)
	while($$page =~ m!(?:<\!--|\[\[)\s*COUNT( +)(.*?)\s*(?:-->|\]\])!)
	{
		my($space,$countfield) = ($1,$2);
		my $replace = quotemeta('COUNT'.$space.$countfield);
		my $replacement = 0;
		if($In{$countfield} =~ /\w/)
		{
			for(split /(\t|\Q$tabHolder\E)/,$In{$countfield}) { $replacement++ if /\w/; }
		}
		$$page =~ s!(?:<\!--|\[\[)\s*$replace\s*(?:-->|\]\])!$replacement!sg;
	}
	# # # SeparateWith() (in order specified)
	while($$page =~ m!(?:<\!--|\[\[)\s*([^\]<\[]*?)(\s*)(SeparateWith\()([^\)]*)(\).*?)\s*(?:-->|\]\])!s)
	{
		my($fieldname,$space,$beginstatement,$separation,$endstatement) = ($1,$2,$3,$4,$5);
		my $replace = quotemeta($fieldname.$space.$beginstatement.$separation.$endstatement);
		my @fn = ();
		for(split /\t/,$In{$fieldname}) { push @fn,$_ if /\S/; }
		my $fn = join $separation,@fn;
		$$page =~ s!(?:<\!--|\[\[)\s*$replace\s*(?:-->|\]\])!$fn!sg;
	}
	# # # %In (in order specified)
	for(sort keys %In)
	{
		my $qkey = quotemeta $_;
		my $in = $In{$_};
		$in =~ s/\Q$tabHolder\E/\t/g;
		JSize \$in if $jsfields{$_};
		$$page =~ s/(?:<\!--|\[\[)\s*$qkey\s*(?:-->|\]\])/$in/sg if substr($d,-5,1) =~ /e/i;
	}
	# # # MATH (in order specified)
	while($$page =~ m!(?:<\!--|\[\[)\s*MATH(\d*)( +)(.*?)\s*(?:-->|\]\])!)
	{
		my($decimal,$space,$operation) = ($1,$2,$3);
		my $replace = quotemeta('MATH'.$decimal.$space.$operation);
		for my $k (sort keys %In)
		{
			my $r = " $In{$k}";
			$r =~ s/^([^\d\.\-]*)([\d\.\,\-]*)(.*?)$/$2/;
			$r =~ s/,//g;
			$r = '0' unless $r =~ /\d/;
			$operation =~ s/\b\Q$k\E\b/$r/sg;
		}
		$operation =~ s/ x / * /gi;
		$operation =~ s/ xx / ** /gi;
		$operation =~ s/ r / % /gi;
		my $replacement = eval $operation;
		my $minus = $replacement < 0 ? 1 : 0;
		$replacement = abs $replacement;
		if($decimal =~ /^0$/) { $replacement = int $replacement + .5; }
		elsif($decimal =~ /\d/)
		{
			my $multiplicand = '1';
			for(1..$decimal) { $multiplicand .= '0'; }
			$replacement *= $multiplicand;
			$replacement = int $replacement + .5;
			$replacement /= $multiplicand;
		}
		my $pos = index($replacement,'.');
		my $tail = length($replacement) - $pos - 1;
		if($pos < 0)
		{
			$tail = 0;
			if($decimal > 0) { $replacement .= '.'; }
		}
		while($tail < $decimal)
		{
			$replacement .= '0';
			$tail++;
		}
		$replacement = '-' . $replacement if $minus;
		$$page =~ s!(?:<\!--|\[\[)\s*$replace\s*(?:-->|\]\])!$replacement!sg;
	}
	# # # ifnot (in order specified)
	while($$page =~ m!(?:<\!--|\[\[)\s*(ifnot)_(.*?)\s*(?:-->|\]\])!)
	{
		my($ifnotss,$ss) = ($1,$2);
		my($ifnots,$s) = (quotemeta $ifnotss,quotemeta $ss);
		if($Mine{$ss} =~ /\S/ or $In{$ss} =~ /\S/)
		{
			$$page =~ s!(?:<\!--|\[\[)\s*${ifnots}_${s}\s*(?:-->|\]\]).*?(?:<\!--|\[\[)\s*/${ifnots}_${s}\s*(?:-->|\]\])!!sg;
		}
		else
		{
			$$page =~ s!(?:<\!--|\[\[)\s*/?${ifnots}_${s}\s*(?:-->|\]\])!!sg;
		}
	}
	# # # if (in order specified)
	while($$page =~ m!(?:<\!--|\[\[)\s*(if)_(.*?)\s*(?:-->|\]\])!)
	{
		my($ifss,$ss) = ($1,$2);
		my($ifs,$s) = (quotemeta $ifss,quotemeta $ss);
		if($Mine{$ss} =~ /\S/ or $In{$ss} =~ /\S/)
		{
			$$page =~ s!(?:<\!--|\[\[)\s*${ifs}_${s}\s*(?:-->|\]\])!!sg;
			$$page =~ s!(?:<\!--|\[\[)\s*/${ifs}_${s}\s*(?:-->|\]\])!!sg;
		}
		elsif($$page =~ m!(?:<\!--|\[\[)\s*/${ifs}_${s}\s*(?:-->|\]\])!)
		{
			$$page =~ s!(?:<\!--|\[\[)\s*${ifs}_${s}\s*(?:-->|\]\]).*?(?:<\!--|\[\[)\s*/${ifs}_${s}\s*(?:-->|\]\])!!sg;
		}
		else
		{
			$$page =~ s!(?:<\!--|\[\[)\s*${ifs}_${s}\s*(?:-->|\]\])!!sg;
		}
	}
	while($$page =~ /\[\[(EMAILS[\s_]*)(.*?)\]\]/s)
	{
		my($replacement,$filename) = ($1,$2);
		$replacement = quotemeta "$replacement$filename";
		RemoveWhiteFromEnds \$filename;
		my $bcc = '';
		ExtractEmails $filename,\$bcc;
		$$page =~ s/\[\[$replacement\]\]/$bcc/s;
	}
#	# Create temporary download links. TEMPORARY_DIRECT_DOWNLOAD_URL
#	while(0) #(no longer used) # while($$page =~ /\[\[\s*TEMPORARY_DIRECT_DOWNLOAD_URL\s+([^\]\]]+)\]\]/)
#	{
#		my $file = $1;
#		$file =~ s/\s*$//s;
#		$TmpDldFile{$file} = $In{' Temporary Download Link '} ? $TmpDldFile{$file} : '~';
#		MakeTemporaryFileURL $file unless $TmpDldFile{$file};
#		$$page =~ s/\[\[\s*TEMPORARY_DOWNLOAD_URL\s+\Q$file\E\s*\]\]/$TmpDldFile{$file}/sg;
#	}
#	# TEMPORARY_MESSAGE_DOWNLOAD_URL (old placeholder)
	while($$page =~ /\[\[\s*TEMPORARY_DOWNLOAD_URL\s+([^\]\]]+)\]\]/)
	{
		my $file = $1;
		$file =~ s/\s*$//s;
		$TmpDldFile{$file} = $In{' Temporary Download Link '} ? $TmpDldFile{$file} : '~';
		MakeTemporaryFileURL $file,'yes' unless $TmpDldFile{$file};
		$G{FormProcessorLocation} = 'Please specify the absolute URL of the form processing script at the "Temporary Download Links" control panel page.' unless $G{FormProcessorLocation};
		my $url = $TmpDldFile{$file};
		$url =~ s!^\Qhttp://$ENV{SERVER_NAME}$G{TDLdirectory}/\E!!;
		$url =~ s!/!!;
		$url = "$G{FormProcessorLocation}?download=$url";
		$$page =~ s/\[\[\s*TEMPORARY_DOWNLOAD_URL\s+\Q$file\E\s*\]\]/$url/sg;
	}
	$$page =~ s/\[\[.*?\]\]//gs;
	$$page =~ s/\[\-\[(.*?)\]\-\]/[[${1}]]/gs;
	%In = %in;
	%Mine = %mine;
} # sub FixNextPage





sub GetPage
{
	my ($url,$contentptr) = @_;
	my ($success,$code,$content) = ();
	$contentptr = \$content unless $contentptr;
	my $ua = LWP::UserAgent->new;
	my $r = $ua->request(GET $url);
	$success = $r->is_success if $r->is_success;
	$$contentptr = $r->content if $r->content;
	$code = $r->code if $r->code;
	return ($success,$code,$content);
} # sub GetPage



sub PostPage
{
	my ($url,$hashptr,$contentptr) = @_;
	my ($success,$code,$content) = ();
	$contentptr = \$content unless $contentptr;
	my $ua = LWP::UserAgent->new;
	my $r = $ua->request(POST $url,$hashptr);
	$success = $r->is_success if $r->is_success;
	$$contentptr = $r->content if $r->content;
	$code = $r->code if $r->code;
	return ($success,$code,$content);
} # sub PostPage





sub RetrievePage
{
	my ($location,$from,$errorpage,$page) = @_;
	SilentFail unless FileWhiteListed($location,'read');
	$page = \$P unless $page;
	$$page = '';
	return unless $location =~ /\w/;
	my $noLWP = '';
	my $newplace = $location;
	$newplace =~ s!^https?://!!i;
	$newplace =~ s!^.*?/!/!;
	my @e = ();
	if($location =~ m!^http://\w!i)
	{
		my ($success,$code) = GetPage $location,$page;
		push @e,$!,qq~Sorry, can't retrieve URL <a href="$location">$location</a> as specified in $from -- $code~ unless $success;
	}
	elsif($location =~ m!^https://!i)
	{
		push @e,qq~Master Form V4 can't retrieve pages from a secure server with an https://... URL. Either put the page where an http://... URL can retrieve it or have $from specify the server directory location where the page can be found &#151; which might be: $newplace~;
	}
	else
	{
		my $newloc = $location;
		$newloc =~ s!\.\./!!g;
		if( $newloc =~ m!^/! )
		{
			$newloc =~ s!^$ENV{DOCUMENT_ROOT}!!;
			$newloc = $ENV{DOCUMENT_ROOT}.$newloc;
		}
		unless(open mfRrp,"<$newloc")
		{
			$newloc = "$Transfer{ThisDirectory}/$newloc";
			push @e,qq~Sorry, can't open file $location as specified in $from -- $!~ unless open mfRrp,"<$newloc";
		}
		binmode mfRrp;
		unless(@e)
		{
			local $/;
			$$page = <mfRrp>;
			close mfRrp;
		}
	}
	return unless @e;
	my @ee = @e;
	for(@ee) { s/<.*?>//gs; }
	WebmasterNotice @ee;
	if($errorpage) { return @e; }
	else { ErrorHTML(@e) if @e; }
} # sub RetrievePage




sub WriteFile
{
	my($filename,$overwrite,$firstlineptr,$contentptr) = @_;
	SilentFail unless FileWhiteListed($filename,'write');
	$filename =~ s/^[\s"]*(.*?)[\s"]*$/$1/s;
	$filename =~ s!\.\./!!g;
	my $hasslash = $filename =~ m!/!;
	my $directory = '';
	$directory = $1 if $filename =~ s!^(.*)/!!;
	if($directory and (! -e $directory))
	{
		my $okay = '';
		if($directory =~ m!^/!) { $okay = MakeDirectory $directory; }
		else { $okay = MakeDirectory $Transfer{ThisDirectory},$directory; }
		unless($okay)
		{
			my $notice = <<NOTICE;
Unable to create directory $directory for writing file 
$filename

The directory may need to be created manually.

If file $filename isn't then created in the directory, try these 
$directory directory permissions, in order, using the form 
between each for testing:
		755
			766
				777
NOTICE
			WebmasterNotice $notice;
			return ErrorHTML q~Unable to create database directory.~,q~A message with more information has been sent to the webmaster's notification email address.~;
		}
	}
	unless($directory) { $directory = '/' if $hasslash; }
	if($directory =~ m!^/!) { $directory = "$ENV{DOCUMENT_ROOT}$directory"; }
	else { $directory = "$Transfer{ThisDirectory}/$directory"; }
	my ($openokay,$writeokay) = ();
	my $new = ($overwrite or (! -e "$directory/$filename"));# ? 1 : '';
	LockFile "$directory/$filename";
	if($new) { $openokay = open Watf,">$directory/$filename";  }
	else
	{
		$openokay = open Watf,">>$directory/$filename";
		$$firstlineptr = '';
	}
	flock Watf,LOCK_EX;
	$writeokay = print Watf "$$firstlineptr$$contentptr";
	close Watf;
	UnLockFile "$directory/$filename";
	my $notice = '';
	if(! $openokay) { $notice = "Unable to open file $filename for writing.\n\n"; }
	elsif(! $writeokay) { $notice = "Unable to write to file $filename\n\n"; }
	if($notice)
	{
		$notice .= <<NOTICE;
The directory $directory might not have correct permissions. 
Try these permissions, in order, testing between each:
		755
			766
				777
NOTICE
		WebmasterNotice $notice;
		ErrorHTML q~Unable to write database file.~,q~A message with more information has been sent to the webmaster's notification email address.~;
	}
} # sub WriteFile










sub FlockDBfile
{
	my($directory,$file) = @_;
	$directory =~ s!/*$!!;
	$directory .= '/' if $directory;
	my $flockfile = "$directory${file}.flockfile";
	my $filehandle = "FLOCK$file";
	$filehandle =~ s/\W//g;
	my $donedidit = '';
	eval "\$donedidit = sysopen($filehandle,\$flockfile,O_RDONLY|O_CREAT)";
	die "Sorry, can't sysopen $flockfile (file handle $filehandle) -- $@" unless $donedidit;
	# die "Sorry, can't flock lock $flockfile (file handle $filehandle) -- $!" unless flock($filehandle,LOCK_EX|LOCK_NB);
	eval "flock($filehandle,LOCK_EX|LOCK_NB)";
###	flock($filehandle,LOCK_EX|LOCK_NB);
} # sub FlockDBfile
sub UnFlockDBfile { my $file = shift; eval "close FLOCK$file"; }

sub UnTieDBfile
{
	my ($file,$dbptr) = @_;
	return unless $TiedDBtracker{$file};
	delete $TiedDBtracker{$file};
	my $filehandle = "FLOCK$file";
	$filehandle =~ s/\W//g;
	UnFlockDBfile $filehandle;
	untie %$dbptr;
} # sub UnTieDBfile

sub TieDBfile
{
	my($directory,$file,$dbptr) = @_;
	return if $TiedDBtracker{$file};
	$TiedDBtracker{$file} = 1;
	$directory =~ s!/*$!!;
	$directory .= '/' if $directory;
	FlockDBfile $directory,$file;
	UnTieDBfile $file,$dbptr unless tie(%$dbptr,$G{whichDB},"$directory$file",O_RDWR|O_CREAT,0666);
} # sub TieDBfile






sub RecordFormLocation
{
	return unless $ENV{HTTP_REFERER};
	my %mine;
	TieDBfile $Transfer{DataDirectory},$FormTracksFileName,\%mine;
	$mine{$ENV{HTTP_REFERER}} = $Transfer{Time};
	UnTieDBfile $FormTracksFileName,\%mine;
} # sub RecordFormLocation


sub RetrieveFormLocations
{
	my $hptr = shift;
	my %h = ();
	my %mine;
	TieDBfile $Transfer{DataDirectory},$FormTracksFileName,\%mine;
	if($hptr) { %$hptr = %mine; }
	else { %h = %mine; }
	UnTieDBfile $FormTracksFileName,\%mine;
	return if $hptr;
	return %h;
} # sub RetrieveFormLocations


sub DeleteFormLocationRecords
{
	my @recs = @_;
	my %mine;
	TieDBfile $Transfer{DataDirectory},$FormTracksFileName,\%mine;
	for(@recs) { delete $mine{$_}; }
	UnTieDBfile $FormTracksFileName,\%mine;
} # sub DeleteFormLocationRecords


sub DeleteFormLocationDatabase
{
	unlink "$Transfer{DataDirectory}/$FormTracksFileName";
	unlink "$Transfer{DataDirectory}/$FormTracksFileName\.db";
	unlink "$Transfer{DataDirectory}/$FormTracksFileName\.pag";
	unlink "$Transfer{DataDirectory}/$FormTracksFileName\.dir";
	unlink "$Transfer{DataDirectory}/$FormTracksFileName\.flockfile";
} # sub DeleteFormLocationDatabase






# IncrementSequentialNumber
sub IncrementSerialNumber
{
	my $number = shift;
	my $placeholder = chr(5);
	$number .= '0' unless $number =~ /\d/;
	$number = reverse $number;
	$number =~ s/(\d+)/$placeholder/;
	$number = reverse $number;
	my $innernumber = reverse $1;
	$innernumber++;
	$number =~ s/\Q$placeholder\E/$innernumber/;
	return $number;
} # sub IncrementSerialNumber




sub RecordNumberSequenceAndReturnNextNumber
{
	my ($id,$startnumber) = @_;
	return unless $id =~ /\w/;
	my %mine;
	TieDBfile $Transfer{DataDirectory},$SequencialNumbersFileName,\%mine;
	my ($firstdate,$firstnumber,$lastdate,$lastnumber,$lastknownreferrer) = split /\t/,$mine{$id};
	if($firstdate)
	{
		$lastdate = $Transfer{Time};
		$lastnumber = IncrementSerialNumber $lastnumber;
	}
	else
	{
		$firstdate = $lastdate = $Transfer{Time};
		if($startnumber =~ /\w/)
		{
			$startnumber .= '0' unless $startnumber =~ /\d/;
			$firstnumber = $lastnumber = $startnumber;
		}
		else { $firstnumber = $lastnumber = '1'; }
	}
	$lastknownreferrer = $ENV{HTTP_REFERER} if $ENV{HTTP_REFERER};
	$mine{$id} = join "\t",$firstdate,$firstnumber,$lastdate,$lastnumber,$lastknownreferrer;
	UnTieDBfile $SequencialNumbersFileName,\%mine;
	return $lastnumber;
} # sub RecordNumberSequenceAndReturnNextNumber


sub RetrieveNumberSequences
{
	my $hptr = shift;
	my %h = ();
	my %mine;
	TieDBfile $Transfer{DataDirectory},$SequencialNumbersFileName,\%mine;
	if($hptr) { %$hptr = %mine; }
	else { %h = %mine; }
	UnTieDBfile $SequencialNumbersFileName,\%mine;
	return if $hptr;
	return %h;
} # sub RetrieveNumberSequences


sub DeleteNumberSequenceRecords
{
	my @recs = @_;
	my %mine;
	TieDBfile $Transfer{DataDirectory},$SequencialNumbersFileName,\%mine;
	for(@recs) { delete $mine{$_}; }
	UnTieDBfile $SequencialNumbersFileName,\%mine;
} # sub DeleteNumberSequenceRecords


sub DeleteNumberSequenceDatabase
{
	unlink "$Transfer{DataDirectory}/$SequencialNumbersFileName";
	unlink "$Transfer{DataDirectory}/$SequencialNumbersFileName\.db";
	unlink "$Transfer{DataDirectory}/$SequencialNumbersFileName\.pag";
	unlink "$Transfer{DataDirectory}/$SequencialNumbersFileName\.dir";
	unlink "$Transfer{DataDirectory}/$SequencialNumbersFileName\.flockfile";
} # sub DeleteNumberSequenceDatabase





sub WindowOpenLength
{
	my $openlength = 0;
	my @parts = split / +/,$G{ASPMwindowOpen};
	for(@parts)
	{
		my $multiplicand = 60;
		if(/H$/) { $multiplicand = (60*60); }
		elsif(/D$/) { $multiplicand = (60*60*24); }
		$openlength += int $_ * $multiplicand;
	}
	$openlength = (30*60) unless $openlength > 0;
	return $openlength + int $G{ASPMwindowDelay};
} # sub WindowOpenLength



sub RecordFormLoadInformation
{
	my($fieldname,$fieldvalue) = @_;
	return unless $ENV{REMOTE_ADDR} =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
	my %mine;
	my @rec = ();
	$rec[$RecordFormLoadInformation{fieldname}] = $fieldname;
	$rec[$RecordFormLoadInformation{fieldvalue}] = $fieldvalue;
	$rec[$RecordFormLoadInformation{loadtime}] = $Transfer{Time};
	$rec[$RecordFormLoadInformation{loadip}] = $ENV{REMOTE_ADDR};
	$rec[$RecordFormLoadInformation{loadreferrer}] = $ENV{HTTP_REFERER};
	$rec[$RecordFormLoadInformation{loadua}] = $ENV{HTTP_USER_AGENT};
	TieDBfile $Transfer{DataDirectory},$FormLoadInformation,\%mine;
	$mine{$fieldname} = join "\t",@rec;
	UnTieDBfile $FormLoadInformation,\%mine;
} # sub RecordFormLoadInformation


sub GetAllFormLoadInformation
{
	my %rethash = ();
	my %mine;
	TieDBfile $Transfer{DataDirectory},$FormLoadInformation,\%mine;
	%rethash = %mine;
	UnTieDBfile $FormLoadInformation,\%mine;
	return %rethash;
} # sub GetAllFormLoadInformation


sub PassedASPMcheck
{
	my $InList = shift;
	return '' unless $ENV{REMOTE_ADDR} =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/;
	my (@delthis,@rec,$difference) = ();
	my %mine;
	TieDBfile $Transfer{DataDirectory},$FormLoadInformation,\%mine;
	for(@$InList)
	{
		next unless $mine{$_};
		push @delthis,$_;
		@rec = split /\t/,$mine{$_};
		$rec[$RecordFormLoadInformation{submittime}] = $Transfer{Time};
		$rec[$RecordFormLoadInformation{submitip}] = $ENV{REMOTE_ADDR};
		$rec[$RecordFormLoadInformation{JSseconds}] = $In{$rec[$RecordFormLoadInformation{fieldvalue}]};
		$rec[$RecordFormLoadInformation{JSpageURL}] = $In{"$rec[$RecordFormLoadInformation{fieldvalue}]jsurl"};
		$rec[$RecordFormLoadInformation{submitreferrer}] = $ENV{HTTP_REFERER};
		$rec[$RecordFormLoadInformation{submitua}] = $ENV{HTTP_USER_AGENT};
		last;
	}
	if($difference >= $G{ASPMwindowDelay}) { for(@delthis) { delete $mine{$_}; } }
	UnTieDBfile $FormLoadInformation,\%mine;
	$difference = $rec[$RecordFormLoadInformation{submittime}] - $rec[$RecordFormLoadInformation{loadtime}];
	$Mine{IP} = $rec[$RecordFormLoadInformation{loadip}];
	$In{' . Elapsed . '}        = $difference;
	$In{' . JSpageURL . '}      = $rec[$RecordFormLoadInformation{JSpageURL}];
	$In{' . LoadReferrer . '}   = $rec[$RecordFormLoadInformation{loadreferrer}];
	$In{' . SubmitReferrer . '} = $rec[$RecordFormLoadInformation{submitreferrer}];
	$In{' . LoadUA . '}         = $rec[$RecordFormLoadInformation{loadua}];
	$In{' . SubmitUA . '}       = $rec[$RecordFormLoadInformation{submitua}];
	$In{' . LoadIP . '}         = $rec[$RecordFormLoadInformation{loadip}];
	$In{' . SubmitIP . '}       = $rec[$RecordFormLoadInformation{submitip}];
	$In{' . JStime . '}         = $rec[$RecordFormLoadInformation{JSseconds}];
	$In{' . LoadTime . '}       = $rec[$RecordFormLoadInformation{loadtime}];
	$In{' . SubmitTime . '}     = $rec[$RecordFormLoadInformation{submittime}];
	$In{' . HandleName . '}     = $rec[$RecordFormLoadInformation{fieldname}];
	$In{' . HandleValue . '}    = $rec[$RecordFormLoadInformation{fieldvalue}];
	for(@RecordFormLoadInformation) { $In{' . MonitorRecord . '} .= "$_=$rec[$RecordFormLoadInformation{$_}]\n"; }
	return '' if $difference < $G{ASPMwindowDelay};
	return '' if $difference > WindowOpenLength;
	return '' unless $rec[$RecordFormLoadInformation{JSseconds}] > 0;
	return '' if length $rec[$RecordFormLoadInformation{JSpageURL}] < 4;
	return 1;
} # sub PassedASPMcheck



sub RemoveOldFormLoadInformation
{
	my %mine;
	my @delthis = ();
	my $windowopenlength = WindowOpenLength;
	TieDBfile $Transfer{DataDirectory},$FormLoadInformation,\%mine;
	while(my($k,$v) = each %mine)
	{
		my @rec = split /\t/,$v;
		push @delthis,$k if $windowopenlength + $rec[$RecordFormLoadInformation{loadtime}] < $Transfer{Time};
	}
	for(@delthis) { delete $mine{$_}; }
	UnTieDBfile $FormLoadInformation,\%mine;
} # sub RemoveOldFormLoadInformation


sub DeleteFormLoadDatabase
{
	unlink "$Transfer{DataDirectory}/$FormLoadInformation";
	unlink "$Transfer{DataDirectory}/$FormLoadInformation\.db";
	unlink "$Transfer{DataDirectory}/$FormLoadInformation\.pag";
	unlink "$Transfer{DataDirectory}/$FormLoadInformation\.dir";
	unlink "$Transfer{DataDirectory}/$FormLoadInformation\.flockfile";
} # sub DeleteFormLoadDatabase




sub CheckForBlockedIPaddress
{
	my $silent = shift;
	return 1 unless $ENV{REMOTE_ADDR} =~ /\d/;
	my @currentIP = split /\./,$ENV{REMOTE_ADDR};
	return 1 unless $#currentIP == 3;
	for(@currentIP) { return 1 unless /^\d{1,3}$/; }
	my $found = '';
	for my $ip (split /\n/,$G{BlockIPaddys})
	{
		my $matches = 0;
		my @parts = split /\./,$ip;
		next unless $#parts == 3;
		for my $piece (0..3)
		{
			if($parts[$piece] eq '*') { $matches++; next; }
			if($parts[$piece] =~ /-/)
			{
				my($low,$high) = split /-/,$parts[$piece];
				$low = 0 unless $low =~ /\d/;
				$high = 999 unless $high =~ /\d/;
				($low,$high) = ($high,$low) unless $low <= $high;
				if($currentIP[$piece] >= $low and $currentIP[$piece] <= $high) { $matches++; next; }
			}
			if($parts[$piece] eq $currentIP[$piece]) { $matches++; next; }
		}
		if($matches == 4) { $found = 1; last; }
	}
	return $found if $silent;
	return $found unless $found;
	$In{exitnow} = 'yes';
	return unless $G{WebPageToDisplayUponBlocked} =~ /\w/;
	$In{BADIP} = $ENV{REMOTE_ADDR};
	my $page = '';
	RetrievePage($G{WebPageToDisplayUponBlocked},'"Blocked IP address found" page','',\$page);
	FixNextPage \$page,'web' if $page =~ /\[\-?\[/;
	ContentHeader;
	print "\n$page";
	return $found;
} # sub CheckForBlockedIPaddress








sub RemoveTemporaryInstallMonitorFiles
{
	opendir D,$Transfer{DataDirectory};
	my @d = grep /\.download\.monitor\.txt$/,readdir D;
	for(@d) { unlink "$Transfer{DataDirectory}/$_" if(-M "$Transfer{DataDirectory}/$_") > .125; }
} # sub RemoveTemporaryInstallMonitorFiles


sub RemoveTemporaryDownloadFiles
{
	my $grepper = quotemeta $Transfer{TempFileName};
	$grepper =~ s/\\\{randomnumber\\\}/9/;
	$grepper =~ s/\\\{FILENAME\\\}/\.\+\?/;
	$grepper =~ s/\d+/\\d\+/;
	opendir D,$Transfer{DataDirectory};
	my @d = grep /^$grepper$/,readdir D;
	closedir D;
	for(@d) { unlink "$Transfer{DataDirectory}/$_" if(-M "$Transfer{DataDirectory}/$_") > .1; }
} # sub RemoveTemporaryDownloadFiles


sub RemoveExpiredLinks
{
	my $agedays = shift;
	my $minutes = 0;
	my %g = ();
	$g{TDLdirectory} = $G{TDLdirectory};
	$g{TDLdirectory} =~ s!^/!!;
	$g{TDLdirectory} = 'TmpDld' unless $g{TDLdirectory} =~ /\w/;
	if($agedays > 0) { $minutes = $agedays * 24 * 60; }
	else
	{
		for (split /[, \+]+/,$G{TDLtiming})
		{
			next unless /\d/;
			if(/:/)
			{
				my($h,$m) = split /:/;
				$minutes += (60 * $h) + $m;
			}
			else { $minutes += $_ * 24 * 60; }
		}
	}
	my $cutoff = $Transfer{Time} - ($minutes * 60);
	opendir D,"$ENV{DOCUMENT_ROOT}/$g{TDLdirectory}";
	my @dlist = readdir D;
	closedir D;
	for my $f (@dlist)
	{
		next unless $f > 0 and $f < $cutoff;
		unless(-d "$ENV{DOCUMENT_ROOT}/$g{TDLdirectory}/$f")
		{
			unlink "$ENV{DOCUMENT_ROOT}/$g{TDLdirectory}/$f";
			next;
		}
		opendir D,"$ENV{DOCUMENT_ROOT}/$g{TDLdirectory}/$f";
		my @flist = readdir D;
		closedir D;
		for(@flist)
		{
			next if /^\.\.?$/;
			unlink "$ENV{DOCUMENT_ROOT}/$g{TDLdirectory}/$f/$_";
		}
		rmdir "$ENV{DOCUMENT_ROOT}/$g{TDLdirectory}/$f";
	}
} # sub RemoveExpiredLinks


sub RemoveTemporaryFilesAndSuch
{
	RemoveExpiredLinks;
	RemoveTemporaryDownloadFiles;
	RemoveOldFormLoadInformation;
	RemoveTemporaryInstallMonitorFiles;
} # sub RemoveTemporaryFilesAndSuch



1;