#!/usr/local/bin/perl
##############################################################################
#                                                                            #
#               *** NOTICE - THIS IS A SAMPLE SCRIPT ***                     #
#                 This script will require modification                      #
#                  to work correctly with your system.                       #
#                                                                            #
# COPYRIGHT NOTICE                                                           #
# Form Mailer Version 1.1                                                    #
# Copyright 1996-2000 Cardiff Software, Inc.   All Rights Reserved.          #
# Created 10/22/96                     Last Modified 1/31/00                 #
# mailto:webmaster@cardiff.com         http://www.cardiff.com                #
##############################################################################
# Special thanks to Matt Wright for creating FormMail Version 1.5            #
# FormMail Copyright 1996 Matt Wright  mattw@worldwidemart.com               #
# Created 6/9/95                       Last Modified 2/5/96                  #
# Scripts Archive at:                  http://www.worldwidemart.com/scripts/ #
##############################################################################
# Define Variables 

# $mailprog defines the location of your mailing program:
# 'sendmail' on UNIX or 'blat.exe' on Windows NT.
# If it is in the path, then the full path is not needed here.

$os = 'UNIX';
#  $os = 'NT';
$useDir;
$allow_email  = 'YES';
$allow_dirsav = 'NO';

$sender    = 'webmaster\@www.cs.niu.edu';
$errors_to = 'berezin@cs.niu.edu';

# configure for NT or Unix server
if ($os eq 'NT') 
{                             # Windows NT or 95
  $mailprog     = 'blat.exe';
  $logfile      = 'C:/WWWROOT/temp/form.log';
  $maildir      = 'C:/WWWROOT/temp/';
}

else 
{                             # UNIX
  #cthomsen@oldmp.cs.niu.edu';
  $mailprog = '/usr/lib/sendmail berezin@cs.niu.edu';
  $logfile  = '/home/www/berezin/survey.log';
  $maildir  = '/home/www/berezin/';
}

# If referer checking is desired (see below to enable): 
# @referers allows forms to be located only on servers which are defined 
# in this field.

@referers = ('oldmp.cs.niu.edu','www.cs.niu.edu');

# Done
#############################################################################

# To enable referrer checking, uncomment the following line.
# &check_url;

# Retrieve Date
&get_date;

# Parse Form Contents
&parse_form;

# Check Required Fields
&check_required;

if (uc($useDir) eq 'NO' && uc($allow_email) eq 'YES') 
  { $send_email = 'YES'; }

elsif ( uc($useDir) eq 'YES' && uc($allow_dirsav) eq 'YES') 
  { $send_email = 'NO'; }

elsif ( uc($allow_email) eq 'YES') 
  { $send_email = 'YES'; }

elsif ( uc($allow_dirsav) eq 'YES') 
  { $send_email = 'NO'; }

else 
  { $send_email = 'YES'; }

# Send E-Mail
&send_mail;

# Return HTML Page or Redirect User
&return_html;


sub check_url 
{
  if ($ENV{'HTTP_REFERER'}) 
  {
    foreach $referer (@referers) 
    {
      if ($ENV{'HTTP_REFERER'} =~ /$referer/i) 
      {
        $check_referer = '1';
	last;
      }
    }
  }

  else 
    { $check_referer = '1'; }

  if ($check_referer != 1) 
    { &error('bad_referer'); }
}

sub get_date 
{
  @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday',
           'Saturday');
  @months = ('January','February','March','April','May','June','July',
	     'August','September','October','November','December');

  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);

  if ($hour < 10) 
    { $hour = "0$hour"; }

  if ($min  < 10) 
    { $min  = "0$min";  }

  if ($sec  < 10) 
    { $sec  = "0$sec";  }

  if ($year > 99) 
    { $year = $year - 100; }

  if ($year < 10) 
    { $year = "0$year"; }

  $date = "$days[$wday], $months[$mon] $mday, 20$year at $hour\:$min\:$sec";

  $mon = $mon + 1;

  if ($mon  < 10) 
    { $mon  = "0$mon";  }

  if ($mday < 10) 
    { $mday = "0$mday"; }

  $logdate = "$year-$mon-$mday $hour\:$min\:$sec";
}

