#!/local/bin/perl
# mailto.cgi - v2.0
# 1998 04 18
# Scott Wimer <scottw@cgibuilder.net>
#
#######################################################################
# COPYRIGHT
# Copyright 1997 by Scott Wimer.  All rights reserved.
#######################################################################
# DISCLAIMER
# In no event shall CGI Builder, Scott Wimer, or anybody other than YOU be 
# responsible for the effects of running this or any other script from the CGI 
# Builder Script Archive.  If this script blows up your computer causing your 
# house to burn down and scorching your cat, it?s your problem.  I extend my 
# condolences, but it?s your problem all the same.
#######################################################################
# SUPPORT
# Support for this and all other scripts available at CGI Builder Script 
# Archive is provided via the CGI Builder Script Archive FAQ and, when 
# necessary via email to scottw@cgibuilder.com (Scott Wimer). 
#######################################################################
# ARCHIVE AND DISTRIBUTION
# This script is archived at:  http://www.cgibuilder.com/  - CGI Builder Script 
# Archive.
# Please direct those who want a copy of it to that site.
# This header and copyright information must remain intact in any distribution 
# of this script.
#######################################################################
#
#######################
# This is a script that allows implementation of error checking forms
# without the end user of this script needing to be fluent in perl or
# anything but english - until someone translates this.
# This error checks the following input data types and form elements:
# types=(EMAIL,PHONE,ZIP,SELECT,NONUM,NOLETTER,NUMONLY,LETTERONLY,NOTBLANK)
# others will be added as people request them.
#######################
#
# NOTE: use strict will not work (since I'm using symbolic references in the
# fetch_data routine.
#
#######################################################################


require "checks.pl"; # brin in the data validation routines
use Var_Sub;         # bring in the Var_Sub routine


### we check for sendmail in 3 places, it makes us more portable
my $mailer_1 = '/usr/lib/sendmail';
my $mailer_2 = '/usr/bin/sendmail';
my $mailer_3 = '/usr/sbin/sendmail';
my $mailer_flags=' -t';
my $sendmail;
if ( -x $mailer_1)
{
  $sendmail=$mailer_1;
}
elsif ( -x $mailer_2)
{
  $sendmail=$mailer_2;
}
elsif ( -x $mailer_3)
{
  $sendmail=$mailer_3;
}
else
{
  print "Content-type: text/html\n\n";
  print "I can't find sendmail, shutting down...<br>";
  print "Whoever set this machine up put it someplace weird.";
  exit(1);
}
###

### declare Global variables
use vars qw($Form_Data $Defaults $Env $Misc @fields $Check $Select_Check);
use vars qw(@errorlog $body $MAX_RECIPIENTS $OUTPUT_STARTED);
###

### declare top level lexical variables
my ($recipient, $fromaddress, $subject);
###


### initialize 3 Symbol Tables, and preload the Defaults ST
$Form_Data={};    # data from the Web Form
$Defaults={};     # default values
$Env={};          # the requested environment variables

$Defaults->{"\$FROMADDRESS"}      = 'mailto_cgi@cgibuilder.com';
$Defaults->{"\$SUBJECT"}          = 'MAILTO.CGI FORM DATA';
$Defaults->{"\$SEPARATOR"}        = ' = ';
$Defaults->{"\$BROWSER_INFO_HEADING"} =  
                      "\n---------Visitor Browser Information----------\n<br>";
###


### set default variables we'll need, or unset, as the case may be
undef $Misc->{ALPHA_SORT};
undef $Misc->{SUPRESS_EMPTY};
undef $Misc->{BROWSER_INFO};
undef $Misc->{THANKURL};
undef $Misc->{ERRORURL};
$Misc->{LIST_JOIN} = ' and';
my $HTML_header="Content-type: text/html\n\n";
$MAX_RECIPIENTS=10;
###



### okay, all setup stuff is done.  now fetch the Form data
fetch_data();
###


