#!/usr/local/bin/perl
# $Header: /meer/cvs_apps/website/cgi-bin/mailit.cgi,v 1.4 2008/03/10 12:08:22 cvs Exp $
#
use strict;

# Globals
my $VERSION                     = '2.0';
my $CONFIG_FILE         = 'siteconfig';
my $RECIPIENT_FILE      = 'mailit.users';

our( $DEBUG, $SENT_HEADERS );

######################################################################
# Main Routine
######################################################################
# Open configuration file, and extract a list of parameters and values.
my $CONFIG = &readValues( $CONFIG_FILE );

# Open the recipient file, and extract a list of valid recipients.
my $VALID_RECIPIENTS = &readList( $RECIPIENT_FILE );

# Get and validate the input
my $contents = &getInput();

# Get a hash of validated recipients
my $recipients = &validateRecipients( $contents->{'Recipient'}, $contents->{'CarbonCopy'}, $contents->{'BlindCopy'} );

# Now special process the subject for tags
$contents->{'Subject'} = &parseText( $contents->{'Subject'} );
$contents->{'Subject'} =~ s/[\r\n](.*)$//gs;            # Make sure it's just one line

# Print it all out
print "Content-Type: text/html\n\n";
$SENT_HEADERS = 1;
$| = 1;

# Send the mail
&sendMail( $recipients, $contents );

&sendResults( $recipients, $contents );

# send the receipt
if( $contents->{'Customer_Receipt'} ) {
        &sendReceipt( $contents );
}

# ..and exit.
exit 0;

######################################################################
# Acquire Configuration Information
######################################################################
sub getInput {
        use vars qw( %ENV $CONFIG );
        my( $hackattempt );

        # Decode the contents of the fields.
        my $contents = &getFormInput();

        # Default some values
        if( ! $contents->{'Form'} ) {
                $contents->{'Form'} = $ENV{'HTTP_REFERER'} || "*unknown*";
        }

        # Make sure a recipient was specified - if not, use a default recipient.
        if( ! $contents->{'Recipient'} ) {
                $contents->{'Recipient'} = $CONFIG->{'WebMaster'};
        }

        # Check to see if an attempt to hack the e-mail was made
        foreach my $field ( 'Name', 'EMail', 'Recipient', 'Receipt_From' ) {
                if( $contents->{ $field } =~ /[\r\n]/ ) {
                        $hackattempt++;
                }
        }
        if( $hackattempt ) {
                #&sendHackAlert( $contents );
                #exit 0;
        }

        # Remove potential security-violation information.
        $contents->{'Name'} =~ s/[^\w\s\_\-\+\@\%\.]//g;
        $contents->{'EMail'} =~ s/[^\w\_\-\+\@\%\.]//g;
        $contents->{'Recipient'} =~ s/[^\w\_\-\+\@\%\.]//g;
        $contents->{'Receipt_From'} =~ s/[^\w\_\-\+\@\%\.]//g;

        # Check for required fields
        if( $contents->{'EMail'} !~ /\w+\@[\w\-]+\.\w+/ ) {
                &sendError( 'Please enter a valid email address ( name@domain.tld ).' );
        }
        elsif( $contents->{'EMail'} =~ /\w+\@$ENV{'SERVER_NAME'}/ ) {
                #&sendHackAlert( $contents );
                #exit 0;
        }

        # Now check for required fields
        my( $missing_fields );
        if( $contents->{'Required_Field'} ) {
                foreach my $field ( split( /,/, $contents->{'Required_Field'} ) ) {
                        if( ! $contents->{ $field } ) {
                                $missing_fields .= $field . ",";
                        }
                        chop( $missing_fields );        # Remove the trailing comma
                }
                if( $missing_fields ) {
                        &sendError( "The following fields are required: ${missing_fields}" );
                }
        }

        # Now return the info
        return $contents;
}

