#!/usr/bin/perl --
# -*-mode: Perl; tab-width: 4 -*-

my $relVersion = "1.0.9dev20010226";

############################################################################
# Soupermail
#
# Internal build version:
# $Id: soupermail.pl,v 1.143 2001/02/26 10:37:22 aithalv Exp $
#
# Soupermail. A whacky and powerful WWW to Email form handler.
# Copyright (C) 1998, 1999, 2000, 2001 
#			   Vittal Aithal <vittal.aithal@bigfoot.com>
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2 of the License, or (at your
# option) any later version.
#
# This program is distributed in the hope that it will be useful, but 
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See 
# the GNU General Public License for more details. You should have received 
# a copy of the GNU General Public License along with this program; if not,
# write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, 
# MA 02139, USA.
#
############################################################################

############################################################################
# Set up the modules soupermail uses - these should all be perl5 standard
############################################################################
use lib qw(.);
use CGI;
use FileHandle;
use File::Copy;
use Fcntl qw(:DEFAULT :flock);
use Time::Local;
use POSIX qw(floor);
use MIME::Lite;
use strict;
use 5.004;

# Not all systems will have DBI, so eval to trap.
eval('use DBI;');
my $hasDbi = ($@ ? 0 : 1);

BEGIN {
	if ($^O =~ /MSWin/i) {
		require Win32::File;
		import Win32::File;
	}
}


############################################################################
my ($soupermailAdmin, $serverRoot, $mailprog, $mailhost, 
	$tempDir, $debug, $lout, $loutOpts, $pgpSet, $privateRoot, $forkable,
	$fhBug, $uploadTimeout, $ps2pdf, $fileLocking, $smtpPoolSize, $paranoid) = "";
############################################################################

############################################################################
# ---CHANGE ME FOR YOUR SITE---
# This is who to mail when soupermail goes wrong
# PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE
# PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE
# PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE
# CHANGE THIS!!!
# I REALLY DON'T WANT TO GET ADMIN EMAILS ABOUT YOUR SITE!!!!
############################################################################
$soupermailAdmin = 'vittal.aithal@bigfoot.com';

############################################################################
# ---CHANGE ME FOR YOUR SITE---
# This is where the webserver's document tree starts
# Do NOT include a trailing '/' character
#
# Some examples:
#	$serverRoot = 'c:/inetpub/wwwroot';		# Default NT/IIS setup
#	$serverRoot = $ENV{'DOCUMENT_ROOT'};	# May work on some webservers
#	$serverRoot = '/home/www/html';			# A typical UNIX setting
############################################################################
$serverRoot = $ENV{'DOCUMENT_ROOT'};


############################################################################
# ---CHANGE ME FOR YOUR SITE---
# If you want to hide your config files from people browsing your site,
# provide a path OUTSIDE your server root here.
#
# Some examples:
#   $privateRoot = "c:/inetpub/private";
############################################################################
$privateRoot = "/home/httpd/soupermail.sourceforge.net/private";


############################################################################
# Program locations. These will vary from site to site, so check that
# they're there and setup as appropriate
############################################################################

############################################################################
# ---CHANGE ME FOR YOUR SITE---
# To send outgoing mail, soupermail needs an SMTP mailserver to talk to.
# If you don't know the address of a suitable mailserver, ask your ISP
# or a system administrator. If you don't have a mailserver handy, you
# can use sendmail.
# If you indend to use the maillist features, I suggest you use a mailhost
# since it is probably faster.
#
# Some examples: 
#	$mailhost = 'localhost';				# Local SMTP server for NT
#	$mailprog = '';							# No mail program for NT
#
#	$mailhost = '';							# No SMTP host for UNIX
#	$mailprog = '/usr/lib/sendmail';		# Local sendmail for UNIX
############################################################################
$mailhost = 'localhost';
$mailprog = '/usr/lib/sendmail';


############################################################################
# ---CHANGE ME FOR YOUR SITE---
# The program to do pgp encryption. This was tested with PGP 5.0i 
# and GNU Privacy Guard 1.0.4 on my home Linux box, your milage 
# may vary with others.
# Set up the versions of GPG and/or pgp you have on your server
# here.
############################################################################
$pgpSet = {
	'gpg'	=> '/usr/local/bin/gpg',
	'pgp2'	=> '/usr/local/bin/pgp2.6.3',
	'pgp5'	=> '/usr/local/bin/pgpe',
};

############################################################################
# ---CHANGE ME FOR YOUR SITE---
# These are the programs needed to generate PDFs
# $ps2pdf is the location of the ps2pdf command
# $lout is the location of the lout executable
# Safe to comment out if they're not used
#
# Some examples:
#	Ghostscript and lout settings for NT
#	$ps2pdf = 'c:/gstools/gs5.50/ps2pdf.bat';
#	$lout = 'c:/lout/3.17/lout.exe';
############################################################################
# Ghostscript and lout settings for UNIX
$ps2pdf = '/usr/bin/ps2pdf';
$lout = '/usr/local/bin/lout';

############################################################################
# ---CHANGE ME FOR YOUR SITE---
# Where to write out temporary files. If you're using PGP, or making
# PDFs, several files will be generated in a sudirectory off here. 
# Include a trailing '/' character.
#
# Some examples:
#	$tempDir = 'c:/temp/';	# Default temp area on NT
############################################################################
$tempDir = '/var/tmp/';

############################################################################
# Uncomment this to see what soupermail's doing.
# On a production server make sure its commented out.
############################################################################
$debug = "";
#$debug = "${tempDir}soupermaillog";

############################################################################
# If your machine doesn't have fork() support, try setting this to 0
############################################################################
$forkable = 1;

############################################################################
# If you have trouble uploading files, try setting this to 1
# FreeBSD users may well need to do this
############################################################################
$fhBug = 1;

############################################################################
# If you are uploading large files, and soupermail's timing out, then
# increase this value. The units are seconds
############################################################################
$uploadTimeout = 100;

############################################################################
# This stuff is for PDF generation
############################################################################
$loutOpts = " -S";

############################################################################
# $maxbytes is the maximum number of bytes allowed to be uploaded.
# Its not very cleverly handled at the moment, but what can you do.
############################################################################
my ($maxbytes) = 102400;

############################################################################
# $maxdownload is the maximum number of bytes allowed to be downloaded.
############################################################################
my ($maxdownload) = 10240000;

############################################################################
# To prevent problems when lots of people are submiting fileto forms at
# the same time, file locking can be used. However - NT may screw up.
############################################################################
$fileLocking = 1;

############################################################################
# If you are sending out a large mailing list to several hundred addresses
# and you find that mailing stops after a while, you may have to increase
# this value. Check your SMTP server's maximum messages per connection to
# get a feel for the value.
############################################################################
$smtpPoolSize = 20;

############################################################################
# Paranoid should be used where people other than yourself have access to
# your server. i.e. Other people can put content on some part of your 
# server. At worst case the person would write their own config files,
# and read data from your server. Setting $paranoid to 1 prevents
# Soupermail from reading files from a directory, unless that directory
# contains a file called soupermail.allow
############################################################################
$paranoid = 1;

############################################################################
# Right, that in theory is the end of anything you have to configure in
# soupermail.pl - the rest's generic... well, maybe :)
#
# HOWEVER - remember you'll have to write config files for your forms -
# so now would be a good time to ==> READ THE MANUAL!! <==
# Just to repeat... READ THE MANUAL, READ THE MANUAL, READ THE MANUAL
# If things are going wrong, also READ THE FAQ AND THE HELP FORUM!!!!
#
# http://soupermail.sourceforge.net/manual.html
# http://soupermail.sourceforge.net/faq.html
# http://sourceforge.net/forum/forum.php?forum_id=342
#
# Very important that stuff, Soupermail's complex, and takes time to learn,
# please try to read about it BEFORE using it.
############################################################################



############################################################################
# Set up some global constants
############################################################################

############################################################################
# Useful month shortcuts
############################################################################
my (%MONTHS) = 
	('Jan','01','Feb','02','Mar','03','Apr','04','May','05','Jun','06',
	 'Jul','07','Aug','08','Sep','09','Oct','10','Nov','11','Dec','12');


############################################################################
# We may be generating cookies, and they'll live in %cookieList
# $cookieStr determines how many cookies we're allowing (9 by default)
############################################################################
my (%cookieList) = ();
my ($cookieStr) = 'cookie([1-9][0-9]*)';


############################################################################
# Other globals
############################################################################
my ($pageRoot, $config, %CONFIG, @required, @typeChecks, $configRoot,
	$query, $child, @bindVals, %sqlVals, %sqlCount, @listSql, $base);
my $parent = $$;
my @ignored = ('SoupermailConf');
my $CRLF = "\015\012";


############################################################################
# Some default configuration values
############################################################################
my $today				= time;
$CONFIG{'expirydate'}	= $today;
$CONFIG{'subject'}->{"DEFAULT"}		= "Form Submission";
$CONFIG{'pgpuploads'}->{"DEFAULT"}	= 1;
$CONFIG{'pgppdfs'}->{"DEFAULT"}		= 1;
$CONFIG{'pgpdynamics'}->{"DEFAULT"}	= 1;
$CONFIG{'pgptextmode'}->{"DEFAULT"} = 0;
$CONFIG{'pgpmime'}->{"DEFAULT"}		= 1;
$CONFIG{'alphasort'}->{"DEFAULT"}	= 1;
$CONFIG{'pgpversion'}->{"DEFAULT"}	= 'gpg';
$CONFIG{'mimeon'}->{"DEFAULT"}		= 0;
$CONFIG{'mailcharset'}->{"DEFAULT"}	= "iso-8859-1";
$CONFIG{'error'}		= "";
$CONFIG{'successcookie'}= 1;
$CONFIG{'failurecookie'}= 0;
$CONFIG{'blankcookie'}	= 0;
$CONFIG{'expirescookie'}= 0;
$CONFIG{'cgiwrappers'}	= 0;
$CONFIG{'counter'}		= {};
$CONFIG{'sendercharset'}= 'iso-8859-1';
$CONFIG{'listcharset'}	= 'iso-8859-1';
$CONFIG{'encoding'}		= '8BIT';
$CONFIG{'encodesubjects'}= 0;
$CONFIG{'successmime'}	= 'text/html';
$CONFIG{'failuremime'}	= 'text/html';
$CONFIG{'blankmime'}	= 'text/html';
$CONFIG{'expiresmime'}	= 'text/html';
$CONFIG{'listprecedence'}= 'list';
$CONFIG{'sqluser'}		= "";
$CONFIG{'sqlpassword'}	= "";
$CONFIG{'sqlname'}		= "";

my %needToReplace = ();
### These are the config options that can use variable replacement
my $replaceable = '^((mailto|replyto|subject|bcc|fileto|mailfrom)(\d*)|' .
					"${cookieStr}value|" .
					'(sender|list)(replyto|subject|from)|senderbcc|ref|error|' .
					'goto(success|blank|expires|failure)|' .
					'(sender|mail|list)(\d*)dyn(name|mime)(\d*))';
my $scratchPad = "";
my $OS;
my $attachCount = 1;
my $eToken = q([\w\-\.\!\#\$\%\^\&\*\{\}\'\|\+\`\~]);

### Taint things if we're not private
my $privateConfig = 0;
my $denyFile = "soupermail.deny";
my $allowFile = "soupermail.allow";

if ($^O =~ /MSWin/i) {
	$OS = "windows";
} else {
	$OS = "unix";
}

### Just in case people didn't read the instructions :)
$serverRoot =~ s/[\/\\]$//;
### Concatenate dir breaks into single ones.
$serverRoot =~ s/[\/\\]+/\//g;


### Speed things up by interpreting only what we need

my $fileFunctions =<<'END_OF_FILE_FUNCTIONS';
############################################################################
# Subroutine: hideFile ( filename )
# Make an OS specific call to hide a file from the webserver
# makes the file hidden under windows, chmoded under unix
############################################################################
sub hideFile {
	($debug) && (print STDERR "hideFile (@_) \@ " . time . "\n");
	my $filename = shift;
	no strict 'subs';
	if ($OS eq "windows") {
		Win32::File::SetAttributes($filename, Win32::File::HIDDEN)
	} else {
		if ($CONFIG{"cgiwrappers"}) {
			chmod 0600, $filename;
		} else {
			chmod 0266, $filename;
		}
	}
}

############################################################################
# Subroutine: saveResults ()
# Save the results to a file called $fileto
############################################################################
sub saveResults {
	($debug) && (print STDERR "saveResults (@_) \@ " . time . "\n");
	my $tag;
	foreach $tag (keys (%{$CONFIG{'fileto'}})) {
		my $outbuffer = "";
		my $outstring = "";
		my ($value, $tmpfile);
		($debug) && print STDERR "Saving file for tag $tag\n";
		if ($CONFIG{'filetemplate'}->{$tag}) {
			grabFile($CONFIG{'filetemplate'}->{$tag}, \$outbuffer);
			if ($CONFIG{'nofilecr'}->{$tag}) {
				substOutput(\$outbuffer, '2');
			} else {
				substOutput(\$outbuffer, '0');
			}
			$outbuffer =~ s/\cM?\n$//;
		} else {
			my (@keylist) = sort($query->param());
			my ($key);
			foreach $key (@keylist) {
				### Because we may be dealing with multiple values, need to
				### join with a comma.
				$value = join(',', $query->param($key));
				$value =~ s/\cM?\n/ /g if ($CONFIG{'nofilecr'}->{$tag});
				$outbuffer .= "$key = $value\n";
			}
		}
		my ($header, $footer, $fileto) = "";
		if ($CONFIG{'headings'}->{$tag}) {
			grabFile($CONFIG{'headings'}->{$tag}, \$header);
		}
		if ($CONFIG{'footings'}->{$tag}) {
			grabFile($CONFIG{'footings'}->{$tag}, \$footer);
		}
		showFile($CONFIG{'fileto'}->{$tag});

		if (-f $CONFIG{'fileto'}->{$tag}) {
			my @fileStats = stat($CONFIG{'fileto'}->{$tag});
			### Is the file going to be bigger than the maximum?
			if ($CONFIG{'filemaxbytes'}->{$tag} && 
				($fileStats[7] + length($outbuffer)) > $CONFIG{'filemaxbytes'}->{$tag}) {
				### Yes, it is too big, but first see if it needs copying.
				if ($CONFIG{'filebackupformat'}->{$tag}) {
					copy($CONFIG{'fileto'}->{$tag}, $CONFIG{'filebackupformat'}->{$tag});
					hideFile($CONFIG{'filebackupformat'}->{$tag}) 
						unless ($CONFIG{'filereadable'}->{$tag});
				}
				### Now delete it.
				unlink $CONFIG{'fileto'}->{$tag};
			} else {
				grabFile($CONFIG{'fileto'}->{$tag}, \$fileto);
			}
		}

		$fileto = $header . $footer unless ($fileto);
		if ($CONFIG{'filepgpuserid'}->{$tag}) {
			pgpMessage(\$outbuffer, $CONFIG{'filepgpuserid'}->{$tag}, $tag);
		}

		open (FILETO, "> $CONFIG{fileto}->{$tag}") ||
			fatal("Failed to write data file:\n\n    $CONFIG{fileto}->{$tag}");
		($fileLocking) && flock(FILETO, LOCK_EX);
		if ($CONFIG{'fileattop'}->{$tag}) {
			### want to add new entries to top of file.
			print FILETO $header;
			print FILETO $outbuffer;
			print FILETO substr($fileto, length($header));
		} else {
			if ($footer) {
				print FILETO substr($fileto, 0, (-1 * length($footer)));
			} else {
				print FILETO $fileto;
			}
			print FILETO $outbuffer;
			print FILETO $footer;
		}
		($fileLocking) && flock(FILETO, LOCK_UN);
		close (FILETO);

		hideFile($CONFIG{'fileto'}->{$tag}) unless ($CONFIG{'filereadable'}->{$tag});
	}
	return 1;
}

sub genFileto {
	my $tag;
	foreach $tag (keys %{$CONFIG{'fileto'}}) {
		$CONFIG{'fileto'}->{$tag} = makePath(translateFormat($CONFIG{'fileto'}->{$tag}));
		$CONFIG{'fileto'}->{$tag} =~ m!^(.*)/[^/]*$!;
		my $tmpFileName = $1;

		### We have to check to see if its writable, or at least the
		### directory where it'll be created is writable. Also check
		### the file's a read file and not a symlink
		my $f = $CONFIG{'fileto'}->{$tag};
		fatal ("Can not write to fileto of:\n\n    $f") 
		if ((-e $f && ! -w $f) || (-e $f && -l $f) ||
			(! -e $f && ! -w $tmpFileName));
	}
}
END_OF_FILE_FUNCTIONS


my $templateFunctions =<<'END_OF_TEMPLATE_FUNCTIONS';
############################################################################
# Subroutine: getOutVals ( name, {attributes}, iscounter )
# Given a variable name and an assoc array of attributes, return a list
# of values with appropriate formatting. The value of iscounter is set by
# reference.
############################################################################
sub getOutVals {
	my @nameoutput = ();
	$_ = shift;
	my $at = shift;
	my $isCounter = shift;
	my %ATTRIBS = %$at;
	$debug && print STDERR "In getOutVals with $_\n";

	$ATTRIBS{'format'} = '%ddd% %mmmm% %dd% %yyyy%' if (/^http_date/ && 
						 !$ATTRIBS{'format'});
	$ATTRIBS{'format'} = '%hhhh%:%mm%:%ss%' if (/^http_time/ && 
						 !$ATTRIBS{'format'});
	$$isCounter = 0;

	if (/^http_[a-zA-Z_]+$/) {
		if (!/^http_(time|date)$/) {
			push(@nameoutput, getHttpValue($_)) if (getHttpValue($_));
		} else {
			push(@nameoutput, translateFormat($ATTRIBS{'format'},
											  $ATTRIBS{'timeoffset'}));
		}
	} elsif (/^cookie_([\w\-]+)/) {
		push(@nameoutput, $query->cookie($1)) if ($query->cookie($1));
	} elsif (/^counter_(\d+)/i) {
		push(@nameoutput, $CONFIG{"counter"}->{"${1}value"})
			if ($CONFIG{"counter"}->{"${1}value"});
		$$isCounter = (!$CONFIG{"counter"}->{"${1}value"});
	} elsif (/^maillist_(\d+)$/) {
		if ($CONFIG{"maillistdata"}) {
			push(@nameoutput, $CONFIG{"maillistdata"}->{$1});
		}
	} elsif (/^sql_\d+_\d+_\d+$/) {
		push(@nameoutput, $sqlVals{$_}) if ($sqlVals{$_} || $sqlVals{$_} eq '0');
	} else {
		push(@nameoutput, $query->param($_));
	}
	if ($ATTRIBS{'format'} =~ /^\%(c+)\%$/) {
		my $span = length($1);
		@nameoutput = map { s/\D//g; s/(\d{0,$span})/$1 /g; s/\s+$//s; $_; } 
						  @nameoutput;
	}
	return @nameoutput;
}



############################################################################
# doMaths ( element_list, element_name, attributes )
# For every element in the list, perform the maths function specified in 
# the math attribute. Assume this is for the element named element_name
############################################################################
sub doMaths {
	my $list = shift;
	my $name = shift;
	my $at = shift;
	my $isCounter = 0;

	my $expr = $at->{'math'};
	$expr =~ s/\s//g;
	my $toEval = "";
	my $mathSyms = '\)\(\+\-\*\/';

	$debug && print STDERR "In doMath with $expr\n";

	while ($expr =~ /[sS][uU][mM]\(([^\)]+)\)/) {
		my $var = $1;
		my @vals = getOutVals($var, $at, \$isCounter);
		my $sum = 0;
		for (@vals) {
			if (/^(\-?(\d*\.)?\d+)$/) {
				$sum += $_;
			}
		}
		$expr =~ s/[sS][uU][mM]\(\Q$var\E\)/$sum/g;
	}

	while ($expr =~ /[cC][oO][uU][nN][tT]\(([^\)]+)\)/) {
		my $var = $1;
		my @vals = getOutVals($var, $at, \$isCounter);
		my $cnt = scalar(@vals);
		$expr =~ s/[cC][oO][uU][nN][tT]\(\Q$var\E\)/$cnt/g;
	}

	my @breakdown = split(/([^$mathSyms]+)/, $expr);
	$debug && print STDERR ("Breakdown = " . join(" | ", @breakdown) . "\n");
	for (@breakdown) {
		if (/^\s*([$mathSyms]+|(?:\d*\.)?\d+)\s*$/) {
			s/^0+([^\.])/$1/;
			$toEval .= $_;
		} elsif ($_ ne $name && $_) {
			my @vals = getOutVals($_, $at, \$isCounter);
			if ($vals[0] && $vals[0] =~ /^(\-?(\d*\.)?\d+)$/) {
				my $x = sprintf("%f", $vals[0]);
				$toEval .= "(" . $x . ")";
			} elsif ($_) {
				$toEval .= "0";
			}
		} elsif ($_) {
			$toEval .= $name;
		}
	}

	$toEval =~ s/([$mathSyms])(\-(?:(\d*\.)?\d+))/$1\($2\)/g;
	$toEval =~ s/\)\(\-(\d)/\)-\($1/g;
	$debug && print STDERR "to eval is $toEval\n";
	my $i = 0;
	while ($i < scalar(@$list)) {
		my $thisEval = $toEval;
		my $rep = ($list->[$i] ? 
			($list->[$i] =~ /^(\-?(\d*\.)?\d+)$/ ? 
				$list->[$i] : "1") : "0");
		$thisEval =~ s/\Q$name\E/$list->[$i]/g;
		$thisEval =~ s/[^${mathSyms}\.\d]//g;
		$debug && print STDERR "Evaling $thisEval\n";
		my $r = eval($thisEval);
		if ($at->{'precision'} =~/^(\-?)\d+$/) {
			### allow for negative precisions for the fractional portion
			if ($1) {
				$at->{'precision'} = $at->{'precision'} * -1;
				$r = $r - int($r);
				$r = sprintf("%." . $at->{'precision'} . "f", $r);
				$r =~ s/.*\.//;
			} else {
				$r = sprintf("%." . $at->{'precision'} . "f", $r);
			}
		}
		$list->[$i] = ($r ? $r : ($@ ? "NaN" : "0"));
		$i++;
	}
}



############################################################################
# Subroutine: URLunescape ( string )
# Takes a URL escaped string and unencodes it. Again pinched from CGI.pm
############################################################################
sub URLunescape {
	($debug) && (print STDERR "URLunescape (@_) \@ " . time . "\n");
	my $todecode = shift;
	return undef unless defined($todecode);
	$todecode =~ tr/+/ /;	   # pluses become spaces
	$todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
	return $todecode;
}

############################################################################
# Subroutine: substOutput ( buffer_containing_output_tags,
#							flag_to_specify_format )
# Substitute all instances of the output tag in a string
# returning the substituted string
# $format is '0' for no changes
#			'1' for output newlines as HTML <br> elements
#			'2' for remove all newlines, and replace with space characters.
#			'4' prepare the output for lout
############################################################################
sub substOutput {
	($debug) && (print STDERR "substOutput (@_) \@ " . time . "\n");
	my ($buffer, $format, $includes) = @_;
	my ($tempstring, $endstring, $outstring, $doLines) = "";
	$outstring = "";
	doLoops($buffer);
	$$buffer =~ s#<only\s+if\s*=\s*(?:"([^"]+)"|'([^']+)')\s*>(.*?)</only>#
				  subOnly($3,$1,$2)#siexg;
	while ($$buffer =~ /(<output(\s+[^>\s]+?\s*=\s*('[^']*'|
							"[^\"]*"|[^\s>]+))+\s*>)/iox) {
		$$buffer = $';
		$endstring = $`;
		($tempstring, $doLines) = translateOutput($1);
		$tempstring =~ s/\n/<br \/>/g if ($format == 1 && !$doLines);
		$tempstring =~ s/\cM?\n/ /g if ($format == 2);
		$tempstring = clean4Lout($tempstring) if ($format == 4);
		$outstring .= "$endstring$tempstring";
	}
	$$buffer = "$outstring$$buffer";
	$outstring = "";
	if ($format == 1 || $includes) {
		### CRAZZEEEE!!! do SSI type includes if its a HTML format type
		### substitution.
		while ($$buffer =~ /<\!\-\-\#include\s+virtual\s*=\s*
							("([^"]+)"|'([^']+)'|(\S+))\s*
							(type\s*=\s*(?:html|"html"|'html')\s*)?-->/xi) {
			$$buffer = $';
			$endstring = $`;
			$tempstring = "";
			my $incFile = $2;
			$incFile = $3 if ($3);
			$incFile = $4 if ($4);
			my $needsEncoding = $5;
			($debug) && (print STDERR "including $incFile\n");
			$incFile = makePath($incFile);
			if (-f $incFile && -r $incFile &&
				-T $incFile) {
				grabFile($incFile, \$tempstring);
			}
			$tempstring = clean4Lout($tempstring) if ($format == 4);
			$tempstring = dehtml(undef, $tempstring) if ($needsEncoding);
			$outstring .= "$endstring$tempstring";
		}
	}
	$$buffer = $outstring . $$buffer;
}