#############################################################################
# RandFileName() : Creats a 0-byte unique file name and tests for existence #
#############################################################################
sub RandFileName 
{
  $maxattemps = 400;
  $i = 0;
  $t = 0;
  $testfile;

  for ($i = 0; $i lt $maxattemps; $i++)
  {
    $userIP = $ENV{'REMOTE_ADDR'};       # Get the user's IP address and 
    $_ = $userIP;                        # Set the default variable
    s/\.//g;                             # Globally remove all periods from
    $userIP = $_;                        # 
    $IPseed = int($userIP);              # convert string to int

    #  srand($$ ^ time);                 # use process_id and time as seed

    # use user's IP address and time as seed
    srand(time ^ (IPseed + time + $$));  
    $t = int(rand(99999999));

    $testfile = $maildir . $t . ".tfm";
    if ( open(TEST, $testfile) )
    {
      close(TEST);                          # close this file
      next;                                 # and try again
    } 

    else 
    {
      open(TEST,">$testfile");              # Create a new file
      close(TEST);                          # and then close it.
      last;
    }
  }

  if ( uc($i) eq uc($maxattempts) ) 
    { return ""; } 

  else 
    { return $testfile; }
}

##############################################################################
# Parse the form                                                             #
##############################################################################
sub parse_form 
{
  # Isolate each name-value pair based on request method
  if ($ENV{'REQUEST_METHOD'} eq 'GET') 
    { @pairs = split(/&/, $ENV{'QUERY_STRING'}); }

  elsif ($ENV{'REQUEST_METHOD'} eq 'POST') 
  {
    read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
    @pairs = split(/&/, $buffer);
  }

  else 
    { &error('request_method'); }

  #Split each name-value pair and process futher.
  foreach $pair (@pairs) 
  {
    ($name, $value) = split(/=/, $pair);
 
    $name =~ tr/+/ /;         # replace space symbol with space
    $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    $value =~ tr/+/ /;
    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    # If they try to include server side includes, erase them, so they
    # arent a security risk if the html gets returned.  Another 
    # security hole plugged up.

    $value =~ s/<!--(.|\n)*-->//g;

    # Create two associative arrays here.  One is a configuration array
    # which includes all fields that this form recognizes.  The other
    # is for fields which the form does not recognize and will report 
    # back to the user in the html return page and the e-mail message.
    # Also determine required fields.

    if 
    (
      $name eq 'recipient' || $name eq 'subject' || $name eq 'email' ||
      $name eq 'realname' || $name eq 'redirect' || $name eq 'title' ||
      $name eq 'sort' || $name eq 'return_link_title' || 
      $name eq 'return_link_url' && ($value)
    ) 
      { $CONFIG{$name} = $value; }

    elsif ($name eq 'required') 
      { @required = split(/,/,$value); }

    elsif ($name eq 'env_report') 
      { @env_report = split(/,/,$value); }

    else 
    { 
      if ($FORM{$name} && ($value)) 
        { $FORM{$name} = "$FORM{$name}, $value"; }

      elsif ($value || $value eq "0") 
        { $FORM{$name} = $value; }
    }

    if ( lc($name) eq 'usedirectory' ) 
    {
      if ( uc($value) eq 'YES' )
        { $useDir = 'YES'; }

      elsif ( uc($value) eq 'NO' )
        { $useDir = 'NO'; }

      else 
        { $useDir = 'xx'; }
    }
  } # end for-loop
}

##############################################################################
# check_required - 
##############################################################################
sub check_required 
{
   foreach $require (@required) 
   {
      if 
      (
        $require eq 'recipient' || $require eq 'subject' || 
        $require eq 'email' || $require eq 'realname' ||
        $require eq 'redirect' || $require eq 'sort' ||
        $require eq 'title' || $require eq 'return_link_title' ||
        $require eq 'return_link_url'
      ) 
      {
        if (!($CONFIG{$require}) || $CONFIG{$require} eq ' ') 
          { push(@ERROR,$require); }
      }

      else 
      {
        $found = 0;
        if ( $FORM{"b12c96nf$require"} || ( $FORM{"b12c96nf$require"} eq "0") )
        { 
          #push(@ERROR,$require); 
          $found = 1; 
        }

        if ( $FORM{"b12c96nz$require"} || ( $FORM{"b12c96nz$require"} eq "0") )
        { 
          #push(@ERROR,$require); 
          $found = 1;
        }

        if ( $FORM{"b12c96nm$require"} || ( $FORM{"b12c96nm$require"} eq "0") )
        {
          #push(@ERROR,$require);
          $found = 1;
        }

        if ( $FORM{"b12c96ne$require"} || ( $FORM{"b12c96ne$require"} eq "0") )
        {
          #push(@ERROR,$require);
          $found = 1;
        }

        if ( $FORM{"b12c96nc$require"} || ( $FORM{"b12c96nc$require"} eq "0") )
        {
          #push(@ERROR,$require);
          $found = 1;
        }

        if ( $found == 0 ) 
          { push(@ERROR,$require); }
      }
   }

   if (@ERROR)
     { &error('missing_fields', @ERROR); }

   else 
   {
      if (!$CONFIG{'recipient'}) 
        { &error('missing_fields', "recipient"); }
   }
}