sub validateRecipients {
        my $recipient = shift;
        my $cclist = shift;
        my $bcclist = shift;
        my( $validated );

        # Error out if the recipient is not authorized.
        if( &isValidRecipient( $recipient ) ) {
                $validated->{'Recipient'} = $recipient;
        }
        else {
                &sendError( "The recipient of this form is not on the authorized list." );
        }

        # Look through carbon copy recipients
        if( $cclist ) {
                foreach my $carboncopy ( split( /,/, $cclist ) ) {
                        if( &isValidRecipient( $carboncopy ) ) {
                                $validated->{'CarbonCopy'} .= $carboncopy . ", ";
                        }
                        else {
                                $validated->{'Warnings'} .= "CarbonCopy recipient '$carboncopy' is not an authorized recipient.\n";
                        }
                }

                # Remove the final comma
                $validated->{'CarbonCopy'} =~ s/, $//;
        }

        # Look through blind carbon copy recipients
        if( $bcclist ) {
                foreach my $blindcopy ( split( /,/, $bcclist ) ) {
                        if( &isValidRecipient( $blindcopy ) ) {
                                $validated->{'BlindCopy'} .= $blindcopy . ", ";
                        }
                        else {
                                $validated->{'Warnings'} .= "BlindCopy recipient '$blindcopy' is not an authorized recipient.\n";
                        }
                }

                # Remove the final comma
                $validated->{'BlindCopy'} =~ s/, $//;
        }

        return( $validated );
}

# Subroutine to check for a valid recipient
sub isValidRecipient {
        use vars qw( $VALID_RECIPIENTS );
        my $recipient = shift;

        # Check each recipient in order, return successful if found.
        my $found = 0;
        foreach( @{ $VALID_RECIPIENTS } ) {
                if( /^\s*${recipient}\s*$/i ) {
                        $found = 1;
                        last;
                }
        }

        # Return success or failure.
        return $found;
}

######################################################################
# Send the e-mail message.
######################################################################
sub sendMail {
        use vars qw( %ENV $CONFIG $VERSION );
        my $recipients = shift;
        my $contents = shift;

        open( MAIL, "|/usr/sbin/sendmail -oi  -t" )
                || &sendError( "Unable to open mail program.\n" );

        print MAIL <<END;
From: $contents->{'Name'} <$contents->{'EMail'}>
To: $recipients->{'Recipient'}
Cc: $recipients->{'CarbonCopy'}
Bcc: $recipients->{'BlindCopy'}
Subject: $contents->{'Subject'}
Content-Type: text/plain
X-Mailer: Isite MailIt v${VERSION}
X-Server: $ENV{'SERVER_NAME'}
X-From-Host: $ENV{'REMOTE_HOST'} ($ENV{'REMOTE_ADDR'})

END

        # If an e-mail form page was specified, parse it and send it out
        if( $contents->{'EMailPage'} ) {
                print MAIL &parseFile( $contents->{'EMailPage'} );
        }

        # Otherwise print the standard output.
        else {
                print MAIL "\nThe following was sent from the $contents->{'Form'} form: \n\n";

                # Foreach key
                foreach ( sort keys %{ $contents } ) {
                        #########################################################
                        # Ignore any fields that shouldn't show up in the E-Mail.
                        #
                        /^\s*Return\s*$/ && next;
                        /^\s*ReturnIcon\s*$/ && next;
                        /^\s*AnswerPage\s*$/ && next;
                        /^\s*ReplyPage\s*$/ && next;
                        /^\s*EMailPage\s*$/ && next;
                        /^\s*Form\s*$/ && next;
                        /^\s*Recipient\s*$/ && next;
                        /^\s*CarbonCopy\s*$/ && next;
                        /^\s*BlindCopy\s*$/ && next;
                        /^\s*Name\s*$/ && next;
                        /^\s*EMail\s*$/ && next;
                        /^\s*Body\s*$/ && next;
                        /^\s*Subject\s*$/ && next;
                        /^\s*Customer_Receipt\s*$/ && next;
                        /^\s*Customer_Attachment\s*$/ && next;
                        /^\s*Receipt_From\s*$/ && next;

                        # Otherwise print the field name, followed by the value
                        print MAIL "$_: $contents->{$_}\n";
                }

                # Last, print any Body text
                if( $contents->{'Body'} ) {
                        print MAIL "\nBody Text: \n$contents->{Body}\n";
                }
        }

        if( $recipients->{'Warnings'} ) {
                print MAIL "\n\nForm processing output the following errors:\n$recipients->{'Warnings'}\n";
        }

        # Done Sending E-Mail
        close( MAIL );
}