############################################################################
# Subroutine: subOnly ( replace_data, condition [, condition ] )
# Return the replacement text if the condition is true
############################################################################
sub subOnly {
	my $repTxt = shift;
	my $cond = shift;
	$cond = shift unless ($cond);
	return (evalCond($cond) ? $repTxt : "");
}


############################################################################
# Subroutine: translateOutput ( output_tag_string )
# Take a tag in the form <output ...> and return the value based on
# %rqpairs. If no pair exists, return "".
############################################################################
sub translateOutput {
	($debug) && (print STDERR "translateOutput (@_) \@ " . time . "\n");
	my ($line) = shift;
	my ($name, $attrib, $tag, $nameoutput) = "";
	my (@nameoutput) = ();
	my (%ATTRIBS) = ();
	my (%SETATTRIBS) = ();
	my $isCounter = 0;
	my $newlineTrans = 0;
	my $matchVal = 1;
	my $matchData = 1;

	### Some attributes can be declared multiple times. define them here
	my $multiAttr = { charmap => 1 };
	foreach (keys %$multiAttr) {
		$ATTRIBS{$_} = [];
	}

	$ATTRIBS{'list'} = $ATTRIBS{'post'} = $ATTRIBS{'pre'} = $ATTRIBS{'case'} =
		$ATTRIBS{'name'} = $ATTRIBS{'sub'} = $ATTRIBS{'alt'} = 
		$ATTRIBS{'math'} = $ATTRIBS{'format'} = $ATTRIBS{'delim'} = 
		$ATTRIBS{'type'} = $ATTRIBS{'indent'} = $ATTRIBS{'newline'} = 
		$ATTRIBS{'altvar'} = $ATTRIBS{'subvar'} = 
		$ATTRIBS{'value'} = $ATTRIBS{'valuevar'} = $ATTRIBS{'data'} = 
		$ATTRIBS{'wrap'} = $ATTRIBS{'timeoffset'} = "";

	while ($line =~ /(\w+)\s*=\s*("[^"]*"|'[^']*'|[^\s>]+)/) {
		print STDERR "Translating $line\n" if ($debug);
		$line = $';
		$attrib  = lc($1);
		$tag = $2;
		$tag =~ s/^'([^']*)'/$1/ unless ($tag =~ s/^"([^"]*)"/$1/);
		if ($multiAttr->{$attrib}) {
			push(@{$ATTRIBS{$attrib}}, $tag);
		} else {
			$ATTRIBS{$attrib} = $tag;
		}
		$SETATTRIBS{$attrib} = 1;
	}
	$ATTRIBS{'name'} =~ s/^\s*([\S])/$1/;
	$ATTRIBS{'name'} =~ s/(.*[\S])\s*$/$1/;
	$_ = $ATTRIBS{'name'};
	securityName($_);

	@nameoutput = getOutVals($_, \%ATTRIBS, \$isCounter);

	### Firstly, it should be unescaped if needed.
	if ($ATTRIBS{'type'} =~ /^unescaped(html)?$/i) {
		@nameoutput = map { URLunescape($_); } @nameoutput;
	} elsif ($ATTRIBS{'type'} =~ /^sql$/i) {
		push(@{$ATTRIBS{'charmap'}}, "',''");
		$SETATTRIBS{'charmap'} = 1;
	}

	if (scalar(@nameoutput) && $ATTRIBS{'subvar'} &&
		(!$SETATTRIBS{'valuevar'} || $nameoutput[0] eq $ATTRIBS{'valuevar'})) {
		securityName($ATTRIBS{'subvar'});
		$debug && print STDERR "subvar replace $_ with $ATTRIBS{'subvar'}\n";
		$_ = $ATTRIBS{'subvar'};
		@nameoutput = getOutVals($_, \%ATTRIBS, \$isCounter); 
	} elsif ((!scalar(@nameoutput) || ($SETATTRIBS{'valuevar'} &&
			 $nameoutput[0] ne $ATTRIBS{'valuevar'})) && $ATTRIBS{'altvar'}) {
		securityName($ATTRIBS{'altvar'});
		$debug && print STDERR "altvar replace $_ with $ATTRIBS{'altvar'}\n";
		$_ = $ATTRIBS{'altvar'};
		@nameoutput = getOutVals($_, \%ATTRIBS, \$isCounter); 
	}
	if ($SETATTRIBS{'value'}) {
		$matchVal = ($nameoutput[0] eq $ATTRIBS{'value'}) ? 1 : 0;
	}
	if ($SETATTRIBS{'data'} && scalar(@nameoutput)) {
		$ATTRIBS{'data'} =~ s/^\s*(.*?)\s*$/\L$1\E/;
		$debug && print STDERR "data $nameoutput[0] as a $ATTRIBS{'data'}\n";
		$matchData = !checkType($ATTRIBS{'data'},$nameoutput[0]);
		$debug && print STDERR "check results in $matchData\n";
	}

	### We can now apply various transformations on the data.
	### Upper of lowercase
	if ($ATTRIBS{'case'} =~ /^upper$/i) {
		@nameoutput = map { uc($_); } @nameoutput;
	} elsif ($ATTRIBS{'case'} =~ /^lower$/i) { 
		@nameoutput = map { lc($_); } @nameoutput;
	}
	
	### Perform maths functions
	if ($ATTRIBS{'math'}) {
		doMaths(\@nameoutput, $_, \%ATTRIBS);
	}

	### Map special character
	if ($SETATTRIBS{'charmap'}) {
		foreach (@{$ATTRIBS{'charmap'}}) {
			if (m!(.)\,(.*)!) {
				my $fromChar = $1;
				my $toStr = $2;
				$debug && print STDERR "Char mapping -${fromChar}- to -${toStr}-\n";
				$debug && print STDERR "(" . join("),(", @nameoutput) . ")\n";
				@nameoutput = map { s/\Q$fromChar\E/$toStr/gs;$_; } @nameoutput;
				$debug && print STDERR "(" . join("),(", @nameoutput) . ")\n";
			}
		}
	}

	if ($ATTRIBS{'type'} =~ /^escaped$/i) {
		@nameoutput = map { URLescape($_); } @nameoutput;
	} elsif ($ATTRIBS{'type'} =~ /^(unescaped)?html$/i) {
		@nameoutput = map { dehtml($1,$_); } @nameoutput;
	}

	# Wrap the element
	if ($ATTRIBS{'wrap'} && $ATTRIBS{'wrap'} =~ /^0*[1-9][0-9]*$/) {
		my $wrapCnt = 0;
		while ($wrapCnt < scalar(@nameoutput)) { 
			wrapText($ATTRIBS{'wrap'}, \${nameoutput[$wrapCnt++]});
		}
	}

	if ($ATTRIBS{'newline'} =~ /^html$/i) {
		@nameoutput = map { s/(\r?\n)/<br>\n/gs;$_; } @nameoutput;
		$newlineTrans = 1;
	} elsif ($ATTRIBS{'newline'} =~ /^none$/i) {
		@nameoutput = map { s/(\r?\n)/ /gs;$_; } @nameoutput;
		$newlineTrans = 1;
	} elsif ($ATTRIBS{'newline'} =~ /^paragraphs$/i) {
		@nameoutput = map { s/(\r?\n){3,}/\n\n/gs;$_; } @nameoutput;
		@nameoutput = map { s/(\r?\n){1,1}/\n/gs;$_; } @nameoutput;
		$newlineTrans = 1;
	} elsif ($ATTRIBS{'newline'} =~ /^unchanged$/i) {
		$newlineTrans = 1;
	}
	
	if (@nameoutput || $nameoutput || $isCounter) {
		### Now we have to be smart and handle multiple lists. Default
		### behavior is to display multiples as HTML UL lists, but can
		### be overridden by the list tag of OL, DIR or MENU.
		if (!$SETATTRIBS{'sub'} && ($ATTRIBS{'list'} || scalar(@nameoutput) > 1 )) {
			if ($SETATTRIBS{'delim'}) {
				$nameoutput= join("$ATTRIBS{post}$ATTRIBS{delim}$ATTRIBS{pre}",
								  @nameoutput);
				return("$ATTRIBS{pre}$nameoutput$ATTRIBS{post}", $newlineTrans);
			} elsif ($ATTRIBS{'list'} =~ /TEXT/i) {
				### Plain text list.
				$nameoutput = join("$ATTRIBS{post}\n	* $ATTRIBS{pre}",
									@nameoutput);
				return("\n	* $ATTRIBS{pre}$nameoutput$ATTRIBS{post}\n", 
					   $newlineTrans);
			} else {
				$ATTRIBS{'list'} = 'UL' unless ($ATTRIBS{'list'} ne "");
				$nameoutput = join ("$ATTRIBS{post}<LI>$ATTRIBS{pre}",
									@nameoutput);
			   
				return("<$ATTRIBS{list}><LI>$ATTRIBS{pre}" .
						"$nameoutput$ATTRIBS{post}</$ATTRIBS{list}>", 
						$newlineTrans);
			}
		} else {
			$nameoutput = $nameoutput[0] unless ($nameoutput);
			if ($SETATTRIBS{'sub'} && $matchVal && $matchData) {
				return($ATTRIBS{'sub'},0);
			} elsif ($matchVal && $matchData) {
				if ($SETATTRIBS{'indent'}) {
					$nameoutput =~ s/(\cM?\n)/$1$ATTRIBS{'indent'}/g ;
					$nameoutput = $ATTRIBS{'indent'} . 
									($isCounter ? '0' : $nameoutput);
					$isCounter = 0;
				}
				return("$ATTRIBS{pre}" .
						($isCounter ? '0' : $nameoutput) . "$ATTRIBS{post}",
						$newlineTrans);
			} else {
				return($ATTRIBS{'alt'},0);
			}
		}
	} else {
		return($ATTRIBS{'alt'},0);
	}
}

sub doLoops {
	my $data = shift;
	my $loopCnt = 0;
	my $pos = 0;
	my $buffer = "";
	my $num = "-?(?:\\d+|\\d*\\.\\d+)";
	my @els = split(/(<loop\s+[^>]+>|<\/loop>)/m, $$data);
	my $max = 0;

	while (@els && $max++ < 10000) {
    	my $el = $els[$pos];
		my $isLoop = ($el =~ /^<loop\s+[^>]+>/i);
		my $isEndLoop = ($el =~ /^<\/loop>/i);
		if ($isLoop && $#els > 1) {
        	$loopCnt++;
        	$pos++;
		} elsif ($isLoop) {
			splice(@els, $pos, 1);
			$pos--;
		} elsif ($isEndLoop) {
			if ($loopCnt > 0) { $loopCnt--; }
			if ($pos >= 1) {
				my $e1 = $els[$pos - 1];
				my $p1 = $pos - 1;
				my $p2 = $pos - 2;
				my $e2 = $els[$p2];
				my $start = undef;
				my $end = undef;
				my $step = 1;
				my $name = "";
				my $field = "";
				my $sql = "";
				#get loop data from $els[$p2];
				if ($e2 =~ /\sstart\s*=\s*(?:"($num)"|'($num)'|($num))/i) {
					$start = $+;
				}
				if ($e2 =~ /\send\s*=\s*(?:"($num)"|'($num)'|($num))/i) {
					$end = $+;
				}
				if ($e2 =~ /\sstep\s*=\s*(?:"($num)"|'($num)'|($num))/i) {
					$step = $+;
				}
				if ($e2 =~ /\sname\s*=\s*(?:"(\w+)"|'(\w+)'|(\w+))/i) {
					$name = $+;
				}
				if ($e2 =~ /\sfield\s*=\s*(?:"([\-\.\w]+)"|'([\-\.\w]+)'|([\-\.\w]+))/i) {
					if ($query->param($+)) { $field = $+; }
				}
				if ($e2 =~ /\ssqlrun\s*=\s*(?:"(\d+)"|'(\d+)'|(\d+))/i) {
					$sql = $+;
				}
				my @flist = ();
				if ($field) {
					@flist = $query->param($field);
					if ($step > 0) {
						$start = 0 unless ($start && $start > 0);
						$end = $#flist unless ($end && $end < $#flist);
					} else {
						$start = $#flist unless ($start && $start < $#flist);
						$end = 0 unless ($end && $end > 0);
					}
				}
				if ($sql) {
					if ($step > 0) {
						$start = 1;
						$end = $sqlCount{$sql};
					} else {
						$start = $sqlCount{$sql};
						$end = 1;
					}
				}
				# are we able to loop?
				my $tmpBuff = "";
				if (defined($start) && defined($end) &&
					(($step > 0 && $start <= $end) ||
					($step < 0 && $start >= $end))) {
					my $a = $start;
					my $b = $end;
					while (($step > 0 && $a <= $b) || ($step < 0 && $a >= $b)) {
						my $data = $e1;
						if ($name) {
							if (@flist) {
								$data =~ s/\@$name\@/$flist[$a]/sg;
							} else {
								$data =~ s/\@$name\@/$a/sg;
							}
						}
						$tmpBuff .= $data;
						$a += $step;
					}
				}
				my $o = ($pos > 2) ? 3 : 2;
				if ($o == 3) {
					$els[$pos - $o] .= $tmpBuff;
				} else {
					$els[$pos - $o] = $tmpBuff;
				}
				if  ($pos + 1 <= $#els) {
					$els[$pos - $o] .= $els[$pos + 1];
					splice(@els, $pos + 1, 1);
				}
				splice(@els, $pos - $o + 1, $o);
			}
			$pos = 0;
			$loopCnt = 0;
		} elsif ($loopCnt == 0) {
			# not in a loop, so this can be added to the content
			$buffer .= shift(@els);
		} elsif ($pos >= $#els) {
			# end of the line... if we're here, then there are
			# unclosed loops - join the array, and shove it on buffer.
			$buffer .= join("", @els);
			@els = ();
			$pos = 0;
		} elsif (!$isLoop && !$isEndLoop) {
			$pos++;
		}
	}
	$$data = $buffer;
}