##############################################################################
# Return HTML as follow-on to 'Submit'                                       #
##############################################################################
sub return_html 
{
  if ($CONFIG{'redirect'} =~ /http\:\/\/.*\..*/) 
  {
    #If the redirect option of the form contains a valid url,
    #print the redirectional location header.

    print "Content-type: text/html\n\n";
    print "<html>\n <head>\n";
 
    $theRedirect = $CONFIG{'redirect'};

    print "  <META HTTP-EQUIV='Refresh' CONTENT='0;URL=$theRedirect'>"; 
    print "  <meta http-equiv='PRAGMA' content='NO-CACHE'>\n";
    print "  <meta http-equiv='Expires' content='-1'>";
    print " </head>\n";
    print " <body></body>\n";
    print "</html>";
  }

  else 
  {
    # print "HTTP/1.0 200 OK\n";
    print "Content-type: text/html\n\n";
    print "<html>\n <head>\n";
    print " <title>Congratulations!</title>\n";
    print " </head>\n";
    
    print " <center><h1>Congratulations!</h1></center>\n\n";
    print " <CENTER><P><FONT SIZE=+2>Your form has been submitted to";
    print " Teleform Internet Server on $date via ";

    if ($send_email eq 'YES') 
      { print "$CONFIG{'recipient'}"; } 

    else 
      { print "directory"; }

    print ".</FONT></P></CENTER>\n\n";
    print " <CENTER><P><FONT SIZE=+2>Visit ";
    print "<A HREF=\"http://www.cardiff.com/\" target=\"_top\">";
    print "Cardiff Software </A> on the World Wide Web.";
    print "</FONT></P></CENTER>\n\n";
    print " <P>\n<HR size=7 width=75%></P>\n\n";
    
    print "</body>\n</html>";
  }
}

##############################################################################
# Send the mail in response to 'Submit'                                      #
##############################################################################
sub send_mail 
{
  # Write a log record of this mail
  if ("$logfile") 
  {
    open(LOG,">>$logfile");
    print LOG "$logdate\t";
    print LOG "$CONFIG{'recipient'}\t";
    print LOG "$ENV{'HTTP_REFERER'}\t";
    print LOG "$ENV{'SERVER_NAME'}\t";
    print LOG "$ENV{'REMOTE_HOST'}\t";
    print LOG "$ENV{'REMOTE_IDENT'}\n";
    close(LOG);
  }

  # Open The Mail Program

  if ($os eq 'NT' || $send_email ne 'YES') 
  {
     $tempmailfile = RandFileName();
     open(MAIL,">$tempmailfile");
  }

  else 
    { open(MAIL,"|$mailprog"); }

  print MAIL "To: $CONFIG{'recipient'}\n";
  print MAIL "From: $CONFIG{'email'} (Cardiff Test Script)\n";

  # Check for Message Subject
  if ($CONFIG{'subject'}) 
    { print MAIL "Subject: $CONFIG{'subject'}\n\n"; }

  else 
    { print MAIL "Subject: WWW Form\n\n"; }

  print MAIL "The following form data was ";
  print MAIL "submitted by $CONFIG{'realname'} ($CONFIG{'email'}) on ";
  print MAIL "$date\n";
  print MAIL "---------------------------------------";
  print MAIL "------------------------------------\n\n";

  if ($CONFIG{'sort'} eq 'alphabetic') 
  {
    # Print the name and value pairs in FORM array to mail.
    foreach $key (sort keys %FORM) 
      { print MAIL "$key: $FORM{$key}\n"; }
  }

  elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) 
  {
    $CONFIG{'sort'} =~ s/order://;
    @sorted_fields = split(/,/, $CONFIG{'sort'});

    foreach $sorted_field (@sorted_fields) 
    {
      # Print the name and value pairs in FORM array to mail.
      if ($FORM{$sorted_field}) 
        { print MAIL "$sorted_field: $FORM{$sorted_field}\n"; }
    }
  }

  else 
  {
    # Print the name and value pairs in FORM array to html.
    foreach $key (keys %FORM) 
      { print MAIL "$key: $FORM{$key}\n"; }
  }

  print MAIL "---------------------------------------------";
  print MAIL "------------------------------\n";

  # Send Any Environment Variables To Recipient.
  foreach $env_report (@env_report) 
    { print MAIL "$env_report: $ENV{$env_report}\n"; }

  close (MAIL);

  #
  # if writing to a file, we are done
  # if sending mail we might have more to do
  #
  if ($os eq 'NT' && $send_email eq 'YES') 
  { # Send NT mail?
    # For UNIX we are done (we used a pipe)
    # For NT, we still have to send the message
    #
    local(@mailcommand,$commandline,$resultstring,@resultarray);
    local(@lines);

    # -- create commandline for mail program --
    @mailcommand = ();
    push (@mailcommand,"$mailprog");
    push (@mailcommand,"$tempmailfile");
    push (@mailcommand,"-s \"WWW Form\"");            # -s subject
    push (@mailcommand,"-t $CONFIG{'recipient'}");    # -t to recipient
    push (@mailcommand,"-f $sender");                 # -f sender
    # push (@mailcommand,"-c $cc") if $cc;            # -c copy to recipient
    # push (@mailcommand,"-i \"$name <$from>\"");     # -i specif. from address
    $commandline = join(' ',@mailcommand); 
    undef @mailcommand;

    # -- execute mail program and delete temp mail file --
    $resultstring = `$commandline`;
    unlink($tempmailfile);

    # -- check if mail was successfully sent
    #    in the case of Blat a successful mailing will return 2 lines
    #    (if not using -f parameter - 3 with -f parameter)
    #    and any unsuccessful mailing will have additional lines

    # $resultstring contains more than one line
    $* = 1;
    @lines = split(/^/, $resultstring);
    # strings contain just one line (back to default value)
    $* = 0;
    if (@lines > 3) 
    {
      @resultarray = split(/\n/,$resultstring);
      &error('send_failed', @resultarray);
    }
  }   # end if $os == NT && $send_email == YES
}