######################################################################
# Send a security alert when hacked.
######################################################################
sub sendHackAlert {
        use vars qw( %ENV $CONFIG $VERSION );
        my $contents = shift;

        open( MAIL, "|/usr/sbin/sendmail -oi -t" )
                || &sendError( "Unable to open mail program.\n" );

        print MAIL <<END;
From: guru\@isite.net
To: guru\@isite.net
Subject: SECURITY ALERT - attempted mailit hack on $ENV{'SERVER_NAME'}
Content-Type: text/plain
X-Mailer: Isite MailIt v${VERSION}

Server: $ENV{'SERVER_NAME'}
From Host: $ENV{'REMOTE_HOST'} ($ENV{'REMOTE_ADDR'})

The following form input was provided, with an attempt to hack the site:

END

        # Foreach key
        foreach ( sort keys %{ $contents } ) {
                # Otherwise print the field name, followed by the value
                print MAIL "Field '$_'; Value '$contents->{$_}'\n\n";
        }

        # Done Sending E-Mail
        close( MAIL );

        # Send a warning to the sender.
        print <<END;
Content-Type: text/html

<html>
<head>
<title>Hack attempt detected!</title>
<body bgcolor="white">

<h1>Hack Attempt Detected from $ENV{'REMOTE_ADDR'}</h1>

<p>An attempt to deliberately submit invalid data has been detected.
This attempt was clearly an effort to induce a badly written e-mail utility
to send SPAM out for you.  This has been prevented.  The only person who will
receive this information is the District Attorney's Office in Santa Clara
County, California.  We have your IP address, the time and date, and of
course all of the information you provided in your SPAM attempt.  Rest assured
that you will be contacted shortly by legal authorities.</p>

<img src="/isite-lib/icons/isite-noc.jpg" align="right" hspace="12">
<p>If you believe you have received this message in error, you can
<a href="http://support.isite.net/Problem/Report.html">open a trouble ticket</a>
and we can investigate this error.</p>
</body>
</html>
END

        exit 0;
}

######################################################################
# Automatic Notification
######################################################################
sub sendReceipt {
        use vars qw( %ENV $CONFIG $VERSION );
        my $contents = shift;

        my $filename = $contents->{'Customer_Receipt'};
        my $attachment = $contents->{'Customer_Attachment'};
        my $now = time();

        my $sender = $contents->{'Receipt_From'} || $contents->{'Recipient'};

        $DEBUG = "  Entering 'Send E-Mail Receipt' routine:\n    Starting mail message.\n";

        open( MAIL, "|/usr/sbin/sendmail -oi -t" )
                || &sendError( 'CANTMAIL', $? );
        print MAIL <<END;
From: $sender
To: $contents->{'EMail'}
Subject: $contents->{'Receipt_Subject'}
X-Mailer: Isite MailIt v${VERSION}
X-Server: $ENV{'SERVER_NAME'}
X-From-Host: $ENV{'REMOTE_HOST'} ($ENV{'REMOTE_ADDR'})
X-From-Browser: $ENV{'HTTP_USER_AGENT'}
X-From-Form: $contents->{'Form'}
END

# If this is MIME, output the multipart beginning and the first separator
if( $attachment ) {
        print MAIL <<END;
Content-Type: multipart/mixed; boundary="_$ENV{'SERVER_NAME'}.${now}_"

This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.

--_$ENV{'SERVER_NAME'}.${now}_
END
        }

        # Now continue with the message
        print MAIL "Content-Type: text/plain\n\n";

        # parse the file to send
        if( -r $ENV{'DOCUMENT_ROOT'} . $filename ) {
                print MAIL &parseFile( $filename );
        }
        else {
                print MAIL "ERROR: Unable to read receipt file: $filename.\n";
        }

        # Start the MIME section
        if( $attachment ) {
                print MAIL <<END;
--_$ENV{'SERVER_NAME'}.${now}_
END

                if( ( $attachment =~ /\.html/ ) || ( $attachment =~ /\.htm/ ) ) {
                        print MAIL "Content-Type: text/html\n\n";
                }
                elsif( $attachment =~ /\.pdf/ ) {
                        print MAIL "Content-Type: application/pdf\n\n";
                }
                else {
                        print MAIL "Content-Type: text/plain\n\n";
                }

                # parse the file to send
                if( -r $ENV{'DOCUMENT_ROOT'} . $attachment ) {
                        print MAIL &parseFile( $attachment );
                }
                else {
                        print MAIL "ERROR: Unable to read receipt attachment.\n";
                }

                print MAIL <<END;
--_$ENV{'SERVER_NAME'}.${now}_--
END
        }

        # Close the mail, then reopen stderr
        $DEBUG = "    Sending E-Mail... ";
        close MAIL;

        # Done Sending E-Mail
        $DEBUG = " done.\n  Leaving 'Send E-Mail Receipt' routine.\n";

        return 1;
}