END_OF_TEMPLATE_FUNCTIONS


my $pdfFunctions =<<'END_OF_PDF_FUNCTIONS';
sub makePdf {
	my $template = shift;
	my $pdfName = shift;
	$pdfName =~ s!(.*/)([^/]+)(\.[^/]*)$!$2\.pdf!;
	my $pdfDir = $1;
	($debug) && print STDERR "pdfDir is $pdfDir\n";
	my $fname = "$scratchPad/$pdfName";
	if ($ps2pdf && $lout && -d $scratchPad) {
		opendir (PDFDIR, $pdfDir);
		my @epsFiles = grep { /^[^\.]/ && /\.eps$/i } readdir(PDFDIR);
		closedir (PDFDIR);
		for (@epsFiles) {
			($debug) && print STDERR "copying $pdfDir$_\n";
			copy("${pdfDir}$_", "${scratchPad}/$_");
		}
		open (LIN, ">${scratchPad}/lout.in");
		print LIN $$template;
		close (LIN);
		my $cmd1 = "$lout $loutOpts lout.in >lout.ps";
		my $cmd2 = "$ps2pdf lout.ps ${fname}";
		($debug) && print STDERR "fname is $fname\n";
		($debug) && print STDERR "Running $cmd1\nand\n$cmd2\n";
		chdir ($scratchPad);
		### FIX ME - need to change how system is called
		system("$cmd1");
		system("$ps2pdf", "lout.ps", $fname);
		if ($fname) {
			return $fname;
		}
	}
	return "";
}


