#!/usr/bin/perl

### web2mail -- An anonymous CGI mailer.
###             See http://www.halcyon.com/sanford/cgi/web2mail/web2mail.html
###             for usage and description.
###             Copyright 1995-6, Sanford Morton <sanford@halcyon.com>
###
### Modified 8April97 by Alan McLean
###     - Added timestamp when saved to file.
###     - Removed the requirement for .email_target
###       when .writefile specified.  Now, when
###       .email_target is specified with .writefile
###       an email message is sent informing that new
###       data has been saved (or an order has been made).
###
### Configuration Variables
###
$home=$ENV{"DOCUMENT_ROOT"};

### the local mail program -- without sendmail, revise &send_mail
$mail_program = "/usr/lib/sendmail -t"; 
### instructions page -- make sure this is current
$instructions_url = "http://www.halcyon.com/sanford/cgi/web2mail/web2mail.html"; 

###
### Main body of script
###

### parse the form data
&ReadParse;

#### is required email address supplied
#if ( ! $in{'.email_target'} ) {
#    print &instructions_page;
#    exit;
#}

### any required data? if so, has user supplied it?
if ( $in{'.required_data'} && &missing_data  ) {
    print &incomplete_page;
    exit;
} 

### prepare first line of mail message
$message = $in{'.mail_intro'} ? "$in{'.mail_intro'}\n\n"
    : "Form data submitted to $ENV{'HTTP_REFERER'}:\n\n";

### write the form data to the mail message
foreach (sort keys %in) {
    next if /^\./;  # skip hidden form data in mail message

    $item = "$_: $in{$_}";
    $item =~ s/^..// if $in{'.remove_indexing'};
    $item =~ s/: on$//;     # remove checkbox flags
    $message .= "\t$item\n";
}

## do you want the environment variables?
if ( $in{'.environment'} ) { 
    $message .= "\nThe environment variables are:\n\n";
    foreach (keys %ENV) {
        $message .= "\t$_: $ENV{$_}\n";
    }
}

## prepare subject line in mail message 
$subject_line = $in{'.mail_subject'} ? "$in{'.mail_subject'}"
    : "Form data submitted to $ENV{'HTTP_REFERER'}";

## mail it (or web it if in test mode)
&send_mail ($mail_program, $in{'.email_target'}, $subject_line, $message);

## Return an acknowledgement page
&acknowledge_page;

###
### End of main body of script.
### Subroutines below.
###

### 
### Return an acknowledgement page.
### Look first for a matching custom response url, 
### then for a thanks page, or send the default acknowledgement page.
### 
sub acknowledge_page {
    local($i, @triples);

    ## search for a match among custom responses
    if ( $in{'.custom_response_url'} ) {

        ## for each custom response, the triple is:
        ## form tag name :: triggering value :: response url
        @triples = split( /::/, $in{'.custom_response_url'} );

        for ($i=0; $i < $#triples; $i+=3) {

            ## if name matches value
            if ( $in{"$triples[$i]"} eq $triples[$i+1] ) {  

                ## print URL
                if ( $in{'.test'} ) {    # test mode
                    print "The acknowledgement page that would be returned is:
                           <A HREF=\"$triples[$i+2]\">$triples[$i+2]</A>";
                } else { 
                    print "Location:  $triples[$i+2]\n\n"; 
                }
                exit;
            }
        }
    }

    ## if no custom response matches, return the supplied 
    ## base thanks page, if any
    if ( $in{'.thanks_url'} ) {
        if ( $in{'.test'} ) {  # test mode
            print "The acknowledgement page that would be returned is:
                   <A HREF=\"$in{'.thanks_url'}\">$in{'.thanks_url'}</A>";
        } else { 
            print "Location:  $in{'.thanks_url'}\n\n";
        }

    ## or just return the built-in default
    } else {       
        print &thanks_page;
    }
}   

###
### .email_target form data is missing, return an instruction page
###