######################################################################
# Give the user results
######################################################################
sub sendResults {
        use vars qw( %ENV $CONFIG );
        my $recipients = shift;
        my $contents = shift;

        # If a follow-up page was specified, make it a parsed page
        if( $contents->{'AnswerPage'} ) {
                $contents->{'ReplyPage'} = $contents->{'AnswerPage'};
        }

        # If a parse-page was specified, parse it and send it out
        if( $contents->{'ReplyPage'} ) {
                print &parseFile( $contents->{'ReplyPage'} );
        }

        # Print the normal output, and the submitted information.
        else {
                # Otherwise, print out the default page.
                print <<END;
<html>
<head>
<title>$CONFIG->{'SiteName'} $contents->{'Form'} Results</title>
END


                # Do they have a stylesheet?
                if( $contents->{'Stylesheet'} ) {
                        print qq|<link rel="stylesheet" type="text/css" href="$contents->{'Stylesheet'}">|;
                }

                print "</head><body ";          #Start the BODY Tag
                # Check to see if Netscape's BODY colors have been defined.
                if( $CONFIG->{'BODY_Colors'} ) {
                        print $CONFIG->{'BODY_Colors'}; # ..Add BODY configuration
                }
                print ">\n";            # Close the TAG.

                # Check to see if a Standard HEADER has been defined.
                if( $CONFIG->{'Header'} ) {
                        &printFile( "$ENV{'DOCUMENT_ROOT'}/$CONFIG->{Header}" );
                }

                # Print out the header, including an icon if submitted.
                if( $CONFIG->{'HeaderIcon'} ) {
                        print qq|<h1><img align="top" src="$CONFIG->{'HeaderIcon'}" ALT="" hspace="8">$CONFIG->{'SiteName'} $contents->{'Form'} Results</h1>|;
                }
                else {
                        print "<h1>$CONFIG->{SiteName} $contents->{'Form'} Results</h1>";
                }

                print <<END;
<hr>
<pre>
<strong>From: $contents->{'Name'} &lt;$contents->{'EMail'}&gt;</strong>
<strong>To:     $recipients->{'Recipient'}</strong>
<strong>Cc:     $recipients->{'CarbonCopy'}</strong>
<strong>Subject: $contents->{'Subject'}</strong>

END

                # Loop through the keys
                foreach ( sort keys %{ $contents } ) {
                        #########################################################
                        # Ignore any fields that shouldn't show up in the HTML response.
                        #
                        /^\s*Return\s*$/ && next;
                        /^\s*ReturnIcon\s*$/ && next;
                        /^\s*AnswerPage\s*$/ && next;
                        /^\s*EMailPage\s*$/ && next;
                        /^\s*ReplyPage\s*$/ && next;
                        /^\s*Form\s*$/ && next;
                        /^\s*Recipient\s*$/ && next;
                        /^\s*CarbonCopy\s*$/ && next;
                        /^\s*BlindCopy\s*$/ && next;
                        /^\s*Name\s*$/ && next;
                        /^\s*EMail\s*$/ && next;
                        /^\s*Body\s*$/ && next;
                        /^\s*Subject\s*$/ && next;
                        /^\s*Customer_Receipt\s*$/ && next;
                        /^\s*Customer_Attachment\s*$/ && next;
                        /^\s*Receipt_From\s*$/ && next;

                        # Print out field_name: field_value
                        print "$_: $contents->{$_}\n";
                }

                # Last, print any Body text
                if( $contents->{'Body'} ) {
                        print "\n$contents->{'Body'}\n";
                }

                print qq|</pre><hr><p align="center"><em>Mail sent!</em></p>\n|;

                # There is a return specified in the form input...
                # Verify/reset the default return icon
                if( ! $contents->{'ReturnIcon'} ) {
                        $contents->{'ReturnIcon'} = "/isite-lib/icons/color_back.gif";
                }

                if( $contents->{'Return'} ) {
                        print qq|<a href="$contents->{'Return'}"><img src="$contents->{'ReturnIcon'}" align="bottom" alt="" border="0">Continue Here..</a>|;
                }
                else {
                        print qq|<a href="/"><img src="$contents->{ReturnIcon}" align="bottom" alt="Home" border="0">Home Page</a>|;
                }
                print qq|<br clear="all" />\n|;

                # Check to see if a Standard FOOTER has been defined.
                if( $CONFIG->{'Footer'} ) {
                        &printFile( "$ENV{'DOCUMENT_ROOT'}/$CONFIG->{'Footer'}" );
                }

                print "</body></html>\n";
        }

        return 1;
}