sub clean4Lout {
	my $val = shift;
	$val =~ s/[\t ]+/ /gs;
	$val =~ s/([\"\\])/\"\\$1\"/gs;
	$val =~ s/([\#\&\/\@\^\{\|\}\~])/\"$1\"/gs;
	$val =~ s/(\r?\n){2,2}/\n\@LP\n/gs;
			 
	# Win latin stuff... can we check for this in form
	# enctype?
	$val =~ s/\x82/ \@Char quotesinglbase /gs;
	$val =~ s/\x83/ \@Florin /gs;
	$val =~ s/\x84/ \@Char quotedblbase /gs;
	$val =~ s/\x85/ \@Char ellipsis /gs;
	$val =~ s/\x86/ \@Dagger /gs;
	$val =~ s/\x87/ \@DaggerDbl /gs;
	$val =~ s/\x88/ \@Char circumflex /gs;
	$val =~ s/\x8a/ \@Char S /gs;
	$val =~ s/\x8c/ \@Char OE /gs;
	$val =~ s/\x91/ \@Char quoteleft /gs;
	$val =~ s/\x92/ \@Char quoteright /gs;
	$val =~ s/\x93/ \@Char quotedbl /gs;
	$val =~ s/\x94/ \@Char quotedbl /gs;
	$val =~ s/\x95/ \@Sym bullet /gs;
	$val =~ s/\x96/ \@Char endash /gs;
	$val =~ s/\x97/ \@Char emdash /gs;
	$val =~ s/\x99/ \@Sym trademarkserif /gs;
	$val =~ s/\x9c/ \@Char oe /gs;
	$val =~ s/\x9e/ \@Char z /gs;
	$val =~ s/\x9f/ \@Char Y /gs;
	return $val;
}
END_OF_PDF_FUNCTIONS


my $mailFunctions =<<'END_OF_MAIL_FUNCTIONS';

############################################################################
# Subroutine: attachFilesToMail (fileset_name, message_ref, 
#								has_body_content, initial_parameters)
# This attaches files to a message body.
############################################################################
sub attachFilesToMail {
	my $type = shift;
	my $msg = shift;
	my $hasBody = shift;
	my $msgParams = shift;
	my ($key, $file);
	while (($key, $file) = each %{$CONFIG{$type}}) {
		($debug) && print STDERR "examining attachment $key, $file\n";
		next unless ($key =~ /(\d+)file/ && -f $file);
		my $attachNum = $1;
		$file =~ m!/([^/]+)$!;
		my $filename = $1;
		my $mime_type = 
			$CONFIG{$type}->{"${attachNum}mime"};
		($debug) && print STDERR "Attaching a mime type of $mime_type for $filename ($key)\n";
		unless ($mime_type) {
			$mime_type = (!$fhBug && -T $file) ? 'text/plain' :
									'application/octet-stream';
		}
		my @stats  = stat($file);
		($debug) && print STDERR "Attaching $file ($stats[7] bytes) " .
								 "to email\n";
		my $data = { Path => $file,
					 ReadNow => 1,
					 Filename => $filename,
					 Disposition => 'attachment'
					 };
		unless ($mime_type =~ /^text\//) {
			$data->{'Encoding'} = "base64";
		}

		if (!$hasBody) {
			$$msg->data("This is a MIME message with attachments");
		}
		if ($$msg->attr("content-type") eq "multipart/alternative") {
			($debug) && print STDERR "Attaching to multipart/alternative\n";
			my $newMsg = MIME::Lite->build(%$msgParams);
			$newMsg->attr("content-type", "multipart/mixed");
			$newMsg->attr("content-type.boundary", "sljkdhf8998IUHKjhkurhkjOUehjf" . $$);
			foreach ('To', 'From', 'Subject', 'X-Mailer', 'Date', 'Reply-To') {
				$$msg->delete($_);
			}
			$newMsg->attach($$msg);
			$$msg = $newMsg;
		}
		my $m = $$msg->attach(%$data);
		$m->attr("content-type" => $mime_type);
	}
}

############################################################################
# Subroutine: fakeEmail (address)
# MIME::Lite doesn't like sending odd email From addresses, so make them
# look a bit saner.
############################################################################
sub fakeEmail {
	($debug) && (print STDERR "fakeEmail (@_) \@ " . time() . "\n");
	$_ = shift(@_);
	if (!/\@.+/) { $_ .= "\@localhost"; }
	s/\@+/@/g;
	($debug) && (print STDERR "fakeEmail returns $_\n");
	return $_;
}

############################################################################
# Subroutine: mailResults ()
# Mail the results to the people in $mailto and also send back a mail to the
# form's sender using the sendertemplate config field.
############################################################################
sub mailResults {
	($debug) && (print STDERR "mailResults (@_) \@ " . time() . "\n");
	my ($outstring, $messageBuffer, $value, $tmpfile, $mailbuffer) = "";
	my ($mailto, $email, $tmp, $theirMail, $defReplyto, $defSubject);
	my $t = time();

	if ($CONFIG{'encodesubjects'} && $CONFIG{'sendercharset'} !~ /^us-ascii$/i) {
		my $s = substr(MIME::Lite::encode_base64($CONFIG{'sendersubject'}), 0, -2);
		$CONFIG{'sendersubject'} = "=?" . $CONFIG{'sendercharset'} . "?B?" .  $s . "?=";
	}

	checkEmail($email) if ($email = $query->param('Email'));

	my $defTag = "DEFAULT";
	if (!$CONFIG{'mailto'}->{"DEFAULT"}) {
		my @tags = (sort keys (%{$CONFIG{'mailto'}}));
		$defTag = $tags[0];
	}
	$mailto = $CONFIG{'mailto'}->{$defTag};
	$mailto = $email if (!$mailto && $CONFIG{'returntosender'}->{$defTag} && $email);
	$defReplyto = $CONFIG{'replyto'}->{$defTag};
	$defSubject = $CONFIG{'subject'}->{$defTag};

	### Handle a sendertemplate setting.
	if ($email && ($CONFIG{'sendertemplate'} || $CONFIG{'htmlsendertemplate'} ||
				   $CONFIG{'pdfsendertemplate'})
		&& ($mailto || $defReplyto || $CONFIG{'senderreplyto'} ||
			$CONFIG{'senderfrom'} || $email)) {
		print STDERR "Should be sending a mail to the sender\n" if ($debug);
		
		my $theirTemplate = "";
		my $theirHtmlTemplate = "";
		my $theirPdfTemplate = "";
		my $hasBody = 0;
		my $senderFrom = $CONFIG{'senderfrom'} ? $CONFIG{'senderfrom'} :
						($CONFIG{'senderreplyto'} ? $CONFIG{'senderreplyto'} :
						($mailto ? $mailto : 
							($defReplyto ? $defReplyto : $email)));
		my $msgParams = {
						  'From' => $senderFrom,
						  'To' => $email,
						  'Subject' => ($CONFIG{'sendersubject'} ? 
										  $CONFIG{'sendersubject'} :
										  $defSubject),
						  'Reply-To' => ($CONFIG{'senderreplyto'} ? 
										  $CONFIG{'senderreplyto'} :
											  ($defReplyto ? $defReplyto : $mailto)),
						  'Bcc' => $CONFIG{'senderbcc'},
						  'Encoding' => $CONFIG{'encoding'},
						};
		my $senderMsg = MIME::Lite->build(%$msgParams);

		if ($CONFIG{'sendertemplate'}) {
			grabFile($CONFIG{'sendertemplate'}, \$theirTemplate);
			substOutput(\$theirTemplate, '0', 1);
		}
		if ($CONFIG{'htmlsendertemplate'}) {
			grabFile($CONFIG{'htmlsendertemplate'}, \$theirHtmlTemplate);
			substOutput(\$theirHtmlTemplate, '0', 1);
		}
		if ($CONFIG{'pdfsendertemplate'}) {
			($debug) && print STDERR "Translating pdf sender template\n";
			grabFile($CONFIG{'pdfsendertemplate'}, \$theirPdfTemplate);
			substOutput(\$theirPdfTemplate, '4', 1);
			my $pdfFile = makePdf(\$theirPdfTemplate, 
								  $CONFIG{'pdfsendertemplate'});
			if ($pdfFile) {
				($debug) && print STDERR "Marking sender pdf as attachment\n";
				$CONFIG{"attachments"}->{"${attachCount}file"} = $pdfFile;
				$CONFIG{"attachments"}->{ $attachCount++ . "mime" } =
					"application/pdf";
			}
		}
		if ($CONFIG{'senderwrap'} && $theirTemplate) {
			wrapText($CONFIG{'senderwrap'}, \$theirTemplate);
		}
		if ($theirTemplate && $theirHtmlTemplate) {
			$hasBody = 1;
			($debug) && print STDERR "Making alt sender email\n";
			$senderMsg->attr("content-type" => 'multipart/alternative');
			$senderMsg->attr("content-type.boundary" => 'eskjdlj239w09epaods' . $$);
			my $m1 = $senderMsg->attach(
							Data => "$theirTemplate",
						);
			$m1->attr("content-type" => "text/plain; charset=$CONFIG{sendercharset}");
			my $m2 = $senderMsg->attach(
							Data => "$theirHtmlTemplate",
						);
			$m2->attr("content-type" => "text/html; charset=$CONFIG{sendercharset}");
			$m2->attr("content-location" => ($CONFIG{'senderbase'} ?
												$CONFIG{'senderbase'} : $base));
		} elsif ($theirHtmlTemplate) {
			$hasBody = 1;
			($debug) && print STDERR "Making HTML sender email\n";
			$senderMsg->attr('content-type' => "text/html; charset=$CONFIG{sendercharset}");
			$senderMsg->attr('content-location' => ($CONFIG{'senderbase'} ?
													$CONFIG{'senderbase'} : $base));
			$senderMsg->data($theirHtmlTemplate);
		} elsif ($theirTemplate) {
			$hasBody = 1;
			($debug) && print STDERR "Making text sender email\n";
			$senderMsg->attr("content-type" => "text/plain; charset=$CONFIG{sendercharset}");
			$senderMsg->data($theirTemplate);
		}
		if ($CONFIG{'attachments'}) {
			($debug) && print STDERR "Looking for sender attachments\n";
			attachFilesToMail("attachments", \$senderMsg, $hasBody, $msgParams);
		}
		if (scalar(keys(%{$CONFIG{'senderdyn'}->{'DEFAULT'}}))) {
			my $att;
			foreach $att (keys %{$CONFIG{'senderdyn'}->{'DEFAULT'}}) {
				my $d = $CONFIG{'senderdyn'}->{'DEFAULT'}->{$att};
				next unless ($d->{'template'});
				my $dynTemplate = "";
				grabFile($d->{'template'}, \$dynTemplate);
				substOutput(\$dynTemplate, '0', 1);
				my $dynName = $d->{'name'} ? $d->{'name'} : "attachment$att";
				my $dynMime = $d->{'mime'} ? $d->{'mime'} : "application/octet-stream";
				safeAttach(\$senderMsg, {},
						{Data => $dynTemplate, Filename => $dynName, 
						 Disposition => 'attachment' },
						 $dynMime, 'DEFAULT', 1, $msgParams);
			}
		}
		$senderMsg->replace('X-Mailer' => "Soupermail $relVersion");
		eval('$senderMsg->send();');
	}

	my $hasMailingList = ($CONFIG{'maillist'} || ($CONFIG{"listformfield"} && 
							$query->param($CONFIG{"listformfield"})) ||
							scalar(@listSql)) && 
						($CONFIG{'listtemplate'} || $CONFIG{'htmllisttemplate'});

	return 1 unless (keys(%{$CONFIG{'mailto'}}) || $hasMailingList);

	### Since potentially we'll be sending uploads to multiple people, it
	### makes a sick kind of sense to cache the upload data (though it could be
	### memory hungry) - should write to the scratch pad area
	my @uploadCache = ();
	my $uploadCount = 1;
	foreach ($query->param()) {
		my $val;
		foreach $val ($query->upload($_)) {
			next unless ($val && fileno($val) && ref($val));
			if ($debug) {
				print STDERR "Upload $val\n";
				while (my ($n, $v) = each %{$query->uploadInfo($val)}) {
					print STDERR "	$n => $v\n";
				}
			}
			my $isText = (!$fhBug && -T $val);
			my $mime_type = "";
			if ($query->uploadInfo($val)) {
				$mime_type = $query->uploadInfo($val)->{'Content-Type'};
			}
			unless ($mime_type) {
				$mime_type = ($isText) ? 'text/plain' :
									 'application/octet-stream';
			}
			($debug) && print STDERR "Upload mime $mime_type\n";
			my $fname = $val;
			if ($query->user_agent() =~ /(PPC|Mac)\b/) {
				$fname =~ s/.*:([^:]*)/$1/;
			} else {
				 $fname =~ s/\\/\//g;
				 $fname =~ s/.*\/([^\/]*)/$1/;
			}
			($debug) && print STDERR "Upload name $fname\n";

			my $cacheFile = "$scratchPad/upload-" . $uploadCount++;
			($debug) && print STDERR "Make cachefile $cacheFile\n";
			binmode($val);
			if (open(U, "> $cacheFile")) {
				while(<$val>) {
					print U $_;
				}
				close (U);
				my $data = {Filename => $fname,
							Path => $cacheFile,
							Disposition=>"attachment"};
				unless ($mime_type =~ /^text\//) { $data->{'Encoding'} = 'base64'; }
				($debug) && print STDERR "Got upload data of " . %$data . "\n";
				push (@uploadCache, [$mime_type, { %$data }]);
			} else {
				($debug) && print STDERR "Unable to write cache file\n";
			}
		}
	}
	my $tag;
	foreach $tag (keys(%{$CONFIG{'mailto'}})) {
		($debug) && print STDERR "Processing mail for tag $tag\n";
		$mailto = $CONFIG{'mailto'}->{$tag};
		$mailto = $email if (!$mailto && $CONFIG{'returntosender'}->{$tag} && $email);
		my $cset = $CONFIG{'mailcharset'}->{$tag} ? $CONFIG{'mailcharset'}->{$tag} :
								$CONFIG{'mailcharset'}->{"DEFAULT"};
		if ($CONFIG{'encodesubjects'} && $cset !~ /^us-ascii$/i) {
			my $s = substr(MIME::Lite::encode_base64($CONFIG{'subject'}->{$tag}), 0, -2);
			$CONFIG{'subject'} = "=?" . $CONFIG{'mailcharset'}->{$tag} . "?B?" .  $s . "?=";
		}
		my $origEnc = $CONFIG{'encoding'};
		### Since we're going through PGP ascii armoring, there's no need
		### to use 7bit safe quoted-printable messages since the data will
		### be mail transport safe.
		if ($CONFIG{'pgpuserid'}->{$tag}) {
			$CONFIG{'encoding'} = "8BIT";
		}

		my $footerText .= "-------------------------------\n" .
							"Remote Host: $ENV{'REMOTE_HOST'}\n" .
							"Remote IP: $ENV{'REMOTE_ADDR'}\n" .
							"User Agent: $ENV{'HTTP_USER_AGENT'}\n" .
							"Referer: $ENV{'HTTP_REFERER'}\n";
		my $mailMessage = "";
		my $htmlMailMessage = "";
		my $mailtoParams = {
						'From' => $CONFIG{'mailfrom'}->{$tag} ?
									fakeEmail($CONFIG{'mailfrom'}->{$tag}) : 
										($email ? fakeEmail($email) : $mailto),
						'To' => ($CONFIG{'returntosender'}->{$tag} && 
							  $email && $email ne $mailto) ?  
									  "$mailto, $email" : $mailto,
						'Reply-To' => $CONFIG{'replyto'}->{$tag} ? 
										   $CONFIG{'replyto'}->{$tag} :
										   ($email ? $email : $mailto),
						'Subject' => $CONFIG{'subject'}->{$tag},
						'Bcc' => $CONFIG{'bcc'}->{$tag},
						'Encoding' => $CONFIG{'encoding'}};
		my $mailtoMsg = MIME::Lite->build(%$mailtoParams);
		my $copyMsg = MIME::Lite->build(%$mailtoParams);
		if ($CONFIG{'mailtemplate'}->{$tag} || $CONFIG{'htmlmailtemplate'}->{$tag}) {
			if ($CONFIG{'mailtemplate'}->{$tag}) {
				grabFile($CONFIG{'mailtemplate'}->{$tag}, \$mailMessage);
				substOutput(\$mailMessage, '0', 1);

				$mailMessage .= "\n$footerText" unless 
					($CONFIG{'nomailfooter'}->{$tag});
				### If there's to be word wrapping...
				($CONFIG{'mailwrap'}->{$tag}) && 
					(wrapText($CONFIG{'mailwrap'}->{$tag}, \$mailMessage));
			}
			if ($CONFIG{'htmlmailtemplate'}->{$tag}) {
				grabFile($CONFIG{'htmlmailtemplate'}->{$tag}, \$htmlMailMessage);
				substOutput(\$htmlMailMessage, '0', 1);
			}
			if ($mailMessage && $htmlMailMessage) {
				$mailtoMsg->attr("content-type" => 'multipart/alternative');
				$mailtoMsg->attr("content-type.boundary" => 'skfdhj384jhqoihe' . $$);
				my $m1 = $mailtoMsg->attach(
							Data => $mailMessage,
						);
				$m1->attr("content-type" => "text/plain; charset=$cset");
				my $m2 = $mailtoMsg->attach(
							Data => $htmlMailMessage,
						);
				$m2->attr("content-type" => "text/html; charset=$cset");
				$m2->attr("content-location" => ($CONFIG{'mailbase'}->{$tag} ? 
													$CONFIG{'mailbase'}->{$tag} : $base));
			} elsif ($htmlMailMessage) {
				($debug) && print STDERR "Making HTML mailto email\n";
				$mailtoMsg->attr('content-type' => "text/html; charset=$cset");
				$mailtoMsg->attr('content-location' => ($CONFIG{'mailbase'}->{$tag} ?
														$CONFIG{'mailbase'}->{$tag} : $base));
				$mailtoMsg->data($htmlMailMessage);
			} else {
				($debug) && print STDERR "Making text  mailto email\n";
				$mailtoMsg->attr("content-type" => "text/plain; charset=$cset");
				$mailtoMsg->data($mailMessage);
			} 
		} else {
			my (@keylist) = ($CONFIG{'alphasort'}->{$tag} ? sort($query->param()) :
													$query->param());
			my ($key);
			foreach $key (@keylist) {
				### Because we may be dealing with multiple values, need to
				### join with commas.
				$value = join(',', $query->param($key));
				$messageBuffer .= "$key = $value\n";
			}

			$messageBuffer .= "\n$footerText" unless ($CONFIG{'nomailfooter'}->{$tag});
			### If there's to be word wrapping...
			($CONFIG{'mailwrap'}->{$tag}) && (wrapText($CONFIG{'mailwrap'}->{$tag}, \$messageBuffer));
			### Don't encode the message if its going to a non PGP/MIME
			### destination.
		   	$mailtoMsg->attr("content-type" => "text/plain; charset=$cset");
			$mailtoMsg->data($messageBuffer);
		}

		### At this point, message buffer contains the right message

		### Store a marker to see if we're splitting attachments from PGP
		my $added = 0;

		### Its here that file upload should go - should restrict size
		### Pseudo code is:
		### foreach input item, look at its values
		### see if the value has a filehandle
		### if there's a filehandle, read it in to the specified size
		### MIME it up
		### print it with an appropriate mime type
		### simple :)

		if ($CONFIG{'mimeon'}->{$tag}) {
			($debug) && print STDERR "Uploads allowed for tag $tag\n";
			my $data;
			foreach $data (@uploadCache) {
				$added += safeAttach(\$mailtoMsg, \$copyMsg, $data->[1],  $data->[0], $tag, 
							$CONFIG{'pgpuploads'}->{$tag}, $mailtoParams);
			}
		} else {
			($debug) && print STDERR "Uploads NOT allowed for tag $tag\n";
		}

		if ($CONFIG{'pdfmailtemplate'}->{$tag}) {
			my $pdfTemplate = "";
			grabFile($CONFIG{'pdfmailtemplate'}->{$tag}, \$pdfTemplate);
			substOutput(\$pdfTemplate, '4', 1);
			my $pdfName = $CONFIG{'pdfmailtemplate'}->{$tag};
			my $pdfFile = makePdf(\$pdfTemplate, $pdfName);
			$pdfName =~ s!.*/([^/]+)(\.[^/]*)$!$1\.pdf!;
			if ($pdfFile) {
				($debug) && print STDERR "Putting $pdfName as an attachment\n";
				$added += safeAttach(\$mailtoMsg, \$copyMsg, {Path => $pdfFile, Filename => $pdfName},
							'application/pdf', $tag, 
							$CONFIG{'pgppdfs'}->{$tag}, $mailtoParams);
			}
		}
		if (scalar(keys(%{$CONFIG{'maildyn'}->{$tag}}))) {
			my $att;
			foreach $att (keys %{$CONFIG{'maildyn'}->{$tag}}) {
				my $d = $CONFIG{'maildyn'}->{$tag}->{$att};
				next unless ($d->{'template'});
				my $dynTemplate = "";
				grabFile($d->{'template'}, \$dynTemplate);
				substOutput(\$dynTemplate, '0', 1);
				my $dynName = $d->{'name'} ? $d->{'name'} : "attachment$att";
				my $dynMime = $d->{'mime'} ? $d->{'mime'} : "application/octet-stream";
				$added += safeAttach(\$mailtoMsg, \$copyMsg, 
							{Data => $dynTemplate, Filename => $dynName, 
							 Disposition => 'attachment' },
							$dynMime, $tag, 
							$CONFIG{'pgpdynamics'}->{$tag}, $mailtoParams);
			}
		}

		if ($CONFIG{'pgpuserid'}->{$tag}) {
			my $encMsg = $mailtoMsg->body_as_string();
			if ($encMsg =~ /^\-\-(_\-.*)$/m) {
				$encMsg = "Content-Type: multipart/mixed; boundary=\"$1\"\r\n\r\n$encMsg";
			}
			pgpMessage(\$encMsg, $CONFIG{'pgpuserid'}->{$tag}, $tag);
			if ($CONFIG{'pgpmime'}->{$tag}) {
				if (! $added) {
					$copyMsg->attr('content-type' => 'multipart/encrypted');
					$copyMsg->attr('content-type.protocol' => 'application/pgp-encrypted');
					$copyMsg->attr('content-type.boundary' => 'of3ewjlkdsi3jd9asjd' . $$);
					my $m = $copyMsg->attach(
								  Data => 'Version: 1'
							  );
					$m->attr("content-type" => 'application/pgp-encrypted');
					my $p = $copyMsg->attach(
								  Data => $encMsg
							  );
					$p->attr("content-type" => 'application/octet-stream');
				} else {
					my $subMsg = MIME::Lite->build();
					$subMsg->attr('content-type' => 'multipart/encrypted');
					$subMsg->attr('content-type.protocol' => 'application/pgp-encrypted');
					$subMsg->attr('content-type.boundary' => 'of3ekjhdsgfytdsbuJTWERKGAk' . $$);
					my $m = $subMsg->attach(
								  Data => 'Version: 1'
							  );
					$m->attr("content-type" => 'application/pgp-encrypted');
					my $p = $subMsg->attach(
								  Data => $encMsg
							  );
					$p->attr("content-type" => 'application/octet-stream');
					$copyMsg->attach($subMsg);
				}
			} else {
				if (! $added) {
					$copyMsg->data($encMsg);
					$copyMsg->attr("content-type" => 'text/plain');
				} else {
					$copyMsg->attach(Type => 'TEXT',
										Data => $encMsg);
				}
			}
			$mailtoMsg = $copyMsg;
		}


		$debug && print STDERR "Sending mail to $mailto or $email\n";
		$mailtoMsg->replace('X-Mailer' => "Soupermail $relVersion");
		eval('$mailtoMsg->send();');
		undef $messageBuffer;
		$CONFIG{'encoding'} = $origEnc;
	}

	if ($hasMailingList) {
		my $textTemplate = "";
		my $htmlTemplate = "";
		if ($CONFIG{'listtemplate'}) {
			grabFile($CONFIG{'listtemplate'}, \$textTemplate);
		}
		if ($CONFIG{'htmllisttemplate'}) {
			grabFile($CONFIG{'htmllisttemplate'}, \$htmlTemplate);
		}
		($debug) && print STDERR "Got maillist templates\n";
		my @listLines = ();
		my $maxItemCnt = 0;
		my $listReply = $CONFIG{'listreplyto'} ? $CONFIG{'listreplyto'} : 
							($email ? $email : $mailto);
		my $listFrom = $CONFIG{'listfrom'} ? $CONFIG{'listfrom'} : 
							($email ? $email : $mailto);

		### Read in the mailing list data from the file datasource
		if ($CONFIG{'maillist'}) {
			($debug) && print STDERR "Opening data file $CONFIG{maillist}\n";
			open(MAILLIST, "<$CONFIG{maillist}");
			($fileLocking) && flock(MAILLIST, LOCK_SH);
			while (<MAILLIST>) {
				chomp;
				my @bits = split(/,/);
				push(@listLines, [ 1, @bits ]);
			}
			($fileLocking) && flock(MAILLIST, LOCK_UN);
			close(MAILLIST);
		}

		### Pull the mailing list data from the form field specified
		if ($CONFIG{'listformfield'} && 
			$query->param($CONFIG{'listformfield'})) {
			($debug) && print STDERR "Getting maillist data from form field $CONFIG{listformfield}\n";
			my @lines = split(/\n/, $query->param($CONFIG{'listformfield'}));
			foreach (@lines) {
				chomp;
				my @bits = split(/,/);
				push (@listLines, [ 1, @bits ]);
			}
		}

		### Pull some mailing list data from the SQL command
		if (scalar(@listSql)) {
			push(@listLines, @listSql);
		}

		eval('use Net::SMTP;');
		my @smtpCon = ();
		my $hasSmtp = ($@ || !$mailhost ? 0 : 1);
		if ($hasSmtp) {
			### Make sure we don't generate too many threads
			if ($smtpPoolSize > scalar(@listLines)) {
				$smtpPoolSize = scalar(@listLines);
			}
			### Open up a set of connections
			for (0 .. $smtpPoolSize) {
				$smtpCon[$_] = Net::SMTP->new($mailhost);
			}
		}
		my $poolNum = -1;

		### Now loop through the mailing list data
		foreach (@listLines) {
			$poolNum++;
			$poolNum = 0 if ($poolNum > $smtpPoolSize);
			my @rawList = @$_;
			my $itemCnt = 1;
			my $inQuote = 0;
			my $item = "";
			my $subedTxt = "";
			my $subedHtml = "";
			my $subedMsg = "";
			my $undefCnt = 0;
			my $doQuotes = shift(@rawList);
			while ($undefCnt++ < $maxItemCnt) {
				($debug) && print STDERR "Unsetting $undefCnt\n";
				$CONFIG{'maillistdata'}->{$undefCnt} = "";
			}
			foreach $item (@rawList) {
				if ($doQuotes && $inQuote) {
					($debug) && print STDERR "In quote with $item\n";
					$item =~ s/""/"/g;
					if ((($item =~ tr/"//) % 2) && $item =~ s/"$//) {
						$inQuote = 0;
					}
					$CONFIG{"maillistdata"}->{$itemCnt} =
						$CONFIG{"maillistdata"}->{$itemCnt} . ",$item";
					if (!$inQuote) { $itemCnt++; }
				} else {
					($debug) && print STDERR "In no quote with $item\n";
					if ($doQuotes && $item =~ s/^"//) {
						$inQuote = 1;
						$item =~ s/""/"/g;
						if ((($item =~ tr/"//) % 2) && $item =~ s/"$//) {
							$inQuote = 0;
						}
					}
					$CONFIG{"maillistdata"}->{$itemCnt} = $item;
					if (!$inQuote) { $itemCnt++; }
				}
				if ($itemCnt > $maxItemCnt) { $maxItemCnt = $itemCnt; }
			}
			#### Should send mail at this point
			if ($textTemplate) {
				$subedTxt = $textTemplate;
				substOutput(\$subedTxt, '0', 1);
			}
			if ($htmlTemplate) {
				$subedHtml = $htmlTemplate;
				substOutput(\$subedHtml, '0', 1);
			}

			my $thisListSubject = $CONFIG{'listsubject'};
			if ($thisListSubject =~ /^"[^"]*"\s*$/) {
				subReplace(\$thisListSubject);
				$thisListSubject = replacer($thisListSubject, 'listsubject');
			}
			
			if ($CONFIG{'encodesubjects'} && $CONFIG{'listcharset'} !~ /^us-ascii$/i) {
				my $s = substr(MIME::Lite::encode_base64($thisListSubject), 0, -2);
				$thisListSubject = "=?" . $CONFIG{'listcharset'} . "?B?" .  $s . "?=";
			}

			my $listParams = {
							 'From' => $listFrom,
							 'To' => $CONFIG{'maillistdata'}->{1},
							 'Reply-To' => $listReply,
							 'Subject' => $thisListSubject,
							 'Encoding' => $CONFIG{'encoding'},
							};
			my $listMsg = MIME::Lite->build(%$listParams);
			$listMsg->add('Precedence' => $CONFIG{listprecedence});
			if ($subedTxt && $subedHtml) {
				$listMsg->attr("content-type" => 'multipart/alternative');
				$listMsg->attr("content-type.boundary" => 'skf349sadjq2uadlkj' . $$);
				$listMsg->attach(Data => $subedTxt);
				my $m = $listMsg->attach(Data => $subedHtml);
				$m->attr("content-type" => "text/html; charset=$CONFIG{listcharset}");
				$m->attr("content-location" => ($CONFIG{'listbase'} ? 
												$CONFIG{'listbase'} : $base));
			} elsif ($subedHtml) {
				$listMsg->attr("content-type" => "text/html; charset=$CONFIG{listcharset}");
				$listMsg->attr("content-location" => ($CONFIG{'listbase'} ? 
														$CONFIG{'listbase'} : $base));
				$listMsg->data($subedHtml);
			} else {
				$listMsg->data($subedTxt);
			}
			if ($CONFIG{'maillistdata'}->{1}) {
				if ($CONFIG{'listattachments'}) {
					($debug) && print STDERR "Looking for list attachments\n";
					attachFilesToMail("listattachments", \$listMsg, 1, $listParams);
				}
				if (scalar(keys(%{$CONFIG{'listdyn'}->{'DEFAULT'}}))) {
					my $att;
					foreach $att (keys %{$CONFIG{'listdyn'}->{'DEFAULT'}}) {
						my $d = $CONFIG{'listdyn'}->{'DEFAULT'}->{$att};
						next unless ($d->{'template'});
						my $dynTemplate = "";
						grabFile($d->{'template'}, \$dynTemplate);
						substOutput(\$dynTemplate, '0', 1);
						my $dynName = $d->{'name'} ? $d->{'name'} : "attachment$att";
						my $dynMime = $d->{'mime'} ? $d->{'mime'} : "application/octet-stream";
						safeAttach(\$listMsg, {},
								{Data => $dynTemplate, Filename => $dynName, 
						 		Disposition => 'attachment' },
						 		$dynMime, 'DEFAULT', 1, $listParams);
					}
				}
				$listMsg->replace('X-Mailer' => "Soupermail $relVersion");
				if ($hasSmtp) {
					$smtpCon[$poolNum]->mail($listFrom);
					$smtpCon[$poolNum]->to($CONFIG{'maillistdata'}->{1});
					$smtpCon[$poolNum]->data();
					$smtpCon[$poolNum]->datasend($listMsg->as_string());
					$smtpCon[$poolNum]->dataend();
					$smtpCon[$poolNum]->reset();
				} else {
					eval('$listMsg->send();');
				}
			}
		}
		if ($hasSmtp) {
			for (0 .. $smtpPoolSize) {
				$smtpCon[$_]->quit;
			}
		}
	}
	return 1;
}

sub safeAttach {
	my $msg = shift;
	my $copy = shift;
	my $data = shift;
	my $ct = shift;
	my $tag = shift;
	my $flag = shift;
	my $params = shift;
	my $added;
	my $m;
	if ($flag || !$CONFIG{'pgpuserid'}->{$tag}) {
		if ($$msg->attr('content-type') eq "multipart/alternative") {
			my $newParent = MIME::Lite->build(%$params);
			$newParent->attr('content-type', 'multipart/mixed');
			$newParent->attr('content-type.boundary' => 'asdkJNkgY3k' . rand(10) . 'asywq62hsoah' . $$);
			foreach ('To', 'From', 'Subject', 'X-Mailer', 'Date', 'Reply-To') {
					$$msg->delete($_);
			}
			$newParent->attach($$msg);
			$$msg = $newParent;
		}
		$m = $$msg->attach(%$data);
	} else {
		($debug) && print STDERR "Adding to copy message\n";
		$added++;
		$$copy->attr('content-type' => 'multipart/mixed');
		$$copy->attr('content-type.boundary' => 'sdfjei' . rand(10) . 'rkjf93akjl2' . $$);
		$m = $$copy->attach(%$data);
	}
	$m->attr("content-type" => $ct);
	($debug) && print STDERR "Atached " . %$data . " of $ct\n";
	return $added;
}

END_OF_MAIL_FUNCTIONS

############################################################################
# Subroutine: wrapText ( number_of_characters_to_wrap_to,
#						buffer_to_wrap )
# Takes a buffer, and wraps it to the number of characters specified.
# Returns the wrapped buffer.
############################################################################
sub wrapText {
	($debug) && (print STDERR "wrapText (@_) \@ " . time . "\n");
	my ($wrap, $buffer) = @_;
	my ($start, $rest, $tmp, $something);
	### Need to isolate words longer than the wrap size ...
	$$buffer =~ s/([^\s]{$wrap,})\s/\n$1\n/g;
	### ... and then do real wrapping.
	while ($$buffer =~ /([^\n]{$wrap})/) {
		$start = $`;
		$rest = $';
		$something = $1;
		$something =~ s/((.|\n)*)\s((.|\n)*)/$1\n$3/;
		$something =~ /((.|\n)*)(\n.*)/;
		$tmp .= $start . $1;
		$$buffer = $3 . $rest;
	}
	$$buffer = $tmp . $$buffer;
}

############################################################################
# Subroutine: dehtml ( [unescape], string )
# Change common HTML characters to special charaters optionally url
# unescaping if neccessary. 
############################################################################
sub dehtml { 
	my $arg1 = shift;
	my $arg2 = shift;
	$_ = ($arg1) ? URLunescape($arg2) : $arg2;
	s/\&/\&#38;/g; s/>/\&#62;/g; s/</\&#60;/g;
	s/\"/\&#34;/g; s/\'/\&#39;/g;
	return $_;
}



my $pgpFunctions =<<'END_OF_PGP_FUNCTIONS';

############################################################################
# Subroutine: pgpFail ( failure_message )
# Need a special pgp failure routine to clean up after pgp's done a mess.
############################################################################
sub pgpFail {
	($debug) && (print STDERR "pgpFail (@_) \@ " . time . "\n");
	my ($msg) = shift;
	fatal("PGP Failure:\n\n    $msg");
}

############################################################################
# Subroutine: pgpInit ()
# Using PGP, so check all's well
# This is designed with pgp 5.0i in mind, so i have to take care
# that pgp doesn't generate any unwanted output... ie. give it a
# random number file
# Stop soupermails from clashing by using pid numbers
# If it all goes pear shape, make sure the files are deleted
# by giving total write access. I suppose this is a hole, but a small one
#
# How to encrypt to sender... hmm, they'd have to supply their own
# pgp key... i guess it could be done, but not at the moment.
# Guess i could introduce a text area called PGP for users to put
# their key in, or have the pgp check the Email field
# Perhaps even use netscape's upload button - only if v.adventurous though
############################################################################
sub pgpInit {
	my $tag = shift;
	my %exts = ('gpg', 'gpg', 'pgp2', 'pgp', 'pgp5', 'pkr', 'pgp6', 'pkr');
	my $keyring = 'pubring.' . $exts{$CONFIG{'pgpversion'}->{$tag}};
	my $secring = 'secring.' . $exts{$CONFIG{'pgpversion'}->{$tag}};

	($debug) && (print STDERR "pgpInit (@_) \@ " . time . "\n");
	fatal("Cannot use PGP encryption with Return to Sender option") 
		if ($CONFIG{'returntosender'}->{$tag});

	if (-f "$configRoot/$keyring") {
		copy("$configRoot/$keyring", "$scratchPad/$keyring") || 
			pgpFail("Can't copy $keyring");
		showFile("${scratchPad}/$keyring");
	}
	if (-f "$configRoot/$secring") {
		copy("$configRoot/$secring", "$scratchPad/$secring") || 
			pgpFail("Can't copy $secring");
		showFile("${scratchPad}/$secring");
	}

	### Create a config and random file for PGP.
	if (!$CONFIG{'gnupg'}->{$tag}) {

		### I don't know how random this is going to be, but there's
		### no HTTP keypress emulator :)
		open(RAND, "> ${scratchPad}/randseed.bin") || 
			pgpFail("can't open randseed.bin for creating");
		my ($i);
		for ($i = 0; $i < 512; $i++) {
			print RAND pack("c", rand(255));
		}
		close(RAND);
		showFile("${scratchPad}/randseed.bin");

		### Make a config file... PGP 5 complains if it doesn't get one.
		my $conf = ($CONFIG{'pgpversion'}->{$tag} eq 'pgp2') ? 'config.txt' : 'pgp.cfg';

		open (PGPCONF, "> ${scratchPad}/$conf") ||
			pgpFail("can't open $conf for creating");
		if ($OS eq "windows") { 
			$scratchPad =~ s/\/+/\\/g;
			print PGPCONF "PubRing=${scratchPad}\\$keyring\n" 
				if (-f "${scratchPad}/$keyring");
		} else {
			print PGPCONF "PubRing=${scratchPad}/$keyring\n" 
				if (-f "${scratchPad}/$keyring");
		}
		if ($CONFIG{'pgpversion'}->{$tag} ne 'pgp2') {
			print PGPCONF "NoBatchInvalidKeys=0\n";
			print PGPCONF "HTTPKeyServerHost=$CONFIG{pgpserver}\n"
				if ($CONFIG{'pgpserver'});
			print PGPCONF "HTTPKeyServerPort=$CONFIG{pgpserverport}\n"
				if ($CONFIG{'pgpserverport'});
		}
		print PGPCONF "VERBOSE=0\n";
		close(PGPCONF);
	}
}


############################################################################
# Subroutine: pgpMessage (messageRef, timeString)
# Wrap a message up as a PGP encrypted message
############################################################################
sub pgpMessage {
	my $messageBuffer = shift;
	my $uid = shift;
	my $tag = shift;
	my $pgpBuffer = "";
	### want to PGP encode the buffer.
	pgpInit($tag);
	$| = 1;
	my $cmd = "";

	my $outfile = "$scratchPad/eout.txt";
	my $t = ($CONFIG{'pgptextmode'}->{$tag} ? " -t" : "");
	my $pgpencrypt = $pgpSet->{$CONFIG{'pgpversion'}->{$tag}};
	if ($CONFIG{'gnupg'}->{$tag}) {
		$cmd = "$pgpencrypt --homedir $scratchPad --batch " .
			   "--always-trust --quiet --no-secmem-warning $t " .
			   "-ear '${uid}'";
		if ($OS eq "windows") {
			$outfile =~ s/\/+/\\/g;
			$cmd .= " -o \"$outfile\"";
			$cmd =~ s/'/"/g;
		} else {
			$cmd .= " -o $outfile";
		}
		$debug || close(STDERR);
		open (WINGPGIN, "| $cmd");
		print WINGPGIN $$messageBuffer;
		close WINGPGIN;
	} else {
		if ($OS eq "windows") {
			$outfile =~ s/\/+/\\/g;
			$cmd = "\"$pgpencrypt\" $t -a -f -r $uid +batchmode -o $outfile";
		} else {
			if ($CONFIG{'pgpversion'}->{$tag} eq 'pgp2') {
				$cmd = "PGPPATH=$scratchPad $pgpencrypt $t -fea '${uid}' " .
						" -o $outfile";
			} else {
				$cmd = "PGPPATH=$scratchPad $pgpencrypt $t -a -r '${uid}' " .
						"-f +batchmode=1 -o $outfile";
			}
		}
		$ENV{'PGPPATH'} = $scratchPad;
		chdir($scratchPad);
		open (WINPGPIN, "| $cmd");
		print WINPGPIN $$messageBuffer;
		close WINPGPIN;
	}
	open (WINOUT, "< $outfile");
	while (<WINOUT>) {
		$pgpBuffer .= $_;
	}
	close (WINOUT);
	$debug && print STDERR ($CONFIG{'gnupg'}->{$tag} ? "GPG" : "PGP") . ": $cmd\n" .
				"Generated " . length($pgpBuffer) . " bytes\n";
	$$messageBuffer = $pgpBuffer;
}

END_OF_PGP_FUNCTIONS

############################################################################
# There are a couple of deadlock points in soupermail, mainly due to PGP and
# fileuploads. So, we'll actually fork of a child to do that dangerous stuff
# and kill it if a certain timeout's reached.
############################################################################
if ($forkable && $OS eq "unix" && ($child = fork)) {
	$debug = 0;
	$SIG{CHLD} = sub { cleanScratch(); exit; };
	$SIG{TERM} = sub { kill 9, $child;
						cleanScratch(); exit; };
	$SIG{PIPE} = sub { kill 9, $child;
						cleanScratch(); exit; };
	$| = 1;
	sleep $uploadTimeout;
	kill 9, $child;
	fatal ("Soupermail has timed out");
	exit;
} else {
	### Stop STDERR being output to the screen
	### This is UNIX specific... should check the OS I guess...
	if ($debug) {
		open(STDERR, ">> $debug"); 
	} else {
		open(STDERR, "> /dev/null");
	}

	$| = 1;
	$CONFIG{'ref'} = translateFormat('REF:%rrrrrr%');

	### This is the dangerous child that could hang on the new CGI
	$query = new CGI;

	### Remove leading and trailing spaces.
	nukeValues();

	if ($debug) {
		print STDERR "\n\nrunning on perl $] for $^O\n\n";
		print STDERR "\nsoupermail version $relVersion\n\n";
		while (my($en, $ev) = each %ENV) { print STDERR "$en=$ev\n"; }
		print STDERR "Soupermail variables:\nserverRoot = $serverRoot\n" .
					"privateRoot = $privateRoot\n" .
					"tempDir = $tempDir\n" .
					"fhBug = $fhBug\n" .
					"hasDbi = $hasDbi\nmailhost = $mailhost\nmailprog = $mailprog\n" .
					"ps2pdf = $ps2pdf\nlout = $lout\n" .
					"\nData = " . $query->self_url() . "\n" .
					"CGI Version = " . $CGI::VERSION . "\n";
	}

	# Set up the MIME::Lite mailer to use the right email method
	if ($mailhost) {
		($debug) && (print STDERR "Setting mail to use $mailhost\n");
		MIME::Lite->send("smtp", $mailhost, Debug=>($debug ? 1 : 0));
	} elsif ($mailprog) {
		($debug) && (print STDERR "Setting mail to use $mailprog\n");
		MIME::Lite->send("sendmail", "$mailprog -t -oi -oem", Debug=>($debug ? 1 : 0));
	}

	# And stop it warning
	if (!$debug) { MIME::Lite->quiet(1); }

	$base = ($query->referer() =~ m!^https!i) ? "https" : "http";
	if ($query->referer() =~ m!^https?://([^/]+)!i) {
		$base .= "://$1";
	} else {
		$base .= "://" . $query->server_name();
	}

	### Try and find out where the configuration file is.
	my $transPath = "";
	$transPath = $query->path_translated() if ($query->path_translated());
	if ($transPath =~ m!${serverRoot}(.*)/([^/]*)! &&
		!$query->param('SoupermailConf')) {
		### $pageRoot is where the actual script is being called from
		$pageRoot = $1;
		$configRoot = $serverRoot . $pageRoot;
		securityFilename($pageRoot);
		### The configuration file
		$config = $transPath;
		$base .= $pageRoot;
	} else {
		### See if the config file's been specified in the form itself
		if ($query->param('SoupermailConf')) {
			unless ($query->param('SoupermailConf') =~ m!^[\~/]!) {
				if ($query->referer() =~ m!^https?://[\w\.\-]+(:\d+)?(/.*)!i) {
					my $urlPath = $2;
					### Remove any anchor or query stuff... won't work
					### for path info though :(
					$urlPath =~ s/(^.*?)[\#\?]/$1/;
					$urlPath =~ m!(.*)/[^/]*!;
					$pageRoot = $1;
					$config = "$serverRoot$pageRoot/" . 
								$query->param('SoupermailConf');
					### Have to possibly compress ../ type directories.
					while ($config =~ s![^/]+/\.\./!!) {}
					fatal ("Config file out of server root") unless
						($config =~ /^$serverRoot/);
					$base .= $pageRoot;
				} else {
					fatal("Cannot determine conf location from referer");
				}
			} elsif ($query->param('SoupermailConf') =~ m!^\~!) {
				### The config file is in the private root
				$query->param('SoupermailConf') =~ m!(.*)/[^/]*!;
				$pageRoot = $1;
				$config = "$privateRoot/" . substr($query->param('SoupermailConf'),1);
				$privateConfig = 1;
			} else {
				### The config file is an absolute path starting with /.
				$query->param('SoupermailConf') =~ m!(.*)/[^/]*!;
				$pageRoot = $1;
				$config = $serverRoot . $query->param('SoupermailConf');
				$base .= $pageRoot;
			}
			securityFilename($config);
			fatal("Unable to find or read the config file - " .
					"read http://soupermail.sourceforge.net/faq.html#configprob")
				 unless (-e $config && -f $config && -r $config);
			### Need to reset pageRoot here because ../s in the relative
			### path may have altered things.
			if ($config =~ m!^($serverRoot|$privateRoot)(.*)/[^/]+!) {
				$pageRoot = $2;
				$configRoot = $1 . $2;
			}
		} else {
			fatal("Unable to determine where the config file is.");
		}
	}
	$base .= "/";
	($debug) && print STDERR "Set configRoot to $configRoot\n";
	my $configFile = "";
	grabFile($config, \$configFile);

	$debug && print STDERR "Reading config $config\n";
	for (split(/\n|\r|\012|\015/, $configFile)) {
		my ($setValue);
		my ($toValue);
		next if (/^\s*\#/);
		next unless (/\S/);
		if (/^\s*([^:\s]*\S+)\s*:\s*(.*[\S])\s*$/) {
			$setValue = $1;
			$toValue = $2;
			unless ($setValue =~ /^(if|unless)/i) {
				fatal ("Too many quote marks in a configuration line:\n\n    $_")
					if (($toValue =~ tr/"/"/) > 2);
			}
		
			### now do some work to do replacement of mailto, replyto,
			### subject, ref and cookie values
			if ($toValue =~ /^"[^"]*"\s*$/ && 
				$setValue =~ /$replaceable/ix) {
				$toValue = replacer($toValue, $setValue);
			}
			setConfig($setValue, $toValue);
		} else {
			fatal("Unrecognised config line:\n\n    '$_'\n");
		}
	}
	$debug && print STDERR "Finished reading config $config\n";

	makeScratch();
	if ($CONFIG{'templated'}) { 
		eval($templateFunctions);
		$debug && print STDERR "Evaluated template functions\n";
	}
	if ($CONFIG{'pgpuserid'} || $CONFIG{'filepgpuserid'}) {
		eval($pgpFunctions);
		$debug && print STDERR "Evaluated PGP functions\n";
	}
	if (scalar(keys %{$CONFIG{'fileto'}})) {
		eval($fileFunctions);
		$debug && print STDERR "Evaluated file functions\n";
	}
	if ($CONFIG{'pdftemplate'} || $CONFIG{'pdfmailtemplate'} ||
		$CONFIG{'pdfsendertemplate'}) {
		eval($pdfFunctions);
		$debug && print STDERR "Evaluated pdf functions\n";
	}
	if ($CONFIG{'mailto'} || $CONFIG{'returntosender'} || 
		$CONFIG{'sendertemplate'} || $CONFIG{'htmlsendertemplate'} ||
		$CONFIG{'pdfsendertemplate'} || $CONFIG{'pdfmailtemplate'} ||
		$CONFIG{'maillist'} || $CONFIG{'listformfield'}) {
		eval($mailFunctions);
		$debug && print STDERR "Evaluated mail functions $@\n";
	}

	### Check for expiry date
	if ($today > $CONFIG{'expirydate'}) {
		doCounters('expires');
		$CONFIG{"ref"} = translateFormat($CONFIG{"ref"});
		subReplace();
		returnExpired();
		cleanScratch();
		exit;
	}

	### Check for missing required fields
	if (formMissingRequired() || 
		badTypes(\@typeChecks) || 
		$CONFIG{'error'}) {
		$debug && print STDERR "Have failed a required, type or config_error check\n";
		doCounters('failure');
		$CONFIG{"ref"} = translateFormat($CONFIG{"ref"});
		subReplace();
		returnFailure();
		cleanScratch();
		exit;
	}

	### Check for a blank form
	if (formIsBlank()) {
		doCounters('blank');
		$CONFIG{"ref"} = translateFormat($CONFIG{"ref"});
		subReplace();
		returnBlank();
		cleanScratch();
		exit;
	}

	### Looks ok, so return the final page
	doCounters('success');
	$CONFIG{"ref"} = translateFormat($CONFIG{"ref"});
	subReplace();
	if (scalar(keys %{$CONFIG{'fileto'}})) { genFileto(); }
	returnSuccess();
	cleanScratch();
	exit;
}


############################################################################
# Subroutine: URLescape ( string )
# Escape out characters in a string, and return the string. Pinched
# straight out of CGI.pm, but since its not exported explicitly I figure
# its best to copy it here.
############################################################################
sub URLescape {
	($debug) && (print STDERR "URLescape (@_) \@ " . time . "\n");
	my $toencode = shift;
	return undef unless defined($toencode);
	$toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
	return $toencode;
}

############################################################################
# Subroutine: subReplace ( [optional_ref_value] ) 
# Replace http_ref and counter values for config options. This needs
# to happen after counters have been processed
############################################################################
sub subReplace {
	($debug) && (print STDERR "subReplace () \@ " . time . "\n");
	my $optVal = shift;
	my $setValue;
	if ($optVal) {
			$$optVal =~ s/\$counter_(\d+)/$CONFIG{'counter'}->{"${1}value"}/gs;
			$$optVal =~ s/\$http_ref/$CONFIG{'ref'}/gs;
	} else {
		foreach $setValue (keys %needToReplace) {
			my $val = ($setValue =~ /^(mailto|fileto|replyto|subject|bcc)(\d*)$/ ? 
							\$CONFIG{$1}->{$2 ? $2 : "DEFAULT"} : 
							\$CONFIG{$setValue});
			if ($setValue =~ /^cookie(\d+)value$/) {
				($debug) && (print STDERR "cookie value $1 is " . $cookieList{$1}->{'value'} . "\n");
				$val = \$cookieList{$1}->{'value'};
			}
			($debug) && (print STDERR "val is $$val\n");
			$$val =~ s/\$counter_(\d+)/$CONFIG{'counter'}->{"${1}value"}/gs;
			$$val =~ s/\$http_ref/$CONFIG{'ref'}/gs;
			($debug) && (print STDERR "processing $setValue to $$val\n");
		}
	}
}

############################################################################
# Subroutine: makeUrl ( url )
# For convenience sake, this will try and figure out if a given URL is 
# absolute or relative. If its relative, it'll try and fill in the
# blanks to make it an absolute URL for the current server. 
# Returns the absolute URL.
############################################################################
sub makeUrl {
	($debug) && (print STDERR "makeUrl (@_) \@ " . time . "\n");
	$_ = shift;
	my ($server, $url);
	$server = $query->server_name() unless ($server = $ENV{'HTTP_HOST'});
	if ($query->server_port() != 80 && ! $server =~ /:\d+$/) {
		$server .= ":" . $query->server_port();
	}
	my $proto = "http" . ($ENV{'HTTPS'} =~ /on/i ? "s" : "");
	SWITCH: {
		if (/^\//) { $url = "${proto}://${server}$_"; last SWITCH; }
		if (m!^https?://!i) { $url = $_; last SWITCH; }
		$url = "${pageRoot}/$_";
		while ($url =~ s![^/]+/\.\./!!) {}
		$url = "${proto}://${server}$url";
	}
	return($url);
}


############################################################################
# Subroutine: makePath ( path )
# Makes a path from the server root from the specified path. If the path is
# absolute (ie. starts with a /, its assumed to be from the server root,
# otherwise its assumed to be relative to the configuration file.)
############################################################################
sub makePath {
	($debug) && (print STDERR "makePath (@_) \@ " . time . "\n");
	my $path = shift;
	my $oPath = $path;
	if ($path =~ /^\~/) {
		$path = "${privateRoot}/" . substr($path,1); 
		fatal("Calling private information from a non-private config file")
			unless ($privateConfig);
	} elsif ($path =~ /^\//) {
		$path = $serverRoot . $path; 
	} else {
		$path = "$configRoot/" . $path; 
	}
	while ($path =~ s![^/]+/\.\./!!) {}
	$path =~ s!/+!/!g;
	securityFilename($path);
	($path =~ /^$serverRoot\//) && (return $path);
	($path =~ /^$privateRoot\//) && (return $path);
	fatal("The path $oPath requested is outside the server root");
}


############################################################################
# Subroutine: setConfig ( configuration_line )
# This routine takes a configuration variable name and a value and attempts
# to set the variable to the value. It does a fair bit of error and
# security checking depending on the type of variable to set.
############################################################################
sub setConfig {
	($debug) && (print STDERR "setConfig (@_) \@ " . time . "\n");
	$_ = shift; 
	my ($value) = shift;
	$_ = lc($_);
	CONFSWITCH : {

	### Required form fields that must be filled in before success.
	### Ignored fields can be used to hide hidden fields from the blank
	### form checking routine.
	if (/^(required|ignore)$/) {
		securityName($value, 1);
		my ($list) = ($1 eq "required" ? \@required : \@ignored);
		push(@$list, $value);
		last CONFSWITCH;
	}

	### Localised error string
	if (/^error$/) {
		$CONFIG{"error"} = $value;
		last CONFSWITCH;
	}

	### Type checking fields
	if (/^is(not)?(number|integer|email|creditcard)$/) {
		push(@typeChecks, [$_, $value]);
		last CONFSWITCH;
	}
	
	### This is a subject line for generated email... truncated at 199
	### characters to stop DoS attacks against crappy mail clients.
	if (/^(sender|list)subject$/) {
		if (length($value) > 199) {
			$value = substr($value, 0, 199);
		}
		$CONFIG{$&} = $value;
		last CONFSWITCH;
	} 
	if (/^subject(\d*)$/) {
		if (length($value) > 199) {
			$value = substr($value, 0, 199);
		}
		my $tag = $1 ? $1 : "DEFAULT";
		$CONFIG{'subject'}->{$tag} = $value;
		last CONFSWITCH;
	} 

	### A format for the autogenerated reference field.
	### See translateFormat() for more on how it works.
	if (/^ref/) {
		$CONFIG{'ref'} = $value;
		last CONFSWITCH;
	}

	### For the base URLs for HTML email
	if (/^((list|sender)base)$/) {
		$CONFIG{$1} = $value;
		last CONFSWITCH;
	}
	if (/^(mailbase)(\d*)$/) {
		my $tag = ($2 ? $2 : "DEFAULT");
		$CONFIG{$1}->{$tag} = $value;
		last CONFSWITCH;
	}
	
	### The log on details for DBI support 
	if (/^(sql(user|password))$/) {
		$CONFIG{$1} = $value;
		last CONFSWITCH;
	}

	### The database connection string
	if (/^sqlname$/) {
		unless ($value =~ /^dbi:[^:]+(:.*)?/i) { 
			fatal("Malformed database name:\n\n    $value"); }
		$CONFIG{'sqlname'} = $value;
		last CONFSWITCH;
	}

	### Variables to pass into database queries must be passed as
	### bind values for safety.
	if (/^sqlbind(\d+)$/) {
		if ($1 > 0) {
			my $pos = $1 - 1;
			my $val = replacer($value, $_);
			if ($val eq "") { $val = undef; }
			if (defined $val) { $bindVals[$pos] = $val; }
		}
		last CONFSWITCH;
	}

	### A database query is provided in DBI bind format for safety, as this
	### does all the database escaping. We need DBI and the connection name
	### of the database
	if (/^sqlrun(\d+)|listsql$/ && $hasDbi && $CONFIG{'sqlname'}) {
		if (formMissingRequired() || badTypes(\@typeChecks) ||
			$CONFIG{'error'}) {
			($debug) && print STDERR "Skipping SQL $value due to requires/types.\n";
			@bindVals = ();
			last CONFSWITCH;
		}
		my $sqlNum = $1 || 'listsql';
		($debug) && print STDERR "Trying database " . $CONFIG{'sqlname'} . "\n";
		my $dbh = DBI->connect($CONFIG{'sqlname'}, 
								$CONFIG{'sqluser'}, 
								$CONFIG{'sqlpassword'}) || last CONFSWITCH;
		($debug) && print STDERR "Connected to database\n";
		my $sth = $dbh->prepare($value);
		if ($sth) {
			my $rv;
			eval('$rv = $sth->execute(@bindVals);');
			if (!$@) {
				my @sqlVals = $sth->fetchrow_array;
				my $loop = 0;
				if ($sqlNum eq 'listsql') {
					push (@listSql, [ 0, @sqlVals ]);
				} else {
					while (scalar(@sqlVals)) {
						for (0 .. $#sqlVals) {
							$sqlVals{"sql_${sqlNum}_" . ($loop + 1) . "_" .
									($_ + 1)} = $sqlVals[$_];
						}
						$loop++;
						@sqlVals = $sth->fetchrow_array;
					}
					$sqlCount{$sqlNum} = $loop;
				}
			} else {
				($debug) && print STDERR "Unable to execute with " . 
					join(",", @bindVals) . $dbh->errstr . ", $@\n";
			}
		} else {
			($debug) && print STDERR "Unable to prepare statement '$value' " . 
				$dbh->errstr;
		}
		$dbh->disconnect();
		@bindVals = ();
		last CONFSWITCH;
	}

	### A filename to save the form results into. It should be specified
	### relative to where the configuration file was placed.
	if (/^fileto(\d*)$/) {
		my $tag = $1 ? $1 : "DEFAULT";
		$CONFIG{'fileto'}->{$tag} = $value;
		last CONFSWITCH;
	}

	### This is a filename for a counter. The numbers in the middle are
	### used to specify which counter we're talking about.
	if (/^counter(\d+)file$/) {
		my $countNum = $1;
		my $counterFile = makePath($value);
		$counterFile =~ m!^(.*)/[^/]*$!;
		fatal ("Can not write to counter file of:\n\n    $value") 
			if ((-e $counterFile && ! -w $counterFile) ||
				(-e $counterFile && -l $counterFile) ||
				(! -e $counterFile && ! -w $1));
		my $counterValue = "0";
		grabFile($counterFile, \$counterValue) if (-f $counterFile);
		$counterValue =~ /^(\d+)/;
		$CONFIG{"counter"}->{"${countNum}value"} = $1;
		$CONFIG{"counter"}->{"${countNum}file"} = $counterFile;
		if (!$CONFIG{"counter"}->{"${countNum}step"}) {
			$CONFIG{"counter"}->{"${countNum}step"} = 1;
		}
		last CONFSWITCH;
	}

	### Set the counter to an absolute value.
	if (/^setcounter(\d+)$/) {
		my $countNum = $1;
		fatal("Counter values must be numeric for:\n\n    $_") if 
			($value =~ /[^\d]/);
		$CONFIG{"counter"}->{"${countNum}set"} = $value;
		last CONFSWITCH;
	}

	### Set the counter step value.
	if (/^counter(\d+)step$/) {
		my $countNum = $1;
		fatal("Counter step values must be numeric for:\n\n    $_") if 
			($value =~ /[^\d]/);
		$CONFIG{"counter"}->{"${countNum}step"} = $value;
		last CONFSWITCH;
	}

	### Get the form field name that contains mailing list data
	if (/^listformfield$/) {
		securityName($value, 1);
		$CONFIG{"listformfield"} = $value;
		last CONFSWITCH;
	}

	### Counters can change depending on the four different outcomes of
	### a form's submission.
	if (/^counter(\d+)on(failure|success|expires|blank)$/) {
		my $countNum = $1;
		my $mode = $2;
		last CONFSWITCH unless ($value =~ /^(yes|no|1|0)$/i);
		$CONFIG{'counter'}->{"${countNum}on$mode"} = 
			($value =~ /^(yes|1)$/i) ? 1 : 0;
		last CONFSWITCH;
	}

	### Attachments are sent with sendertemplate data and there can be
	### any number of them.
	if (/^(list)?attachment(\d+)$/) {
		my $atype = ($1 ? "listattachments" : "attachments");
		my $attachNum = $2;
		if ($value ne '""') {
			my $attachFile = makePath($value);
			unless (-f $attachFile && -r $attachFile) {
				fatal("Cannot read file attachment:\n\n    $attachNum");
			}
			($debug) && print STDERR "Config attaching $attachFile\n";
			$CONFIG{$atype}->{"${attachNum}file"} = $attachFile;
			$attachCount++;
		} else {
			delete $CONFIG{$atype}->{"${attachNum}file"};
			delete $CONFIG{$atype}->{"${attachNum}mime"};
			$attachCount--;
		}
	}

	### Attachments need to have a mime type associated with them
	if (/^(list)?attachment(\d+)(mime)$/) {
		my $atype = ($1 ? "listattachments" : "attachments");
		my $attachNum = $2;
		my $attachType = $3;
		fatal("Unrecognised $atype MIME format:\n\n    $value") unless
			($attachType ne "mime" || mimeIsOk($value));
		$CONFIG{$atype}->{"${attachNum}$attachType"} = $value;
		last CONFSWITCH;
	}

	### Templates returned to the browser can have their mime types	
	### set here.
	if (/^(success|blank|expires|failure)mime$/) {
		my $n = $&;
		fatal("Unrecognised return MIME format:\n\n    $value") unless
			(isMimeOk($value));
		$CONFIG{$n} = $value;
		last CONFSWITCH;
	}

	### This specifies the maximum number of bytes a soupermail generated
	### file can grow to. If a new addition will take the file over this
	### size, the file is initially deleted. The backup name (if any)
	### for the deleted file is specified with filebackupformat.
	if (/^filemaxbytes(\d*)$/) {
		my $tag = $1 ? $1 : "DEFAULT";
		fatal("filemaxbytes must be a number")	if ($value =~ /[^\d]/);
		$CONFIG{'filemaxbytes'}->{$tag} = $value;
		last CONFSWITCH;
	}

	### This is the format for any backup of a soupermail generated file
	### which is deleted due to the filemaxbytes setting. It takes the
	### same formatting values as a reference number format.
	if (/^filebackupformat(\d*)$/) {
		my $tag = $1 ? $1 : "DEFAULT";
		$value = translateFormat($value);
		my $tmpFile = makePath($value);
		if (-e $tmpFile && !-w $tmpFile) {
			fatal("No permissions for writing to filebackupformat");
		}
		if (-e $tmpFile && -l $tmpFile) {
			fatal("The filebackupformat file is a symlink");
		}
		### Check to see if we've got write access to the backup
		### directory.
		unless (-e $tmpFile) {
			$tmpFile =~ m!(.*/)[^/]*!;
			fatal ("Cannot write into the backup directory") unless (-w $1);
		}
		$CONFIG{'filebackupformat'}->{$tag} = $tmpFile;
		last CONFSWITCH;
	}

	### email address(es) to send the form's mail to.
	### checkEmail() does a little security check to make sure emails
	### look right.
	if (/^(sender|list)replyto|(sender|list)from|senderbcc$/) {
		checkEmail($value);
		$CONFIG{$&} = $value;
		last CONFSWITCH;
	} 

	if (/^(mailto|bcc|replyto|mailfrom)(\d*)$/) {
		checkEmail($value);
		my $tag = $2 ? $2 : "DEFAULT";
		$CONFIG{$1}->{$tag} = $value;
		last CONFSWITCH;
	}

	### Set up some template files. All these are assumed to be relative
	### to the location of the configuration file.
	if (/^(success|failure|blank|(expires|pdf)template|(html|pdf)?sendertemplate)|
		   (html)?listtemplate$/x) {
		my $cmd = $&;
		if (!$CONFIG{'templated'}) {
			$CONFIG{'templated'} = (/success|failure|blank|template/);
		}
		$CONFIG{$cmd} = makePath($value);
		fatal("Cannot find the '$cmd' template file") unless 
			(-f $CONFIG{$cmd} && -r $CONFIG{$cmd});
		last CONFSWITCH;
	}

	if (/^((?:htmlmail|pdfmail|mail|file)?template|footings|headings)(\d*)$/) {
		my $cmd = $1;
		$CONFIG{'templated'} = 1;
		my $path = makePath($value);
		my $tag = ($2 ? $2 : "DEFAULT");
		$CONFIG{$cmd}->{$tag} = $path;
		fatal("Cannot find the '$cmd' template file") unless 
			(-f $path && -r $path);
		last CONFSWITCH;
	}

	if (/^(sender|mail|list)(\d*)dyn(template|mime|name)(\d*)$/) {
		my $base = "${1}dyn";
		my $tag = $2 ? $2 : "DEFAULT";
		my $cmd = $3;
		my $att = ($4 ? $4 : "DEFAULT");
		if ($cmd eq "template") {
			$CONFIG{'templated'} = 1;
			my $path = makePath($value);
			fatal("Cannot find the dyn '$tag'/'$att' template file") unless 
				(-f $path && -r $path);
			$CONFIG{$base}->{$tag}->{$att}->{'template'} = $path;
			$CONFIG{'dynamics'} = 1;
		} else {
			$CONFIG{$base}->{$tag}->{$att}->{$cmd} = $value;
		}
		fatal("Unrecognised $base MIME format:\n\n    $value") unless
			($cmd ne "mime" || mimeIsOk($value));
		last CONFSWITCH;
	}

	### Get the mailing list - or at least make sure it exists
	if (/^maillist$/) {
		my $list = $&;
		$CONFIG{$list} = makePath($value);
		fatal("Cannot find the maillist file:\n\n    $list") unless 
			(-f $CONFIG{$list} && -r $CONFIG{$list});
		last CONFSWITCH;
	}

	if (/^(returntosender|nomailfooter|mimeon|alphasort)(\d*)/) {
		my $cmd = $1;
		my $tag = $2 ? $2 : "DEFAULT";
		last CONFSWITCH unless ($value =~ /^(yes|no|1|0)$/i);
		$CONFIG{$cmd}->{$tag} = ($value =~ /^(yes|1)$/i) ? 1 : 0;
		if ($cmd eq "mimeon") { $CONFIG{'uploads'} = 1; }
		last CONFSWITCH;
	}

	### Subject lines in emails are sent 7bit, this means non-ascii
	### characters get munged. Setting encodesubjects to yes means they
	### get base64 encoded as per RFC 2047.
	if (/^encodesubjects|cgiwrappers$/) {
		my $cmd = $&;
		last CONFSWITCH unless ($value =~ /^(yes|no|1|0)$/i);
		$CONFIG{$cmd} = ($value =~ /^(yes|1)$/i) ? 1 : 0;
		last CONFSWITCH;
	}


	### To prevent mail loops, emails sent with the maillist functions
	### will be given a precedence of list.
	if (/^listprecedence$/) {
		last CONFSWITCH unless ($value =~ /^(junk|list|bulk)$/i);
		$CONFIG{'listprecedence'} = $value;
		last CONFSWITCH;
	}

	### This field takes a date, and will cause the form to stop
	### accepting submissions ON or AFTER that date.
	if (/^expires$/) {
		fatal ("Invalid expiry format:\n\n    $value") unless 
			($value =~ /^(\d\d?)-(\d\d?)-(\d\d(\d\d)?)$/);
		if ($1 > 31 ||  $2 > 12 || $1 < 1 || $2 < 1) {
			fatal ("Invalid Expiry date:\n\n    $1 - $2 - $3");
		} elsif ($3 > 2037) {
			### Hey, this even looks for the dreaded 32bit running out
			### of bits bug!
			fatal("Expiry date must be before the year 2038");
		}
		$CONFIG{'expirydate'} = timelocal(0,0,0,$1,($2 - 1), $3);
		last CONFSWITCH;
	}

	### This species how many characters to wrap emails to.
	if (/^(sender)?wrap$/) {
		my $cmd = $&;
		$value =~ s/\D//g;
		if ($cmd eq "wrap") {
			$CONFIG{'senderwrap'} = $value;
			$CONFIG{'mailwrap'}->{"DEFAULT"} = $value;
		}
		$CONFIG{$cmd} = $value;
		last CONFSWITCH;
	}
	if (/^mailwrap(\d*)$/) {
		my $tag = $1 ? $1 : "DEFAULT";
		$value =~ s/\D//g;
		$CONFIG{'mailwrap'}->{$tag} = $value;
		last CONFSWITCH;
	}

	### This is the username or KeyID of a user in the pubring.pkr
	### PGP public keyring placed in the directory where the config file
	### is. Using KeyIDs is better, as they are unique (I think).
	if (/^filepgpuserid(\d*)$/) {
		my $tag = $1 ? $1 : "DEFAULT";
		fatal("Illegal characters in the PGP userid:\n\n    $value") if
			($value =~ /[^\w \<\>\@\.\-]/);
		$CONFIG{'filepgpuserid'}->{$tag} = $value;
		last CONFSWITCH;
	}
	if (/^pgpuserid(\d*)$/) {
		fatal("Illegal characters in the PGP userid:\n\n    $value") if
			($value =~ /[^\w \<\>\@\.\-]/);
		my $tag = $1 ? $1 : "DEFAULT";
		$CONFIG{'pgpuserid'}->{$tag} = $value;
		last CONFSWITCH;
	}

	### PGP 5 can look for stuff off an internet PGP key server, this
	### way, you should be able to use pgp userids that are on a remote
	### server, rather than in your public keyring.
	if (/^pgpserver/) {
		unless ($value =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})|
							(([\w\-]+\.)*[\w\-]+)$/x) {
			fatal("The PGP keyserver name must be a hostname or an" .
				  " IP address");
		}
		$CONFIG{'pgpserver'} = $value;
		last CONFSWITCH;
	}

	### This defines the post the PGP key server's running on.
	if (/^pgpport/) {
		unless ($value =~ /^\d+$/) {
			fatal("The PGP keyserver port must be an integer");
		}
		$CONFIG{'pgpserverport'} = $value;
		last CONFSWITCH;
	}

	### These are the flags to say whether or not to use GNU Privacy
	### Guard rather than PGP 5 an whether to use PGP/MIME packaging of
	### the email.
	if (/^(gnupg|pgpmime|pgpuploads|pgppdfs|pgptextmode)(\d*)$/) {
		my $cmd = $1;
		my $tag = $2 ? $2 : "DEFAULT";
		last CONFSWITCH unless ($value =~ /^(yes|no|1|0)$/i);
		$CONFIG{$cmd}->{$tag} = ($value =~ /^(yes|1)$/i) ? 1 : 0;
		last CONFSWITCH;
	}

	### Allow a user selectable version of pgp/gpg
	if (/^pgpversion(\d*)$/) {
		last CONFSWITCH unless ($pgpSet->{$value});
		my $tag = $1 ? $1 : "DEFAULT";
		$CONFIG{'pgpversion'}->{$tag} = $value;
		if ($value =~ /^gpg$/i) {
			$CONFIG{'gnupg'}->{$tag} = 1;
		}
		($debug) && print STDERR "Encryption method set to $value for $tag\n";
		last CONFSWITCH;
	}

	if (/^7bit$/) {
		my $confVal = $&;
		last CONFSWITCH unless ($value =~ /^(yes|no|1|0)$/i);
		$CONFIG{'encoding'} = ($value =~ /^(yes|1)$/i) ? "quoted-printable" : 
														 "8BIT";
		last CONFSWITCH;
	}

	### The defines the character set to set as the email character set
	if (/^mailcharset(\d*)$/) {
		my $tag = $1 ? $1 : "DEFAULT";
		if ($value =~ /[^\w\-]/) {
			fatal("The mail character set must only contain letters, numbers " .
				  "and hyphens");
		}
		$CONFIG{'mailcharset'}->{$tag} = $value;
		last CONFSWITCH;
	}

	if (/^(sender|list)charset$/) {
		my $cmd = $&;
		if ($value =~ /[^\w\-]/) {
			fatal("Character sets must only contain letters, numbers " .
				  "and hyphens");
		}
		$CONFIG{$cmd} = $value;
		last CONFSWITCH;
	}

	### This sets up an if conditional value.
	if (/^if|(unless)$/) {
		my $conditionType = $1 ? 1 : 0;
		fatal("Conditional $value with wrong format") unless 
			($value =~ /.*\s+then\s+[^:\s]+\s*:\s*.*[\S]\s*/i);
		parseCondition($value, $conditionType);
		last CONFSWITCH;
	}

	### Rather than using a templates, these goto... values goto a
	### specific URL.
	if (/^(goto(success|failure|expires|blank))$/) {
		$CONFIG{$1} = makeUrl($value);
		last CONFSWITCH;
	}

	### Set some boolean flags up.
	### By default, soupermail pops a 4 line summary about the form that
	### started it at the end of the email it sends out. 
	### By default, any files written by soupermail are made unreadable
	### to the webserver. If you want, setting filereadable stops this
	### behaviour.
	### Setting nofilecr will remove newline characters from anything
	### written into a soupermail generated file.
	### Setting fileattop will place new entries into a soupermail
	### generated file right at the top, or, if a headings has been	
	### specified, straight after the headings.
	### Setting cgiwrappers alters the chmod behaviour when hiding files
	if (/^(filereadable|nofilecr|fileattop)(\d*)$/) {
		my $cmd = $1;
		my $tag = $2 ? $2 : "DEFAULT";
		last CONFSWITCH unless ($value =~ /^(yes|no|1|0)$/i);
		$CONFIG{$cmd}->{$tag} = ($value =~ /^(yes|1)$/i) ? 1 : 0;
		last CONFSWITCH;
	}

	### This will set or generate a cookie.
	### Defaults for a new cookie are:
	###	 name	- cookie1, cookie2 up to cookie9
	###	 value   - ""
	###	 path	- path to the soupermail CGI
	###	 domain  - the current server's name
	###	 expires - in 24 hours
	###	 secure  - sent over SSL and non-SSL connections
	if (/^${cookieStr}(name|value|path|domain|secure|expires)/) {
		my $item  = $1;
		my $cset  = $2;
		my $cname = "cookie$1";
		my $cval  = "";
		my $csec  = 0;
		my $cexpires = '+1d';
		my $cdomain = ($query->virtual_host() ? $query->virtual_host() :
												$query->server_name());
		my $cpath = $query->script_name();
		if ($cset eq "name") {
			$cname = $value;
			if ($cname =~ /[^\w\-]/) {
				fatal("Cookie names can only contain letters and numbers");
			}
			if (length($cname) > 50) { 
				fatal("Cookie names must be less than 50 characters long.");
			}
		} elsif ($cset eq "value") {
			if (length($value) > 516) {
				$value = substr($value, 516);
			}
			$cval = $value;
		} elsif ($cset eq "path") {
			fatal("Invalid cookie path:\n\n    $value") if ($value =~ /[^\w\.\/\%\-]/);
			$cpath = $value;
		} elsif ($cset eq "domain") {
			fatal("Invalid cookie domain:\n\n    $value") 
				unless ($value =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})|
									(([\w\-]+\.)*[\w\-]+)(:\d+)?$/x);
			$cdomain = $value;
		} elsif ($cset eq "secure") {
			$csec = $value = ($value =~ /yes|1/i) ? 1 : 0;
		} elsif ($cset eq "expires") {
			unless ($value =~ /^(\+\d+[smhdMy]|
								\-\d+[smhdMy]|
								[nN][oO][wW]|
								\d\d?-\d\d?-\d\d(\d\d)?|
								\d\d?-\d\d?-\d\d(\d\d)?\s+\d\d?:\d\d?(:\d\d?)?|
								\d\d?:\d\d?(:\d\d?)?)$/x) {
				fatal("Incorrect cookie expires format:\n\n    $value");
			}
			my (@hasDate) = ();
			my (@hasTime) = ();

			### Now check the date format.
			if ($value =~ /\b(\d\d?)-(\d\d?)-(\d\d(\d\d)?)\b/) {
				if ($1 > 31 ||  $2 > 12 || $1 < 1 || $2 < 1) {
					fatal ("Invalid Expiry date:\n\n    $1 - $2 - $3");
				} elsif ($3 > 2037) {
					fatal("Cookie expiry date must be before the year 2038");
				}
				$hasDate[0] = $1;
				$hasDate[1] = $2;
				$hasDate[2] = $3;
			}

			### And check the time format.
			if ($value =~ /\b(\d\d?):(\d\d?)(:(\d\d?))?\b/) {
				if ($1 > 23 || $2 > 59 || ($4 && $4 > 59)) {
					fatal("Invalid cookie expiry time:\n\n    ${1}:$2$3");
				}
				$hasTime[0] = $1;
				$hasTime[1] = $2;
				$hasTime[2] = $4;
			}

			### Now set up the time/date stuff.
			if (@hasDate || @hasTime) {
				if (@hasDate && @hasTime) {
					$value = localtime(timelocal($hasTime[2],
										$hasTime[1],
										$hasTime[0],
										$hasDate[0],
										$hasDate[1] - 1,
										$hasDate[2]));
				} elsif (@hasDate) {
					$value = localtime(timelocal(0, 0, 0,
										$hasDate[0],
										$hasDate[1] - 1,
										$hasDate[2]));
				} else {
					my @now = localtime(time);
					$value = localtime(timelocal($hasTime[2],
										$hasTime[1],
										$hasTime[0],
										$now[3],
										$now[4],
										$now[5]));
				}
			}
			$cexpires = $value;
		}
		if ($cookieList{$item}) {
			### That cookie already exists, so we'll have to change	
			### stuff.
			$cookieList{$item}->{$cset} = $value;
		} else {
			### Its a new cookie, hhhmmmmmm, coookies :)
			$cookieList{$item} = {'name'=>$cname, 'value'=>$cval,
								  'domain'=>$cdomain, 'path'=>$cpath,
								  'secure'=>$csec, 'expires'=>$cexpires};
		}
		last CONFSWITCH;
	}

	### This controls when cookies will be sent out.
	if (/^cookieon(failure|success|blank|expires)$/) {
		my $cfgval = $1 . "cookie";
		last CONFSWITCH unless ($value =~ /^(yes|no|1|0)$/i);
		$CONFIG{$cfgval} = ($value =~ /^(yes|1)$/i) ? 1 : 0;
		last CONFSWITCH;
	}

	} ### End of CONFSWITCH
}

sub mimeIsOk {
	my $v = shift;	
	return $v =~ m!^${eToken}+/${eToken}+(\s*;\s*${eToken}+\s*(=\s*${eToken}+)?)*$!;
}


############################################################################
# Subroutine: parseCondition ( condition, if_or_unless )
# This will go through a conditional configuration statement
# It'll see if the condition is true, and if so set the specified 
# config value.
############################################################################
sub parseCondition {
	($debug) && (print STDERR "parseCondition (@_) \@ " . time . "\n");
	$_ = shift;
	my $cType = shift;
	my ($opens, $closes, $set, $cond, $toValue);
	my ($tmp) = "";

	($debug) && print STDERR "Got cond $_\n";
	### Initially break up the conditions.
	/^((?:[^\:]*(?:'[^']*'|"[^"]*")[^\:]*)|[^\:]*[^\s:])\s+
		  then\s+([^:]*[^\s:])\s*:\s*(.*[\S])\s*/ix;
	$cond = $1;
	$set = $2;
	$toValue = $3;

	$debug && print STDERR "[$cond] [$set] [$toValue]\n";
	### Perform some validation checks on the statement.
	fatal ("Don't use nested conditionals in:\n\n    $_") 
		if ($set =~ /(if|unless)/i);
	$opens = tr/(/(/;
	$closes = tr/)/)/;
	fatal("Mismatched parentheses in:\n\n    $cond") 
		if ($opens != $closes);
	$tmp = $cond;
	$tmp =~ s/\&\&|\|\|//g;
	failSecurity("<B>$cond </B>contains unamtched &#124;s and &amp;s") 
		if ($tmp =~ /&|\|/);
	fatal ("Too many quote marks in a configuration line:\n\n    $_")
		if (($toValue =~ tr/"/"/) > 2);

	### Some values can contain other config and form values, but
	### NOT ALL. Why? Paranoid security and I really can't see a use
	### for changing the others.
	if ($toValue =~ /^"[^"]*"\s*$/ &&
		$set =~ /$replaceable/ix) {
		$toValue = replacer($toValue, $set);
	}

	$cond = evalCond($cond);
	if ($cType) {
		setConfig($set, $toValue) unless ($cond);
	} else {
		setConfig($set, $toValue) if ($cond);
	}
}


############################################################################
# Subroutine: evalCond ( condition )
# Return true or false based on whether the condition evaluates
############################################################################
sub evalCond {
	my $cond = shift;
	### The not operator needs a bit of pre-tweaking for easy matching.
	$cond =~ s/!([^=])/! $1/g;
	### Now break into smaller parts and security check.
	my @conBits = split (/\(\s*|\)\s*|\&\&\s*|\|\|\s*|\!\s+/, $cond);

	my $ops = "\\s+has(?:nt)?\\s+|\\s*[=!]=\\s*|\\s+eq\\s+|" .
			  "\\s+ne\\s+|\\s*[<>]=?\\s*|\\s+[gl]t\\s+|" .
			  "\\s+[gl]e\\s+|\\s+contains\\s+|\\s+(?:longer|shorter)than\\s+";

	### Each part should be of the form:
	### field op token	  OR	  field	
	### where field is a field name from the form, op is a boolean
	### operator and token is some alphanumeric.
	while (scalar(@conBits)) {
		### Have to put the scalar in to cope with null list values.
		my $part = shift(@conBits);
		next unless ($part =~ /\S/);
		my ($field, $op, $val, $result);
		$_ = $part;
		$debug && print STDERR "Looking at condition $_ \n";
			
		if (/^("[^"]+"|'[^']+'|[\S]+)($ops)
			("[^"]+"|'[^']+'|[\S]+)\s*$/x) {
	
			### Dealing with a boolean expression.
			$result = '0';
			$field = $1;
			$op = lc($2);
			$val = $3;
			$op =~ s/\s//g;
			$field =~ s/^"([^"]+)"/$1/ unless ($field =~ s/^'([^']+)'/$1/);
			$val =~ s/^"([^"]+)"/$1/ unless ($val =~ s/^'([^']+)'/$1/);
			securityName($field) unless 
				($field =~ /^\$((http|cookie)_[\w\-]+|
								(maillist|counter)_\d+|sql_\d+_\d+_\d+)/xi);
			$debug && print STDERR "field = $field; op = $op; val = $val \n";

			### Now see if field is something out of the form.
			if ($op =~ /^has/) {
				$debug && print STDERR "parsing has condition $op \n";
				if ($field =~ /^\$cookie_([\w\-]+)/) {
					$result = '1' if ($query->cookie($1) eq $val);
				} elsif ($field =~ /^\$(http_[\w\-]+)/i) {
					$result = '1' if (getHttpValue($1) eq $val);
				} elsif ($field =~ /^\$counter_(\d+)/i) {
					$result = '1' if 
						($CONFIG{'counter'}->{"${1}value"} eq $val);
				} elsif ($field =~ /^\$maillist_(\d+)$/) {
					$result = 1 if 
						($CONFIG{"maillistdata"} && 
							$CONFIG{"maillistdata"}->{$1} eq $val);
				} elsif ($field =~ /^\$(sql_\d+_\d+_\d+)$/i) {
					$result = '1' if ($sqlVals{$1} eq $val);
				} else {
					foreach ($query->param($field)) {
						($debug) && print STDERR "Checking $_ against $val\n";
						$result = '1',last if ($_ eq $val);
					}
				}
				$result = !$result if ($op =~ /nt/);
			} elsif ($op =~ /^(longer|shorter)than/) {
				$debug && print STDERR "parsing longer/shorter condition $op \n";
				my $subOp = $1;
				my $str = undef;
				if ($field =~ /^\$cookie_([\w\-]+)/) {
					$str = $query->cookie($1) || "";
				} elsif ($field =~ /^\$(http_[\w\-]+)/i) {
					$str = getHttpValue($1) || "";
				} elsif ($field =~ /^\$counter_(\d+)/i) {
					$str = $CONFIG{'counter'}->{"${1}value"} || "";
				} elsif ($field =~ /^\$maillist_(\d+)$/) {
					$str = $CONFIG{"maillistdata"}->{$1} || "";
				} elsif ($field =~ /^\$(sql_\d+_\d+_\d+)$/i) {
					$str = $sqlVals{$1} || "";
				}
				if (defined($str)) {
					($debug) && print STDERR "Checking $str against $val\n";
					if ($subOp eq 'longer') {
						$result = '1' if (length($str) > $val);
					} else {
						$result = '1' if (length($str) < $val);
					}
				} else {
					foreach ($query->param($field)) {
						($debug) && print STDERR "Checking $_ against $val\n";
						if ($subOp eq 'longer') {
							$result = '1' if (length() > $val);
						} else {
							$result = '1' if (length() < $val);
						}
					}
				}
			} elsif ($op =~ /^contains/) {
				### Escape out potential regexp characters
				$val = "\Q$val\E";
				if ($field =~ /^\$cookie_([\w\-]+)/i) {
					$field = $query->cookie($1);
					$result = ($field =~ /$val/i);
				} elsif ($field =~ /^\$(http_[\w\-]+)/i) {
					$field = getHttpValue($1);
					$result = ($field =~ /$val/i);
				} elsif ($field =~ /^\$counter_(\d+)/i) {
					$result = 
						($CONFIG{'counter'}->{"${1}value"} =~ /$val/i);
				} elsif ($field =~ /^\$maillist_(\d+)$/) {
					$result = 1 if 
						($CONFIG{"maillistdata"}->{$1} =~ /$val/i);
				} elsif ($field =~ /^\$(sql_\d+_\d+_\d+)$/i) {
					$result = '1' if ($sqlVals{$1} =~ /$val/);
				} else {
					foreach ($query->param($field)) {
						$result = '1',last if (/$val/i);
					}
				}
			} else {
				if ($field =~ /^\$cookie_([\w\-]+)/i) {
					$field = $query->cookie($1);
				} elsif ($field =~ /^\$(http_[\w\-]+)/i) {
					$field = getHttpValue($1);
				} elsif ($field =~ /^\$counter_(\d+)/i) {
					$field = $CONFIG{'counter'}->{"${1}value"};
				} elsif ($field =~ /^\$(sql_\d+_\d+_\d+)$/i) {
					$result = '1' if ($sqlVals{$1} eq $val);
				} elsif ($field =~ /^\$maillist_(\d+)$/) {
					$result = '1' if 
						($CONFIG{"maillistdata"} && $CONFIG{"maillistdata"}->{$1} eq $val);
				} else {
					$field = $query->param($field);
				}
				### Single quote strings to stop them being 'eval'ed
				$field = "\"\Q${field}\E\"" unless ($field =~ /^\d+$/);
				$val = "\"\Q$val\E\"" unless ($val =~ /^\d+$/);
				($debug) && print STDERR "Evaling $field $op $val\n";
				$result = eval "$field $op $val";
			}
		} elsif (/^\s*("[^"]+"|'[^']+'|\S+)\s*$/) {
			### Does the field exist?
			$field = $1;
			$field =~ s/^"([^"]+)"/$1/ unless 
				($field =~ s/^'([^']+)'/$1/);
			if ($field =~ /^\$cookie_([\w\-]+)/i) {
				$result = defined $query->cookie($1) ? 1 : 0;
			} elsif ($field =~ /^\$(http_[\w\-]+)/) {
				$result = (getHttpValue($1) != "") ? 1 : 0;
			} elsif ($field =~ /^\$counter_(\d+)/i) {
				$result = ($CONFIG{'counter'}->{"${1}value"}) ? 1 : 0;
			} elsif ($field =~ /^\$maillist_(\d+)$/) {
				$result = 
					($CONFIG{"maillistdata"} && $CONFIG{"maillistdata"}->{$1}) ? 1 : 0;
			} elsif ($field =~ /^\$(sql_\d+_\d+_\d+)$/i) {
				$result = ($sqlVals{$1} || $sqlVals{$1} eq '0') ? 1 : 0;
			} else {
				securityName($field);
				$result = (defined $query->param($field)) ? 1 : 0;
			}
		} else {
			fatal("Bad conditional:\n\n    $_");
		}

		$result = '0' if ($result != 1);
		$cond =~ s/\Q$part\E/$result /;
	}

	($debug) && print STDERR "Should eval condition $cond\n";
	eval {$cond = eval "$cond"};
	return $cond;
}


############################################################################
# Subroutine: replacer ( string_containing_things_to_replace )
# The aim here is to do robust replacement of values from the user's form
# (anything that starts with '$form_') most of the http_ variables that
# can be used in output tags (things starting '$http_'), cookie values
# (anything starting with '$cookie_') and some
# special ones like $subject, $sendersubject, $replyto, $mailto...
# All the replacement values must appear in a double quoted string.
############################################################################
sub replacer {
	($debug) && (print STDERR "replacer (@_) \@ " . time . "\n");
	my $toValue  = shift;
	my $setValue  = shift;
	$toValue	 =~ s/^"(.*)"\s*$/$1/;
	my $escaped = ($setValue =~ /^goto/i ? 1 : 0);
	my $tmpString = "";
	my @chunks = split(/((?:(?:\$form|\$http|\$cookie)_[\w\-]+)|
						(?:(?:\$\{form|\$\{http|\$\{cookie)_[\w\-]+?\})|
						\$sql_\d+_\d+_\d+|\${sql_\d+_\d+_\d+}|
						\$mailto(?:\d*)|\$\{mailto(?:\d*)\}|
						\$goto(?:success|failure|blank|expires)|
						\$\{goto(?:success|failure|blank|expires)\}|
						\$sendersubject|\$\{sendersubject\}|
						\$subject(?:\d*)|\$\{subject(?:\d*)\}|
						\$senderreplyto|\$\{senderreplyto\}|
						\$replyto(?:\d*)|\$\{replyto(?:\d*)\}|
						\$counter_\d+|\$\{counter_\d+\}|
						\$maillist_\d+|\$\{maillist_\d+\})/ix, $toValue);

	### Now look through what we've got.
	for (@chunks) {
		s/^\$\{(.*)\}$/\$$1/;
		($debug) && print STDERR "replacer looking at chunk $_\n";
		if (/^\$(((form|http|cookie)_[\w\-]+)|sql_\d+_\d+_\d+|
					mailto|(sender)?subject|(sender)?replyto|
					counter_\d+|maillist_\d+)/ix) {
			my $replaceStr = "";
			my $isCounter = 0;
			if (/^\$form_([\w-]+)/i) {
				### This is a value from the submitted form.
				$replaceStr = $query->param($1);
			} elsif (/^\$counter_\d+/i) {
				### This is a counter
				$needToReplace{lc($setValue)} = 1;
				$replaceStr = $_;
				$isCounter = 1;
			} elsif (/^\$(http_referer)/i) {
				### This is one of the http variables.
				$replaceStr = getHttpValue($1);
			} elsif (/^\$(http_ref)/i) {
				### This is a reference number, which we may work out with counters
				$needToReplace{lc($setValue)} = 1;
				$replaceStr = $_;
			} elsif (/^\$(http_[\w\-]+)/i) {
				### This is one of the http variables.
				$replaceStr = getHttpValue($1);
			} elsif (/^\$cookie_([\w-]+)/i) {
				### This is a cookie value.
				$replaceStr = $query->cookie($1);
			} elsif (/^\$(sql_\d+_\d+_\d+)$/) {
				### This is a sql statement return
				$replaceStr = $sqlVals{$1};
			} elsif (/^\$maillist_(\d+)$/) {
				### This is maillist info
				$replaceStr = $CONFIG{'maillistdata'}->{$1};
			} else {
				/^\$(.*)/;
				my $tag = lc($1);
				$tag =~ /^(.*?)(\d*)$/;
				if (ref ($CONFIG{$1})) {
					$tag = $2 ? $2 : "DEFAULT";
					$replaceStr = $CONFIG{$1}->{$tag};
				} else {
					$replaceStr = $CONFIG{lc($1)};
				}
				if ($1 =~ /^goto/i) { $escaped = 0; }
			}
			$replaceStr =~ s/\s/ /g;
			if ($escaped && !$isCounter) { $replaceStr = URLescape($replaceStr); }
			$tmpString .= $replaceStr;
		} else {
			$tmpString .= $_;
		}
	}
	($debug) && print STDERR "Replacer returns [$tmpString]\n";
	return $tmpString;
}


############################################################################
# Subroutine: getHttpValue ( string_to_match )
# Given a string starting with 'http_', this will return an appropriate
# value from the CGI environment, or an emprty string if it doesn't 
# recognise what was passed in.
############################################################################
sub getHttpValue {
	($debug) && (print STDERR "getHttpValue (@_) \@ " . time . "\n");
	$_ = shift;
	if (/^http_(remote_user|remote_addr|remote_ident|remote_host|
				server_name|server_port)$/xi) {
		return($ENV{"\U$1\E"});
	}
	if (/^(http_(user_agent|referer|from|host))$/i) {
		return($ENV{"\U$1\E"});
	}
	if (/^http_time/) {
		return(translateFormat("%hhhh%:%mm%:%ss%"));
	}
	if (/^http_date/) {
		return(translateFormat("%ddd% %mmmm% %dd% %yyyy%"));
	}
	if (/^http_ref/) { return($CONFIG{'ref'}); }
	if (/^http_config_path/) { return("$pageRoot/"); }
	if (/^http_config_error/) { return($CONFIG{'error'}); }
	return undef;
}


############################################################################
# Subroutine: checkEmail ( email_address )
# Found a flaw in the email handling, so check that email addresses are
# correct... or at least contain reasonable characters
# The flaw would fail because the email had mismatched < brackets
############################################################################
sub checkEmail {
	($debug) && (print STDERR "checkEmail (@_) \@ " . time . "\n");
	$_ = shift;
	my ($opens, $closes);
	$opens = tr/</</; 
	$closes = tr/>/>/;
	fatal("Malformed Email in:\n\n    $_") if 
		($opens != $closes || $opens > 1 || $opens == 1 && !/^<.*>$/);
	s/</&lt;/, fatal("Can't handle email type:\n\n    $_") if 
		(/[^,\'\w\-\.\@\/\!\%\:\<\>\s\xc0-\xd6\xd8-\xf6\xf8-\xff ]/);
}


############################################################################
# Subroutine: fatal (msg)
# Takes a string message and makes a HTML failure page.
############################################################################
sub fatal {
	($debug) && (print STDERR "fatal (@_) \@ " . time . "\n");
	my ($msg) = @_;
	$msg = dehtml(undef, $msg);
	print "Content-type: text/html$CRLF$CRLF";
	print <<"	EOT";
	<HTML><HEAD><TITLE>Fatal Error</TITLE></HEAD>
	<BODY>
	<H1>Error:</H1>
	The soupermail CGI died due to the following error:<P>
	<BLOCKQUOTE><pre>$msg</pre></BLOCKQUOTE>
	<HR>
	Check your soupermail configuration or contact: 
	<A HREF="mailto:$soupermailAdmin">$soupermailAdmin</A> 
	informing them of the error, and how and where it occured.<P>
	<HR>
	<P>
	Soupermail Release Version $relVersion
	</P>
	</BODY></HTML>
	EOT
	cleanScratch();
	exit;
}


############################################################################
# Subroutine: securityFilename ( path_to_check )
# Exit the script if a filename contains ..'s or other potentially nasty
# characters.
############################################################################
sub securityFilename { 
	($debug) && (print STDERR "securityFilename (@_) \@ " . time . "\n");
	my ($filename) = shift;
	if ($filename =~ /\.\.|\~|[^\w\.\-\/:]/) {
		failSecurity("Filename $filename contains a .. " .
						" or other illegal characters");
		cleanScratch();
		exit;
	}
}


############################################################################
# Subroutine: securityName ( form_name_to_check )
# Exit the script if a given string contains shell meta characters
############################################################################
sub securityName {
	($debug) && (print STDERR "securityName (@_) \@ " . time . "\n");
	$_ = shift;
	my ($isrequired) = shift;
	my ($opens, $closes);
	my ($name) = $_;
	if ($isrequired) {
		### Required names can have brackets, &&s and ||s in, so strip
		### them from the name before checking and ensure they all match
		### up.
		$opens = tr/(//d;
		$closes = tr/)//d;
		fatal("Mismatched parentheses in:\n\n    $name") if 
			($opens != $closes);
		### Make sure people are only putting proper numbers of
		### ampersands in!
		s/&&|\|\|//g;
		#### And remove operators
		s/!=|==|<=|>=|<|>|!//g;
	}
	if (s!([^"'\w\s\.\-])!<font color="#ff0000"><b>$1</b></font>!g) {
		failSecurity ("$_ contains an insecure string such as a " .
						"shell meta character. Please use another string " .
						"containing only alphanumerics\n");
		cleanScratch();
		exit;
	}
}


############################################################################
# Subroutine: failSecurity ( failure_message )
# Something has failed a security check, so bomb out with a failure message
############################################################################
sub failSecurity {
	($debug) && (print STDERR "failSecurity (@_) \@ " . time . "\n");
	my ($msg) = shift;
	print $query->header();
	print "<HTML> <HEAD> <TITLE>Form Response</TITLE> </HEAD>\n";
	print "<BODY> <H1>Sorry</H1>\n";
	print "The form failed a security check.\n";
	if ($msg) {
		print "<P><H2>Failure Message:</H2><br \/>\n$msg\n";
	}
	print "</BODY> </HTML>\n";
	cleanScratch();
	exit;
}


############################################################################
# Subroutine: nukeValues ()
# This goes through all the form values, removing blank values and stripping
# leading and trailing space characters. Care is taken not to munge up 
# files that have been submitted using file upload.
############################################################################
sub nukeValues {
	($debug) && (print STDERR "nukeValues (@_) \@ " . time . "\n");
	no strict 'refs';
	my (@vals, @newvals, $val);
	foreach $val ($query->param()) {
		undef @newvals;
		@vals = $query->param($val);
		foreach (@vals) { 
			### Skip stripping for file upload fields.
			if (fileno($_)) { push(@newvals, $_); next; }
			s/(^\s+|\s+$)//g;
			### Read phrack 55 to see why the line below exists. ta rfp.
			s/\0//g;
			push (@newvals, $_) if /\S/;
		}
		$query->delete($val) unless (@newvals);
		$query->param($val, @newvals);
	}
}


############################################################################
# Subroutine: formIsBlank ()
# Return TRUE if the form is blank (i.e. has no non-ignored fields filled 
# in)
############################################################################
sub formIsBlank {
	($debug) && (print STDERR "formIsBlank (@_) \@ " . time . "\n");
	my (%names, $name, @vals);
	foreach ($query->param()) {
		@vals = $query->param($_);
		$names{$_} = ($#vals < 0) ? 0 : 1;
	}
	foreach $name (@ignored) {
		delete $names{$name};
	}
	return(!keys(%names));
}


############################################################################
# Subroutine: formMissingRequired ()
# Check that all the required bits have been filled in in the form.
# This bit is liable to change to add more complex behaviour
# Returns TRUE if the form has any missing bits
############################################################################
sub formMissingRequired {
	($debug) && (print STDERR "formMissingRequired (@_) \@ " . time . "\n");
	my ($name, $requiredLine, @requirednames, $replacement, $missing,
		$oldname);
	my (@vals);
	foreach $requiredLine (@required) {
		$missing = ! evalCond($requiredLine);
		last if ($missing);
	}
	return($missing);
}


############################################################################
# Subroutine: badTypes ( type_list )
# Check that the given datatypes for various fields are correct. Expects
# an array of type, value pairs to be passed in. Returns true if there
# are incorrect types.
############################################################################
sub badTypes {
	my $toCheck = shift;
	foreach (@$toCheck) {
		my ($type, $name) = @$_;
		my $v;
		foreach $v ($query->param($name)) {
			if (checkType($type, $v)) { return 1; }
		}
	}
	return 0;
}


sub checkType {
	my $type = shift;
	my $v = shift;
	my $r = 1;
	$type =~ s/^is//;
	if ($type =~ s/^not//) { $r = 0; }
	return 0 unless (defined $v);
	if ($type eq 'number') {
		if ($v !~ /^-?\d*(\.\d*)?$/) { return $r; }
	} elsif ($type eq 'integer') {
		if ($v !~ /^-?\d*(\.0*)?$/) { return $r; }
	} elsif ($type eq 'email') {
		if ($v !~ /^[\w\-\.\+\/\\\xc0-\xd6\xd8-\xf6\xf8-\xff ]+
				  \@[A-Za-z\d][\-\w]*[A-Za-z\d]
			(\.[\dA-Za-z][\-\w]*[A-Za-z\d])+$/x) { return $r; }
	} elsif ($type eq 'creditcard') {
		$v =~ s/\D//g;
		if (length($v) < 13) { return $r; }
		my ($sum, $i) = 0;
		foreach (reverse split(//, $v)) {
			my $s = $_ * (1 + $i++ % 2);
			$sum += $s - ($s > 9 ? 9 : 0);
		}
		if ($sum % 10) { return $r; }
	} 
	return !$r;
}

############################################################################
# Subroutine: returnHtml ( redirection_URL,
#						   template_pathname,
#						   return_message,
#						   boolean_replace_output_tags_flag,
#						   boolean_send_out_cookies_flag,
#						   boolean_is_pdf,
#						   mime_type)
# General routine to output HTML back to the browser.
############################################################################
sub returnHtml {
	($debug) && (print STDERR "returnHtml (@_) \@ " . time . "\n");
	my ($redirect, $template, $msg, $do_substitute, $do_cookie, $isPdf, $mime) = @_;
	my ($outstring);
	my @cookiesToGo = ();
	my $newCookie;

	### This goes throught the cookie settings generating CGI.pm cookie
	### objects.
	if ($do_cookie && scalar (keys %cookieList)) {
		while (my ($k, $i) = each(%cookieList)) {
			my %cookieVals = %$i;
			next unless ($cookieVals{"value"});
			$newCookie = $query->cookie(-name=>$cookieVals{"name"},
										-expires=>$cookieVals{"expires"},
										-value=>$cookieVals{"value"},
										-domain=>$cookieVals{"domain"},
										-path=>$cookieVals{"path"},
										-secure=>$cookieVals{"secure"});
			push(@cookiesToGo, $newCookie);
		}
	}

	### Handle redirects or send the output from a template or default
	### message.
	if ($redirect) {
		if (@cookiesToGo) {
			print $query->redirect(-URL=>$redirect, -cookie=>\@cookiesToGo);
		} else {
			print $query->redirect($redirect);
		}
	} else {
		if ($template) {
			my $attName = $template;
			($debug) && print STDERR "Returning template $attName\n";
			$attName =~ s!.*/([^/]+)$!$1!;
			my $header = {};
			grabFile($template, \$outstring);
			if ($isPdf) {
				($do_substitute) && (substOutput(\$outstring, '4', 1));
				$attName =~ s/\..*$/\.pdf/;
				$attName .= ".pdf" unless ($attName =~ /\.pdf$/);
				($debug) && print STDERR "Attachment name $attName\n";
				$header->{'-Content_Disposition'} = "file;filename=${attName}";
			} else {
				($do_substitute) && (substOutput(\$outstring, '1'));
				if ($mime ne "text/html") {
					$header->{'-Content_Disposition'} = "inline;filename=${attName}";
				}
			}
			if (@cookiesToGo) {
				$header->{'-cookie'} = \@cookiesToGo;
			}
			$header->{'-type'} = "${mime};name=${attName}";
			print $query->header(%$header);
			if ($isPdf) {
				my $pdfFile = makePdf(\$outstring, $CONFIG{'pdftemplate'});
				($debug) && (print STDERR "sending out pdf $pdfFile\n");
				my $pdfOutput = "";
				grabFile($pdfFile, \$pdfOutput);
				($debug) && (print STDERR "pdf output size = " . 
										  length($pdfOutput) . " bytes\n");
				print $pdfOutput;
			} else {
				print $outstring;
			}
		} else {
			if (@cookiesToGo) {
				print $query->header(-type=>'text/html',
									-cookie=>\@cookiesToGo); 
			} else {
				print $query->header();
			}
			print "<HTML> <HEAD> <TITLE>Form Response</TITLE> </HEAD>\n";
			print "<BODY> $msg\n";
			print "</BODY> </HTML>\n";
		}
	}
}

############################################################################
# Subroutine: grabFile (filename, stringRef)
# Reads a file (usually a template) and places its contents in the thing
# specified by stringRef
############################################################################
sub grabFile {
	($debug) && (print STDERR "grabFile (@_) \@ " . time . "\n");
	my ($file, $buffer) = @_;
	my $fPath = $file;
	### Be paranoid, let admins block read access to directories or
	### block access on a global scale.
	$fPath =~ s/\\+/\//g;
	$fPath =~ s/(.*\/).*/$1/;
	if (-f "${fPath}$denyFile") {
		($debug) && print STDERR "SECURITY : ${fPath}$denyFile exists\n";
		failSecurity("Blocked from reading files in the given directory");
	}
	if ($paranoid && ! -f "${fPath}$allowFile") {
		($debug) && print STDERR "SECURITY : ${fPath}$allowFile doesn't exist\n";
		failSecurity("Not explicitly allowed to read files in the given directory - read http://soupermail.sourceforge.net/faq.html#notallowed");
	}
	my @stats = stat($file);
	open (FILE, "<$file") || fatal("Failed to open:\n\n    '${file}'");
	($fileLocking) && flock(FILE, LOCK_SH);
	binmode(FILE);
	read(FILE, $$buffer, $stats[7]);
	($fileLocking) && flock(FILE, LOCK_UN);
	close(FILE);
	($debug) && (print STDERR "file grabbed is $stats[7] bytes\n");
}

############################################################################
# Subroutine: returnBlank ()
# If the form was blank, produce a www page saying so
############################################################################
sub returnBlank {
	($debug) && (print STDERR "returnBlank (@_) \@ " . time . "\n");
	my ($msg) = "<H1>Sorry</H1>\n";
	$msg .= "You did not enter any form fields so the form was not submitted";
	returnHtml($CONFIG{'gotoblank'}, $CONFIG{'blank'}, $msg, 1, 
				$CONFIG{'blankcookie'},0,$CONFIG{'blankmime'});
}


############################################################################
# Subroutine: returnExpired
# The form is out of date, so return a page saying so.
############################################################################
sub returnExpired {
	($debug) && (print STDERR "returnExpired (@_) \@ " . time . "\n");
	my $msg = "<h1>Sorry</h1>The Form is now out of date. Your " .
				"information was not submitted.\n";
	my $goto = $CONFIG{'gotoexpires'} ? $CONFIG{'gotoexpires'} : '0';
	my $template = $CONFIG{'expirestemplate'} ? 
		$CONFIG{'expirestemplate'} : '0';
	returnHtml($goto, $template, $msg, 1, $CONFIG{'expirescookie'}, 0,
			   $CONFIG{'expiresmime'});
}


############################################################################
# Subroutine: returnFailure ()
# Return a failure page indicating that some required fields are missing
############################################################################
sub returnFailure {
	($debug) && (print STDERR "returnFailure (@_) \@ " . time . "\n");
	my $msg = "<H1>Sorry</H1>\n" .
			  "You did not complete all the required sections of the\n" .
			  "form.<br />Use your browser's BACK button to return to the\n".
			  "form and complete the missing fields.\n";
	my $goto = $CONFIG{'gotofailure'} ? $CONFIG{'gotofailure'} : '0';
	my $template = $CONFIG{'failure'} ? $CONFIG{'failure'} : '0';
	returnHtml($goto, $template, $msg, 1, $CONFIG{'failurecookie'}, 0,
			   $CONFIG{'failuremime'});
}


############################################################################
# Subroutine: returnSuccess ()
# The form has been successfully completed, so return a www page saying so
############################################################################
sub returnSuccess {
	($debug) && (print STDERR "returnSuccess (@_) \@ " . time . "\n");
	my $msg = "<H1>Thank You</H1>Your information has been submitted\n";
	my $goto = $CONFIG{'gotosuccess'} ? $CONFIG{'gotosuccess'} : '0';
	my $template = $CONFIG{'success'} ? $CONFIG{'success'} : '0';

	if (!$template && $CONFIG{'pdftemplate'}) {
		returnHtml($goto, $CONFIG{'pdftemplate'}, $msg, 1, 
				   $CONFIG{'successcookie'}, 1, 'application/pdf');
	} else {
		returnHtml($goto, $template, $msg, 1, $CONFIG{'successcookie'}, 0,
				   $CONFIG{'successmime'});
	}

	### Hmm, for user percieved speed, does closing STDOUT now help?
	close(STDOUT);
	if (scalar(keys(%{$CONFIG{'fileto'}}))) {
		saveResults();
	}
	if (keys(%{$CONFIG{'mailto'}}) || $CONFIG{'returntosender'} || 
		$CONFIG{'sendertemplate'} || $CONFIG{'htmlsendertemplate'} ||
		$CONFIG{'pdfsendertemplate'} || $CONFIG{'pdfmailtemplate'} ||
		$CONFIG{'maillist'} || $CONFIG{'listformfield'}) {
		$debug && print STDERR "About to mailResults\n";
		mailResults();
	}
}



############################################################################
# Subroutine: translateFormat ()
# Take a format string and return the expanded output.
############################################################################
sub translateFormat {
	($debug) && (print STDERR "translateFormat (@_) \@ " . time . "\n");
	my ($format) = shift;
	my ($offset) = shift;
	my ($mm, $mmm, $mmmm, $yy, $yyyy, $hh, $hhhh, $ss, $dd, $ddd, $ampm);
	my ($maxfactor) = 12; ### :-)
	my ($randomno);
	my $eTime = time;
	my ($currtime) = scalar (localtime($eTime));

	### Here, see if we need to rebuild based on an offset
	if ($offset && $offset =~ /^\s*([\+\-]?)\s*(\d+)\s*([smhd])\s*$/) {
		my $plusMinus = $1 ? $1 : "+";
		my $offBy = $2;
		my $unit = $3;
		($debug) && (print STDERR "got timeoffset of $1, $2, $3\n");
		if ($unit eq "m") { $offBy *= 60; }
		if ($unit eq "h") { $offBy *= 3600; }
		if ($unit eq "d") { $offBy *= 86400; }
		$currtime = scalar(localtime(eval("time $plusMinus $offBy")));
	}
	$currtime =~ /^(\w+)\s+(\w+)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+(\d+)/;
	$ddd = $1;
	$mmmm = $2;
	$dd = $3;
	$hhhh = $4;
	$mm = $5;
	$ss = $6;
	$yyyy = $7;

	if ($offset && $offset =~ /^\s*([\+\-]?)\s*(\d+)\s*([My])\s*$/) {
		$mmm = $MONTHS{$mmmm};
		my $plusMinus = $1 ? $1 : "+";
		my $offBy = $2;
		my $unit = $3;
		($debug) && (print STDERR "got timeoffset of $1, $2, $3\n");
		if ($unit eq "M") {
			my $diff = eval("\$mmm $plusMinus \$offBy");
			if ($diff > 12 || $diff < 1) {
				($debug) && (print STDERR "evaling $yyyy $plusMinus floor(($diff - 1) / 12)\n");
				$yyyy = eval("\$yyyy + floor((\$diff - 1) /12)");
			}
			($debug) && (print STDERR "year is now $yyyy\n");
			$mmm = eval("\$mmm $plusMinus \$offBy");
			if ($mmm != 12) { $mmm = $mmm % 12; }
			$mmm = 12 unless ($mmm);
		} else {
			($debug) && (print STDERR "evaling $yyyy $plusMinus $offBy\n");
			$yyyy = eval("\$yyyy $plusMinus \$offBy");
		}
		my $eTime = timelocal(1, 1, 1, $dd, $mmm - 1, $yyyy);
		$currtime = scalar (localtime($eTime));
		$currtime =~ /^(\w+)\s+(\w+)\s+(\d+)\s+\d+:\d+:\d+\s+(\d+)/;
		$ddd = $1;
		$mmmm = $2;
		$dd = $3;
		$yyyy = $4;
	}
	$mmm = $MONTHS{$mmmm};
	$hh = ($hhhh > 12) ? ($hhhh - 12) : $hhhh;
	$ampm = ($hhhh > 12) ? "pm" : "am";
	$yyyy =~ /(\d\d)$/;
	$yy = $1;
	$hh = sprintf("%02u", $hh);
	$mm = sprintf("%02u", $mm);
	$ss = sprintf("%02u", $ss);
	$dd = sprintf("%02u", $dd);
	$yy = sprintf("%02u", $yy);
	$format =~ s/%yyyy%/$yyyy/gi;
	$format =~ s/%hhhh%/$hhhh/gi;
	$format =~ s/%ddd%/$ddd/gi;
	$format =~ s/%mmmm%/$mmmm/gi;
	$format =~ s/%mmm%/$mmm/gi;
	$format =~ s/%mm%/$mm/gi;
	$format =~ s/%dd%/$dd/gi;
	$format =~ s/%yy%/$yy/gi;
	$format =~ s/%ss%/$ss/gi;
	$format =~ s/%hh%/$hh/gi;
	$format =~ s/%ampm%/$ampm/gi;
	$format =~ s/%epoch%/$eTime/gi;
	$