sub instructions_page {
    local ($page_source) = <<"INSTRUCTIONS_PAGE";
Content-type: text/html\n\n 
<TITLE>Oops, .email_target is missing</TITLE>
<H1>Oops, .email_target is missing</H1>
You must include a hidden form tag called <CODE>.email_target</CODE>
whose value is the email address to which you want to mail the form data.
Something like<PRE>
&lt;INPUT TYPE="hidden" NAME=".email_target" VALUE="user\@site.com"&gt;
</PRE>For your information, the form elements and their values that 
actually were supplied in this page were:<UL>
INSTRUCTIONS_PAGE
    
    foreach (keys %in) {
        $page_source .= "<LI>$_: $in{$_}\n";
    }

    $page_source .= <<"LAST_PART";
</UL>You can return to the 
<A HREF="$instructions_url">instructions page</A>
describing the use of this mailing script, or press your <STRONG>BACK</STRONG>
button to return to the web form.
LAST_PART

    return $page_source;  
}

###
### send mail containing the form data
###
sub send_mail {
    local ($mail_program, $email_address, $subject, $message) = @_;

    if ($in{'.test'}) {         # test mode. Send mail to web page
        print <<"TEST";
Content-type: text/html\n\n
<H1>Here is the letter that would be mailed:</H1><PRE>
To: $email_address
Subject: $subject
\n\n$message\n</PRE>
<H1>The rest of this page is the Thanks page</H1><HR>
TEST

    } else {                # production mode. Send mail to mail.
        if ($in{'.writefile'}) { 
           #
           # Here's where it sets the file name that it's going to write to.
           # Historically, it just used the name in .writefile, however, due
	   # to security concerns, .writefile will now contain the name of
           # the template file to use to get the actual filename.
           #
           $template=$home.$in{'.writefile'};
           if (-f $template) {
              if (open(TEMPLATE,$template)) {
                 $output=$home.<TEMPLATE>;
                 close(TEMPLATE);
                 # Check filename for accuracy
                 if ( open( OUTPUT, ">>$output") ) {
                    # write to target file; we want this
					($min,$hour,$mday,$mon,$year) = (localtime(time))[1,2,3,4,5];
					++$mon;
					if ($min < 10) {
						$min = "0".$min;
					}
					print OUTPUT "<pre>==================================================\n";
					$mytime = "\n\nSubmitted on $mon/$mday/$year $hour:$min PDT\n";
					$message =~ s/(:[^:].*)/$1$mytime/;
					print OUTPUT "\nSubject: ${message}";					
					print OUTPUT "\n\n\.\n</pre>";
					close( OUTPUT);
					
                 } else {
                    #Cannot open output file
		    print &error_page ("cannot open: $output");
		    exit;
                 }
              } else {
		  #Cannot open template
		  print &error_page ("cannot open: $template");
		  exit;
              }
           } else {
		#Template Not Found
		print &error_page ("$template not found.");
		exit;
           }
        } else {
           $output="|$mail_program";
        }
        if ( !open(MAIL, $output) ) { 
            print &error_page ($message);
            exit;
        }

		if ($in{'.email_target'} && !$in{'.writefile'}) {
			print MAIL <<"EOM";
To: $email_address
Subject: $subject
\n\n$message
\n.\n
EOM
		}

		if ($in{'.writefile'}) {
			($min,$hour,$mday,$mon,$year) = 
			    (localtime(time))[1,2,3,4,5];
			++$mon;
			if ($min < 10) {
				$min = "0".$min;
			}
			print MAIL "<pre>==================================================\n";
			print MAIL <<"EOM";
Subject: $subject
\nSubmitted on $mon/$mday/$year $hour:$min PDT 
\n$message
\n.\n
EOM
			print MAIL "<pre>\n";
        }

		close (MAIL);

        if ($in{'.writefile'} && $in{'.email_target'}) {
        	open(MAIL,"|$mail_program");
        	print MAIL <<"EOM";
To: $email_address
Subject: $subject
\nNew data submitted to $ENV{'HTTP_REFERER'} 
on $mon/$mday/$year $hour:$min PDT
\n
EOM
			close(MAIL);
		}
    } 
}