###########################################
# Routines which parse files and lines
###########################################
sub readFile {
        use vars qw( $DEBUG );
        my $filename = shift;
        my $text;

        # Sanity check
        my $fullpath = $ENV{'DOCUMENT_ROOT'} . $filename;
        if( ! -f ${fullpath} ) {
                #&sendError( "Unable to open file '${filename}'" );
                &sendError( "Unable to open file '{$fullpath}'" );
        }

        # Open the file with a relative filehandle
        open( INPUTFILE, "<${fullpath}" )
                || &sendError( "Unable to open file '${filename}'!" );
        while( <INPUTFILE> ) {
                # store each line in a large string
                $text .= $_;
        }
        close( INPUTFILE );

        $DEBUG = " done.\n    Leaving 'Read File' routine.\n";
        return $text;
}

sub parseFile {
        my $filename = shift;

        my $text = &readFile( $filename );

        return &parseText( $text );
}

sub parseText {
        use vars qw( $CONFIG $contents $recipients );
        my $text = shift;

        for( $text ) {
                # If there is any SSI lines, process for SSI stuff.
                s/\<!\-\-\#(include|fsize|flastmod|config|echo)\s+(file|virtual|errmsg|sizefmt|timefmt|var)\s*\=\s*\"(.*?)\" \-\-\>/&replaceSSI();/iegs;

                # Find local variables (+ optional fields)
                s/\<!\-\- WARNINGS \-\-\>/$recipients->{'Warnings'}/egs;
                s/\<!\-\- CONFIG: (\w+?) \-\-\>/$CONFIG->{ $1 }/egs;
                s/\<!\-\- INPUT: (\w+?) \-\-\>/$contents->{ $1 }/egs;
                s/\<!\-\- INPUT: (\w+?) (\w+)\s*\=\s*\"*(.*?)\"* \-\-\>/&replaceField( $1, $2, $3);/iegs;
        }

        # Return the parsed string
        return $text;
}

sub replaceField {
        my $var = shift;
        my $param = shift;
        my $value = shift;
        my $answer;

        # The answer lies in the contents (back up to config)
        $answer = $contents->{ $var };

        # If a width is supplied, fix the field length.
        if( lc $param eq /width/ ) {
                # Subtract the length of the current string from the overall length
                $value -= length( $answer );
                # Add the remaining spaces to the string
                if( $value > 0 ) {
                        $answer .= " " x $value;
                }
        }

        return $answer;
}