### Expand BROWSER_INFO request to include all requested environment
##- variables.  If the BROWSER_INFO directive is given without a list of
##- env vars to show, all env vars are pushed into the $Env Symbol Table
if ( exists($Misc->{BROWSER_INFO}) )
{
  if ( $Misc->{BROWSER_INFO} !~ /^\s*$/ )
  {
    my (@env_list)=split (/[ ,\t]+/, $Misc->{BROWSER_INFO});
    my $env_name;
    foreach $env_name (@env_list)
    {
      $Env->{"\$$env_name"}=$ENV{$env_name}; # stick value into $Env ST
    }
  }
  else
  {
    # otherwise, they want the whole thing
    my $env_name;
    foreach $env_name ( keys(%ENV) )
    {
      $Env->{"\$$env_name"} = $ENV{$env_name};
    }
  }
}
###
 

### Input checking.
##- Currently a variety of checks are supported.
my (@keys, $key);
@keys=keys(%{ $Check });
foreach $key (@keys)
{
  if ($key eq "EMAIL"){
                                check_email(@{$key});
  }elsif ($key eq "PHONE"){
                                check_phone(@{$key});
  }elsif ($key eq "ZIP"){
                                check_zip(@{$key});
  }elsif ($key eq "NONUM"){
                                check_nonum(@{$key});
  }elsif ($key eq "NOLETTER"){
                                check_noletter(@{$key});
  }elsif ($key eq "NUMONLY"){
                                check_numonly(@{$key});
  }elsif ($key eq "LETTERONLY"){
                                check_letteronly(@{$key});
  }elsif ($key eq "NOTBLANK"){
                                check_notblank(@{$key});
  }
}

# check the select boxes
my ($listname,$element);
while ( ($listname, $element)=each(%{ $Select_Check }) )
{
  check_selectlist($listname, $element);
} 
###



### Verify that we've got the bare minimum of mailer directives.
##- We'll grab all the others later, this is just so we can get the 
##- error checking report sent back to the user as quick as possible.
unless ( defined($Form_Data->{"\$RECIPIENT"}) ||
         defined($Form_Data->{"\$recipient"}) )
{
  if ($OUTPUT_STARTED == 0)
  {
    print $HTML_header;
    $OUTPUT_STARTED =1;
  }
  print "You Must define a recipient for the message.<br>\n";
  print "As in: \"\&lt; input type=hidden name=RECIPIENT value=me\@xyz.org\&gt;\" <br>\n";
  exit;
}
###


### print out any errors in the input data
##- but only do this if there are actually errors
##- or redirect the browser to the $error_url page
my $error_url;
if ( defined($Defaults->{'$errorURL'}) )
{
  $error_url=$Defaults->{'$errorURL'};
}
elsif ( defined($Defaults->{'$ERRORURL'}))
{
  $error_url=$Defaults->{'$ERRORURL'};
}
if (@errorlog && !$error_url)
{
  if ($OUTPUT_STARTED ==0)
  {
    print $HTML_header;
    $OUTPUT_STARTED=1;
  }
  print<<"ERRORHEAD";
<html><head><title>Errors!</title></head>
<body bgcolor=#FFFFFF>
<center><font size=+2>
There were errors
</font></center>
<br>
The form you submitted had errors (see below).  Please use your browser's back
button return to the form and correct your submission.<br>
<i>Thank you</i>
<p>
ERRORHEAD

  while (@errorlog)
  {
    my ($error_value, $error_routine, $error_desc);
    $error_value=shift(@errorlog);
    $error_routine=shift(@errorlog);
    $error_desc=shift(@errorlog);
    print "<b>error:</b> with -- $error_value -- in $error_routine - - $error_desc<br>\n";
  }
  print "<hr><br>\n";
  exit;
}
elsif (@errorlog && $error_url)
{
  print "Location: $error_url\n\n";
  exit;
}
###