###
### Return the html source for an incomplete submission page
###
sub incomplete_page {
    local ($page_source) = <<"FIRST_HALF";
Content-type: text/html\n\n
<TITLE>Thanks, but oops ...</TITLE>
<H2>Thanks, but oops ...</H2>
Your information is important to us, and the following items
on the form were not filled in:
<UL>
FIRST_HALF

    foreach ( @missing_fields ) {
        $page_source .= "<LI>$_\n";
    }

    $page_source .= <<"SECOND_HALF";
</UL>
Please click your <STRONG>BACK</STRONG> button to return to the form
and add that information. Your other answers should still be there.
SECOND_HALF

    return $page_source;
}

###
### Return an array of missing fields among the Company data, or undef
### Need to name the fields descriptively so users will know what 
### form data they are missing.
###
sub missing_data {
    local ($result) = 0;
    foreach ( split (/::/, $in{'.required_data'} ) ) {
        unless ($in{$_}) {
            s/^..// if $in{'.remove_indexing'};
            push (@missing_fields, $_);
            $result = 1;
        }
    }
    return $result;
}

###
### Return the html source for an error page following a
### mail error. Includes the text of the mail.
###
sub error_page {
    local ($message) = @_;
    local ($page_source) = <<"ERROR_PAGE"; 
Content-type: text/html\n\n
<TITLE>System Form Error</TITLE>
<H2>Thanks, but oops ...</H2>
The system seems a bit confused right now, so your form
was not processed. You can try again a little later, or you can
mail us directly at 
    <A HREF="mailto:$in{'.email_target'}">$in{'.email_target'}</A>.
You can simply quote this page, since the following is the message
that would have been sent: <P><PRE>$message</PRE>
ERROR_PAGE

    return $page_source;
}

###
### Return the html source for the acknowledgement page.
### 
sub thanks_page {
    local ($page_source) = <<"THANKS_PAGE"; 
Content-type: text/html\n\n
<TITLE>Form Acknowledgement</TITLE>
<H2>Thank You</H2>
Your form data have been submitted .
Thank you for taking the time to fill out the form.
THANKS_PAGE
    
    if ( $in{'.back_to_url'} ) { 
        $page_source .= 
            "<P>Return to <A HREF=\"$in{'.back_to_url'}\">$in{'.back_to_url'}</A>";
    }
    return $page_source;
}


###
### Parse the cgi form data.
### Adapted from cgi-lib.pl by S.E.Brenner@bioc.cam.ac.uk 
### Copyright 1994 Steven E. Brenner 
###
sub ReadParse {
    local (*in) = @_ if @_;
    local ($i, $key, $val);

    if ( $ENV{'REQUEST_METHOD'} eq "GET" ) { # replaced his MethGet function
        $in = $ENV{'QUERY_STRING'};
    } elsif ($ENV{'REQUEST_METHOD'} eq "POST") {
        read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
    } else {
        # Added for command line debugging
        # Supply name/value form data as a command line argument
        # Format: name1=value1\&name2=value2\&... (need to escape & for shell)
        # Find the first argument that's not a switch (-)
        $in = ( grep( !/^-/, @ARGV )) [0];
        $in =~ s/\\&/&/g;        
    }
    @in = split(/&/,$in);

    foreach $i (0 .. $#in) {
        # Convert plus's to spaces
        $in[$i] =~ s/\+/ /g;

        # Split into key and value.
        ($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

        # Convert %XX from hex numbers to alphanumeric
        $key =~ s/%(..)/pack("c",hex($1))/ge;       
        $val =~ s/%(..)/pack("c",hex($1))/ge;

        # Associate key and value
        # \0 is the multiple separator
        $in{$key} .= "\0" if (defined($in{$key})); 
        $in{$key} .= $val;
  }
  return length($in);
}