# Globals for SSI
my( $TIMEFORMAT, $SIZEFORMAT );
sub replaceSSI {
        use vars qw( %ENV $contents $TIMEFORMAT $SIZEFORMAT );
        my $ssi_command = lc $1;
        my $ssi_param = lc $2;
        my $ssi_arg = $3;

        # Fix path of file arguements. If the file doesn't exist, return now.
        for( ${ssi_param} ) {
                /file/ && do {
                        # Make sure the file exists
                        if( ! -e $ENV{'DOCUMENT_ROOT'} . $ssi_arg) {
                                return "<-- SSI failed: File '$ssi_arg' not found -->";
                        }
                };

                /virtual/ && do {
                        # Make sure the file exists
                        if( ! -e $ENV{'DOCUMENT_ROOT'} . $ssi_arg) {
                                return "<-- SSI failed: File '$ssi_arg' not found -->";
                        }
                };
        }

        # Figure out which command it is.
        for( $ssi_command ) {
                /include/ && do {
                        return &parseFile( $ssi_arg );
                };

                /fsize/ && do {
                        my $size = -s $ssi_arg;
                        if( lc $SIZEFORMAT eq 'abbrev') {
                                return int( ($size / 1024) + 1 ) . ' Kbytes';
                        }
                        else {
                                return "$size bytes";
                        }
                };

                /flastmod/ && do {
                        my $filetime = ( stat( $ssi_arg ) )[9];
                        return &formatTime( $filetime, $TIMEFORMAT, "local" );
                };

                /config/ && do {
                        for ($ssi_param) {
                                /timefmt/ && do {
                                        $TIMEFORMAT = $ssi_arg;
                                        return '';
                                };

                                /sizefmt/ && do {
                                        if ($ssi_arg eq 'bytes' || $ssi_arg eq 'abbrev') {
                                                $SIZEFORMAT = $ssi_arg;
                                                return '';
                                        }
                                        else {
                                                return "<!-- SSI error: size format is not correct -->";
                                        }
                                };

                                /errmsg/ && do {
                                        return "<!-- Isite's SSI error messages are context sensitive, therefore you cannot configure them. -->";
                                };

                                # If it's not one of these, error out.
                                return "<!-- SSI error: config parameter should be timefmt or sizfmt -->";
                        }
                };

                /echo/&& do {
                        for( lc $ssi_arg ) {
                                /document_name/ && do { return $ENV{'REQUEST_URI'}; };
                                /date_uri/      && do { return $ENV{'PATH_INFO'}; };
                                /date_local/    && do { return &formatTime(time(), $TIMEFORMAT, "local"); };
                                /date_gmt/      && do { return &formatTime(time(), $TIMEFORMAT, "gmt"); };

                                /last_modified/ && do {
                                        my $filetime = ( stat( $ENV{'REQUEST_URI'} ) )[9];
                                        return &formatTime( $filetime, $TIMEFORMAT, "local" );
                                };

                                # If it's not one of these, error out.
                                return "<!-- SSI error: echo variable is invalid -->";
                        }
                };

                # If it's not one of these, error out.
                return "<!-- SSI error: command is not one of (config,include,echo,flastmod,fsize) -->";
        }
}

sub formatTime {
        my $nowtime = shift;
        local $_ = shift;
        my $timetype = shift;

        # Parse the timetype
        s/%x/%A, %d-%b-%y/;
        s/%c/%A, %d-%b-%y %H:%M:%S %Z/;
        s/%X/%H:%M:%S %Z/;

        my @sday=('Mon','Tue','Wed','Thu','Fri','Sat','Sun');
        my @lday=('Monday','Tuesday','Wednesday','Thursday','Friday','Saturday','Sunday');
        my @smon=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
        my @lmon=('January','February','March','April','May','June','July','August','September','October','November','December');

        my( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $ampm, $hour12 );
        if ($timetype eq lc "gmt") {
                ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmttime( $nowtime );
        }
        else {
                ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime( $nowtime );
        }

        if( $hour > 11 ) {
                $ampm = 'pm';
                $hour12 = $hour - 12;
        }
        else {
                $ampm = 'am';
                $hour12 = $hour;
        }

        if( $hour == 0 ) {
                $hour12 = 12;
        }
        my $hour12_lead0 = sprintf( '%.2i', $hour12 );

        my $dweek = sprintf( "%u", $yday / 7 );
        my $year_2d = substr( $year, -2 );

        # If the year is two digits, figure out which century..
        my( $year_4d );
        if( $year < 90 ) {
                $year_4d = 2000 + $year;
        }
        elsif( $year < 1900 ) {
                $year_4d = 1900 + $year;
        }

        s/%a/$sday[$wday]/;
        s/%A/$lday[$wday]/;
        s/%b/$smon[$mon]/;
        s/%B/$lmon[$mon]/;
        s/%d/$mday/;
        s/%H/$hour/;
        s/%I/${hour12_lead0}/;
        s/%j/$yday/;
        s/%l/$hour12/;
        s/%m/$mon/;
        s/%M/$min/;
        s/%p/$ampm/;
        s/%S/$sec/;
        s/%w/$wday/;
        s/(%U|%W)/$dweek/;
        s/%y/$year_2d/;
        s/%Y/$year_4d/;

        if( lc $timetype eq 'gmt' ) {
                s/%Z/GMT/;
        }
        else {
                s/%Z/$ENV{'TZ'}/
        };

        return $_;
}