### format the data.
##- This will be done either using a user defined Format: $Misc->{FORMAT},
##- or, a simple name value pair mapping done internally, the formatted
##- text is stored in the variable $body.
if ( defined($Misc->{FORMAT}) )
{
  $body=Var_Sub ($Misc->{FORMAT}, $Form_Data, $Env, $Defaults);

  ### now strip the mailer information from the Symbol Tables.
  if ($Form_Data->{"\$RECIPIENT"})
  {
    $recipient=delete($Form_Data->{"\$RECIPIENT"});
  }
  else
  {
    $recipient=delete($Form_Data->{"\$recipient"});
  }

  
  ### sanity check the number of recipients <= $MAX_RECIPIENTS
  ##- i've put this in a seperate block for namespace reasons.
  {
    my(@recipients)=split(/,/, $recipient);
    if (@recipients > $MAX_RECIPIENTS)
    {
      errors('FATAL', "Too many recipeints specified.");
    }
  }
  ###

  if ($Form_Data->{"\$SUBJECT"})
  {
    $subject=delete($Form_Data->{"\$SUBJECT"});
  }
  elsif ($Form_Data->{"\$subject"})
  {
    $subject=delete($Form_Data->{"\$subject"});
  }
  else
  {
    $subject=$Defaults->{"\$SUBJECT"};
  }

  if ($Form_Data->{"\$FROMADDRESS"})
  {
    $fromaddress=delete($Form_Data->{"\$FROMADDRESS"});
  }
  else
  {
   $fromaddress=$Defaults->{"\$FROMADDRESS"};
  }
  ###

}
else
{
  ### generate the "old-style" email body.

  ### first, strip all mailer information out of the Form_Data hash, so that
  ##- it does not get placed in the outgoing email
  if ($Form_Data->{"\$RECIPIENT"})
  {
    $recipient=delete($Form_Data->{"\$RECIPIENT"});
  }
  else
  {
    $recipient=delete($Form_Data->{"\$recipient"});
  }

  ### sanity check the number of recipients <= $MAX_RECIPIENTS
  ##- i've put this in a seperate block for namespace reasons.
  {
    my(@recipients)=split(/,/, $recipient);
    if ( scalar(@recipients) > $MAX_RECIPIENTS)
    {
      errors('FATAL', "Too many recipeints specified.");
    }
  }
  ###

  if ($Form_Data->{"\$SUBJECT"})
  {
    $subject=delete($Form_Data->{"\$SUBJECT"});
  }
  elsif ($Form_Data->{"\$subject"})
  {
    $subject=delete($Form_Data->{"\$subject"});
  }
  else
  {
    $subject=$Defaults->{"\$SUBJECT"};
  }

  if ($Form_Data->{"\$FROMADDRESS"})
  {
    $fromaddress=delete($Form_Data->{"\$FROMADDRESS"});
  }
  else
  {
   $fromaddress=$Defaults->{"\$FROMADDRESS"};
  }
  ###


  my ($env_name, $env_value, $key, $last_key);
  my $separator;

  ### set $separator
  if ($Form_Data->{"\$SEPARATOR"})
  {
    $separator = delete($Form_Data->{"\$SEPARATOR"});
  }
  else
  {
    $separator = $Defaults->{"\$SEPARATOR"};
  }
  ###

  (@fields)=sort( keys(%{ $Form_Data }) ) if ($Misc->{ALPHA_SORT});
  foreach $key (@fields)
  {
    next if ($key eq $last_key); # avoid displaying things twice
    $last_key=$key;
    if ($Misc->{SUPPRESS_EMPTY})
    {
      if ($Form_Data->{"\$$key"})
      {
        $body .= $key.$separator.$Form_Data->{"\$$key"}."\n";
      }
      else
      {
        next;
      }
    }
    else
    {
      $body .= $key.$separator.$Form_Data->{"\$$key"}."\n";
#      $body .= $key.$separator.$Form_Data->{"\$$key"}."<br>\n";
    }
  }

  if ( exists($Misc->{BROWSER_INFO}) )
  {
    if ($Form_Data->{"\$BROWSER_INFO_HEADING"})
    {
      $body .= $Form_Data->{"\$BROWSER_INFO_HEADING"};
    }
    else
    {
     $body .= $Defaults->{"\$BROWSER_INFO_HEADING"};
    }
    while (($env_name,$env_value)=each(%{ $Env }))
    {
      substr($env_name, 0,1) = undef;
#      $body .= $env_name.$separator.$env_value."<br>\n";
      $body .= $env_name.$separator.$env_value."\n";
    }
  }
  ###
} # --- end of else .. old-style block --- #
 