##############################################################################
# Handle errors                                                              #
##############################################################################
sub error 
{
  ($error,@error_fields) = @_;

  #print "HTTP/1.0 200 OK\n";
  print "Content-type: text/html\n\n";

  if ( lc($error) eq 'bad_referer') 
  {
    print "<html>\n <head>\n ";
    print "<title>Bad Referrer - Access Denied</title>\n "</head>\n";
    print "<body>\n  <center>\n ";
    print "<h1>Bad Referrer - Access Denied</h1>\n  </center>\n";
    print "The form you are using resides at: $ENV{'HTTP_REFERER'}, "
    print "which is not allowed to access this Form program.<p>\n";
    print "</body></html>\n";
  }

  elsif ( lc($error) eq 'request_method') 
  {
    print "<html>\n <head>\n  <title>Error: Request Method</title>\n </head>\n";
    print "</head>\n <body";

    # Close Body Tag
    print ">\n <center>\n\n";

    print "   <h1>Error: Request Method</h1>\n  </center>\n\n";
    print "The Request Method of the Form you submitted did not match\n";
    print "either GET or POST.  Please check the form, and make sure the\n";
    print "method= statement is in upper case and matches GET or POST.\n";
    print "<p><hr size=7 width=75%><p>\n";
    print "<ul>\n";
    print "<li><a href=\"$ENV{'HTTP_REFERER'}\">";
    print "Back to the Submission Form</a>\n";
    print "</ul>\n";
    print "</body></html>\n";
  }

  elsif ( lc($error) eq 'missing_fields') 
  {
    print "<html>\n <head>\n  <title>Error: Blank Fields</title>\n </head>\n";
    print " </head>\n <body";
      
    # Close Body Tag
    print ">\n  <center>\n";
    print "   <h1>Error: Blank Fields</h1>\n\n";
    print "The following fields were left blank in your submission form:<p>\n";

    # Print Out Missing Fields in a List.
    print "<ul>\n";
    foreach $missing_field (@error_fields) 
      { print "<li>$missing_field\n"; }

    print "</ul>\n";

    # Provide Explanation for Error and Offer Link Back to Form.
    print "<p><hr size=7 width=75\%><p>\n";
    print "These fields must be filled out before you can successfully "; 
    print "submit\n";
    print "the form.  Please return to the <a href=\"$ENV{'HTTP_REFERER'}\"> ";
    print "Fill Out Form</a> and try again.\n";
    print "</body></html>\n";
   }

   elsif ( lc($error) eq 'send_failed') 
   {
     print "<html>\n <head>\n";
     print " <title>Internal Error: Failed to Send Mail</title>\n </head>\n";
     print " </head>\n <body";
      
     # Close Body Tag
     print ">\n  <center>\n";

     print "   <h1>Error: Failed to Send Mail</h1>\n\n";
     print "The following errors were received while attempting to send "
     print "your form as a mail message on $date:<p>\n";

     # Print Out list of errors received.
     print "<ul>\n";

     foreach $err_msg (@error_fields) 
       { print "<li>$err_msg\n"; }

     print "</ul>\n";

     # Give the user some recourse
     print "<p><hr size=7 width=75\%><p>\n";
     print "Please send a copy of this notice to $errors_to.\n";
     print "Please send a copy of this notice to ";
     print "<a href=\"mailto:$errors_to\">$errors_to</a>.\n";

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

  exit;
}