#
# Reading FORM Input
#
# Get query parameters from an HTTP message (GET or Post HTML form)
sub getFormInput {
        my $query;

        # Read in text
        if( $ENV{'REQUEST_METHOD'} =~ /GET/i ) {
                $query = $ENV{'QUERY_STRING'};
        }
        elsif( $ENV{'REQUEST_METHOD'} =~ /POST/i ) {
                read( STDIN, $query, $ENV{'CONTENT_LENGTH'} ) if( $ENV{'CONTENT_LENGTH'} > 0 );
        }

        # Decode the results
        return &decodeForm( $query );
}

# urldecode a single string
sub decodeURL {
        my $string = shift;

        # spaces get converted to plus signs (+) (plus signs were already converted to %2B)
        $string =~ tr/+/ /;

        # decipher ASCII hexadecimal escaped characters
        $string =~ s/%([a-fA-F0-9]{2})/pack("C",hex($1))/eg;

        return $string;
}

# URL decode an HTML Form encoded message
sub decodeForm {
        my( %pairs, $name, $value );
        my $encoded = shift;

        my( @pairs ) = split( /&/, $encoded );
        foreach my $pair (@pairs) {
                # Split into name and value
                ($name,$value) = split(/=/,$pair,2);
                $name = &decodeURL($name);
                $value = &decodeURL($value);

                # If the name has already been seen, just tack the value on the end
                # with a comma delimeter
                if ( defined($pairs{$name}) ) {
                        $pairs{$name} .= ",$value";
                }
                else {
                        $pairs{$name} = $value;
                }
        }
        return \%pairs;
}

#
# Reading Files
#
sub readValues {
        my $filename = shift;
        my( %values );

        # Open the file, and extract a list of parameters and values.
        if( !open( VALUES, $filename ) ) {
                &sendError("Unable to open file ($filename).");
        }

        while (<VALUES>) {
                (/^\s*#/) && next;                                                      # Skip comment lines.
                (/^\s/) && next;                                                        # Skip blank lines
                my( $name, @values ) = split;                           # Split the line into a name and values
                $values{ $name } = join( ' ', @values );        # Assign the combined values to the name
        }

        # Return a reference to the hash
        return \%values;
}

sub readList {
        my $listfile = shift;
        my( @list );

        # Open the file
        if( !open( LIST, ${listfile} ) ) {
                &sendError( "Unable to open file." );
        }

        # and extract a list
        while( <LIST> ) {
                (/^\s*#/) && next;              # Skip comment lines
                s/#.*$//g;                              # Remove comments from the end of lines.
                push( @list, $_ );              # Add to the list
        }

        # Return a reference to the array
        return \@list;
}

sub printFile {
                my $filename = shift;

                # Open the file, and print the contents
                if( open( PRINTFILE, $filename ) ) {
                        while( <PRINTFILE> ) { print; } # Print each line.
                        close(PRINTFILE);
                }
                # .... do nothing (silently) if the file doesn't exist.
}

sub sendError {
        use vars qw( $DEBUG $SENT_HEADERS );
        my $error = shift;
        chomp($error);

        if( ! $SENT_HEADERS ) {
                print "Content-Type: text/html\n\n";
        }

        print <<END;
<html>
<head>
<title>Error Message</title>
</head>
<body>
<script language="Javascript">
<!-- Comment for old browsers
alert( "$error" );
history.back();
// Browsers old for comment -->
</script>
<noscript>
<h1 align="center">Error:</h1>
<p align="center">$error</p>
</noscript>
</body>
</html>
END
        exit 0;
}