###



### do any necessary Var_Sub substitution on the FROMADDRESS
##- otherwise, don't call Var_Sub, this saves us the overhead of loading Var_Sub
##- if it's not needed
if ($fromaddress=~/\$/)
{
  $fromaddress=Var_Sub($fromaddress, $Form_Data);
}
###


### mail off the $body to the $Default->{RECIPIENT} address
#errors('WARN', "opening pipe to sendmial");
open (MAIL, "|$sendmail $mailer_flags") || 
           errors ('FATAL', "pipe to '$sendmail $mailer_flags' failed: $!");
print MAIL "From: $fromaddress\n";
print MAIL "To: $recipient\n";
print MAIL "Subject: $subject\n\n";
print MAIL $body;
close (MAIL);
###

### write the $body text to the $Misc->{APPENDFILE}, if one was given
if ( $Misc->{APPENDFILE} )
{
  open (LOG, ">>$Misc->{APPENDFILE}") || 
                  errors('FATAL', "write failed:$Misc->{APPENDFILE}: $!");
  print LOG $body, "\n";
  close(LOG);
}
###


### send any confirmation message.
if ( defined($Misc->{CONFIRM_MESSAGE}) )
{
  $Misc->{CONFIRM_MESSAGE}=
          Var_Sub($Misc->{CONFIRM_MESSAGE}, $Form_Data, $Env, $Defaults);
  $Misc->{CONFIRM_RECIPIENT}=
          Var_Sub($Misc->{CONFIRM_RECIPIENT}, $Form_Data, $Env, $Defaults);
  $Misc->{CONFIRM_FROMADDRESS}=
          Var_Sub($Misc->{CONFIRM_FROMADDRESS}, $Form_Data, $Env, $Defaults);
  $Misc->{CONFIRM_SUBJECT}=
          Var_Sub($Misc->{CONFIRM_SUBJECT}, $Form_Data, $Env, $Defaults);

  ### make sure that we're only going to send this to a safe number of people
  my @recipients=split /,/, $Misc->{CONFIRM_RECIPIENT};
  if ( scalar(@recipients) > $MAX_RECIPIENTS )
  {
    errors('FATAL', "Too many confirmation recipients specified.");
  }
  ### 

  open (MAIL, "|$sendmail $mailer_flags") || 
           errors ('FATAL', "pipe to '$sendmail $mailer_flags' failed: $!");
  print MAIL "From: $Misc->{CONFIRM_FROMADDRESS}\n";
  print MAIL "To: $Misc->{CONFIRM_RECIPIENT}\n";
  print MAIL "Subject: $Misc->{CONFIRM_SUBJECT}\n\n";
  print MAIL $Misc->{CONFIRM_MESSAGE};
  close (MAIL);
}
###



### write a simple thank you, or redirect the users browser
if ( $Misc->{THANKURL} )
{
  print "Location: $Misc->{THANKURL}\n\n";
}
elsif ( $Misc->{thankURL} )
{
  print "Location: $$Misc->{thankURL}\n\n";
}
else
{
  print "Content-type: text/html\n\n";
  print "<html><head><title>Thank You!</title></head>\n";
  print "<body bgcolor=#FFFFFF>\n";
  print "<h2>Your submission went through!</h2>\n";
  print "<h3>Thank You.</h3>\n";
  print "</body></html>";
}
###


exit;
###############################################################################
###############################################################################

sub fetch_data
{
  ### variable inits
  my $buffer;       # read buffer
  my @pairs;        # array of all name value pairs
  my $pair;         # a single name value pair
  my $name;         # the Field name
  my $value;        # the Field value
  my $type;         # Check type
  my $field;        # The field part of the Check directive
  ###
  
  ### read in data via POST, respond with an error if called via GET
  if ( $ENV{REQUEST_METHOD} eq 'GET' )
  {
    print "Content-type: text/html\n\n";
    print "This Form Mailer script only supports input via POST.<br>\n";
    print "You will need to call it with POST as the method.<p>\n";
    print "-- Thank you, Scott Wimer <scottw\@cgibuilder.com>\n";
    exit(1);
  }
  elsif ( $ENV{REQUEST_METHOD} eq 'POST' )
  {
    read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'});
    @pairs=split(/&/,$buffer);
    foreach $pair (@pairs)
    {
      $pair=~tr/+/ /;$pair=~tr/+/ /;
      ($name,$value)=split(/=/,$pair);
      $value=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $name=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
      $value=~s/<\-\-(.|\n)*?\-\->//g;
      $name=~s/<\-\-(.|\n)*?\-\->//g;
      if ($name=~/CHECK:(.+):(.+)/)
      {
        $type=$1;
        $field=$2;
        push (@{$type}, (split(/,/, $field) ) );
        if ($type eq "SELECT")
        {
          $Select_Check->{$field}=$value; # no '$' so the errors look right
        }
        $Check->{$type}=1;

        next;
      }

      ### store Mailer info fields
      ##- this info is placed in the $Form_Data 
      if ( $name eq 'RECIPIENT'   || $name eq 'recipient' ||
           $name eq 'SUBJECT'     || $name eq 'subject'   ||
           $name eq 'FROMADDRESS' || $name eq 'SEPARATOR' ||
           $name eq 'BROWSER_INFO_HEADING'
         )
      {
        $Form_Data->{"\$$name"}=$value;
      }
      ###
 
      ### Store Misc info fields
      elsif ( $name eq 'THANKURL'     || $name eq 'thankURL'       ||
              $name eq 'ERRORURL'     || $name eq 'errorURL'       ||
              $name eq 'ALPHA_SORT'   || $name eq 'SUPPRESS_EMPTY' || 
              $name eq 'BROWSER_INFO' || $name eq 'LIST_JOIN'      ||
              $name eq 'FORMAT'       || 
              $name eq 'CONFIRM_RECIPIENT'   ||
              $name eq 'CONFIRM_MESSAGE'     ||
              $name eq 'CONFIRM_FROMADDRESS' ||
              $name eq 'CONFIRM_SUBJECT'
            )
      {
        $Misc->{uc($name)}=$value;
      }
      ###

      ### Store user data from the web form
      else
      {
        if ( defined($Form_Data->{"\$$name"}) )
        {
          $Form_Data->{"\$$name"} .= "$Misc->{List_Join} $value";
        }
        else
        {
          $Form_Data->{"\$$name"} = $value;
          push (@fields, $name);
        }
      }
      ###
    } # --- end of foreach $pair (@pairs) loop --- #
  } # --- end of if ( this is a POST method ) block
  ###
  else
  {
    print STDERR "Unsupported calling method.  Must be called via POST.\n";
    exit(1);
  }
}
############ 



### report errors to the user, and exit if the error is severe enough
sub errors
{

  if ($OUTPUT_STARTED == 0)
  {
    print "Content-type: text/html\n\n";
    $OUTPUT_STARTED =1;
  }
  print "Got an error: $_[1]<br>\n";
  if ($_[0] eq 'FATAL')
  {
    print "Serverity = FATAL<br>\n";
    exit(1);
  }
  else
  {
    print "Severity = $_[0]<br>\n";
  }
}
###