#!/usr/bin/perl
# generic forms processor
# version 0.8b-execpc-1
# Oct 9, 1996

# Copyright 1996 by Rod Clark (rclark@aa.net)

# v0.8b-execpc-1
# Auto-configuration of domain name, as long as it's in the
# name field in passwd (jake@execpc.com)

# v0.8b 
# No longer requires user to enter an e-mail address, if not specified
#   with "Required"

# v0.8
# Added cc:
# On user echo page, show to whom e-mail sent.
# Made ECHO DATA HERE matching case-insensitive and less dependent
#   on exact comment syntax.
# Added explanatory note to mail message sent to user.
# Changed an option on sendmail command line from -oem to -oeq
# In responses and mail, separated subject more from user data.

#================================================================
# configuration
#================================================================

# Determine what the hostname should be, depending on the user's
# name in /etc/passwd...

$fqdn = "www.ohiogunshows.com";

if ($fqdn =~ /^(.+)\.cgi\.execpc\.com$/) {
	$email = $1;
	$domain = 'execpc.com';
} else {
	$email = 'webmaster';
	$domain = ($fqdn =~ /^((www|ftp)[^\.]*\.)?(.+)$/)[2];
}

@GoodReferrers         = ($domain, "www.$domain");
$DefaultReturnLinkURL = "http://$fqdn/";
$DefaultMailtoAddress = "$email\@$domain";
$DefaultMailtoName    = "$email\@$domain";
$DefaultFrom          = "$email\@$domain";
$DefaultTo            = "$email\@$domain";

# You'll need to set the following variables.
#

#-----
# syntax example for using forms on one server:

# @GoodReferrers  = ('%%domain-name%%');

# syntax example for using forms on any of several servers:
# (omit "www" prefix if people can use your URLs without it)

# @GoodReferrers  = ('www.%%domain-name%%', 
#                    'www2.%%domain-name%%', 
#                    'another.org');

#-----
# Default return prompt to display on the standard echo page:
# (Applies only if you don't specify a return link on the form
# with a hidden $ReturnLinkURL, and HTTP_REFERER is unavailable.)

# $DefaultReturnLinkURL   = "http://www.%%domain-name%%/";
$DefaultReturnLinkTitle = "Return to Home Page";

#-----
# Defaults for the mailto link on the echo page:
# (Applies only if your mailto address is not specified on the 
# form with a hidden "to" or "MailtoAddress.")
# NOTE: Escape the @ in addresses here, by using \@

$DefaultMailtoPrompt    = "Questions:";
# $DefaultMailtoAddress   = "webmaster\@%%domain-name%%";
# $DefaultMailtoName      = "webmaster\@%%domain-name%%";

#-----
# These are for e-mailing the form results, not printing a 
# mailto link on the echo page as with the previous addresses.
# NOTE: Escape the @ in addresses here, by using \@

# $DefaultFrom            = "webmaster\@%%domain-name%%";
$DefaultSubject         = "Web Form Data";

#-----
$UseDefaultTo           = 1;
# webmaster (or whatever address you choose) lets people reply 
# to an address other than "nobody"
# $DefaultTo              = "webmaster\@%%domain-name%%";

#-----
# Default background color and image for standard echo page:
# Applies only if you don't define your own echo page with a
# hidden $EchoFilePath, and $RedirectURL is not used.

$DefaultBgcolor         = "#FFFFE4";
#$DefaultBackground      = "/images/ivory.gif";

#=====
# The following variables are less likely to need editing. 
# But check them anyway.

$UserMailNote   = "For your records, this is what you entered on the form.";

#-----
# (If you see a "Form Error" message during installation, 
# a bad path to $Mailprogram is the most likely cause. 
# Check the actual location with "which sendmail".)
#
# -oeq avoids some difficulties if address is invalid
$MailProgram    = '/usr/sbin/sendmail -t -oi -oeq';

#-----
# prevents reading other than HTML files
$GoodFileExts   = "\.htm|\.html";

#-----
# if debug is on, redirection will not work. 
$Debug = 0;

#================================================================
# end of configuration
#================================================================

&CheckReferrer;
&GetTime;
&ParseForm;
&CheckRequiredFields;
&SendMail;
if ($Debug)
{
  &PrintDebugPage;
}
else
{
  &PrintEchoPageOrRedirect;
}

#================================================================
# subroutines
#================================================================

sub CheckReferrer
{
  $Referrer = $ENV{'HTTP_REFERER'}; 
  # translate to lowercase
  $Referrer = "\L$Referrer\E";
  $ReferrerOK = 0;
  if ($Referrer) 
  {
    $NumGoodReferrers = @GoodReferrers; 
    for ($RefIndex = 0; $RefIndex < $NumGoodReferrers; $RefIndex++)
    {
      if ($Referrer =~ +$GoodReferrers[$RefIndex]+i) 
      {
        $ReferrerOK = 1;
      }
    }
  }
#### Uncomment if CGI is accessable via file://
#  else 
#  {
#    $ReferrerOK = 1;
#  }

  if (!$ReferrerOK) 
  {
    $ErrorMessage = "The form at <b>$Referrer</b> is outside our domain. Access is denied.";
    push (@Errors, $ErrorMessage);
    &PrintErrorPage;
    exit;
  } 
}


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

  ($Sec, $Min, $Hour, $MonthDay, $Month, $Year, $WeekDay, $YearDay, $IsDST) 
    = localtime (time);
  if ($Hour < 10) 
  {
    {$Hour = "0$Hour";}
  }
  if ($Min < 10) 
  {
    {$Min = "0$Min";}
  }
  $Year = $Year + 1900;

  $Time = "$Hour\:$Min on $Days[$WeekDay], $Months[$Month] $MonthDay, $Year";
}


sub ParseForm 
{
  &ReadParse;

  $to                 = $in{'to'};              # "to" is always needed
  $cc                 = $in{'cc'};
  $email              = $in{'email'};           # equivalent to "from"
  $subject            = $in{'subject'};

  $ReturnLinkURL      = $in{'ReturnLinkURL'};
  $ReturnLinkTitle    = $in{'ReturnLinkTitle'};
  $RedirectURL        = $in{'RedirectURL'};
  $EchoFilePath       = $in{'EchoFilePath'};

  $MailtoPrompt       = $in{'MailtoPrompt'};
  $MailToAddress      = $in{'MailtoAddress'};
  $MailtoName         = $in{'MailtoName'};

  $Required           = $in{'Required'};
  # remove spaces
  $Required           =~ s/ +//g;
  @RequiredFields     = split (/,/, $Required);

  # disallow most special chars, and paths starting with .
  if (($EchoFilePath =~ /[^a-zA-Z0-9-\$_\.\/\~]/) || ($EchoFilePath =~ /^\./))
  {
    $EchoFilePath = '';
  }

  foreach $Part (@in)
  {
    # convert hex values (e.g. %0A) to ASCII characters
    $Part =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    ($Key, $Val) = split (/=/, $Part, 2);
    $Val =~ s/\n/<br>/g;

    if (($Key eq 'to')
    || ($Key eq 'cc')
    || ($Key eq 'subject')
    || ($Key eq 'RedirectURL')
    || ($Key eq 'ReturnLinkURL')
    || ($Key eq 'ReturnLinkTitle')
    || ($Key eq 'Required')
    || ($Key eq 'EchoFilePath'))
    {
      if ($Key eq 'EchoFilePath')
      {
        push (@ScriptPairs, $Key."=".$EchoFilePath);
      }
      else
      {
        push (@ScriptPairs, $Key."=".$Val);
      }
    }
    else
    {
      push (@UserPairs, $Key."=".$Val);
    }
  }
}


sub CheckRequiredFields
{

  if (!$to && !$MailtoAddress && !$UseDefaultTo)
  {
    $ErrorMessage = "This form cannot be sent to its intended recipient.\nPlease send e-mail directly.";
    push (@Errors, $ErrorMessage);
    &PrintErrorPage;
    exit;
  }
  else
  {
    if ($email)
    {
      if ($email =~ /^[\w-.]+\@[\w-.]+$/)
      {
        $EmailOK = 1;
      }
      else
      {
        $MissingMessage = "Your e-mail address (<b>$email</b>) isn't in the usual form. Please make sure it's correct.";
        push (@MissingMessages, $MissingMessage);
      }
    }
    if ($Required)
    {
      foreach $RequiredField (@RequiredFields)
      {
        foreach $UserPair (@UserPairs)
        {
          ($UserKey, $UserVal) = split (/=/, $UserPair, 2);
          if ($RequiredField eq $UserKey)
          {
            if (!$UserVal)
            {
              $MissingMessage = "The required <b>$RequiredField</b> field is missing. Please include it on the form.";
              push (@MissingMessages, $MissingMessage);
            }
          }
        }
      }
    }
    $FieldsMissing = @MissingMessages;
    if ($FieldsMissing)
    {
      &PrintRequiredFieldsPage;
      exit;
    }
  }
}


sub PrintEchoPageOrRedirect 
{
  if ($RedirectURL)
  { 
    print "Location: $RedirectURL\n\n"; 
  } 
  &PrintEchoPage; 
}


sub PrintEchoPage
{
  # check that the echo file is an HTML file

  # change filepath to lowercase
  $EchoFilePathLC = $EchoFilePath;
  $EchoFilePathLC = "\L$EchoFilePathLC\E";
  if ($EchoFilePathLC =~ /$GoodFileExts$/)
  {
    &PrintUserEchoPage;
  }
  else
  {
    &PrintStandardEchoPage;
  }
}


sub PrintUserEchoPage
{
  # Print $EchoFilePath file until encounter <!--ECHO DATA HERE-->
  # Then print the user pairs from the form.
  # Then print the rest of the file.
  # If ECHO DATA HERE is not found, then print the file 
  # without inserting variables from the form.

  if (open (ECHOFILE, $EchoFilePath))
  { 
    &PrintHeader;
    $EchoFileLine = <ECHOFILE>;
    while ($EchoFileLine ne '')
    {
      if (($EchoFileLine =~ /<!--/) && ($EchoFileLine =~ /ECHO DATA HERE/i))
      {
        print "<p>\n";
        print "$MailerMessage\n";
        print "<p>\n";
        if ($subject)
        {
          print "<b>Subject:</b> $subject\n";
        }
        else
        {
          print "<b>Subject:</b> $DefaultSubject\n";
        }
        print "<p>\n";
        &PrintUserPairs;
      }
      else
      {
        print "$EchoFileLine";
      }  
      $EchoFileLine = <ECHOFILE>;
    }
    close (ECHOFILE); 
  }
  else
  {
    &PrintStandardEchoPage;
  }
} 


sub PrintStandardEchoPage
{ 
  &PrintHeader;
  print <<ENDPRINT;
<html>
<head>
<title>Thank You</title>
</head>
<body bgcolor="$DefaultBgcolor" background="$DefaultBackground">

ENDPRINT

  print <<ENDPRINT;
<h2>Thank You</h2>

This is what you entered on the form.<br>
$MailerMessage
<p>
ENDPRINT

  if ($subject)
  {
    print "<b>Subject:</b> $subject\n";
  }
  else
  {
    print "<b>Subject:</b> $DefaultSubject\n";
  }

  print "<hr>\n";
  print "<blockquote>\n";

  &PrintUserPairs;

  print "</blockquote>\n";
  print "<hr>\n";

  &PrintMailto;
  print "<p>\n";
  &PrintReturnLink;
  &PrintPageFooter;
}


sub PrintRequiredFieldsPage
{
  &PrintHeader;
  print <<ENDPRINT;
<html>
<head>
<title>Please Fill Out Required Fields</title>
</head>
<body bgcolor="$DefaultBgcolor" background="$DefaultBackground">

ENDPRINT

  print <<ENDPRINT;
<h2>Please Fill Out Required Fields</h2>
<hr>

<ul>
ENDPRINT

  foreach $MessageLine (@MissingMessages) 
  { 
    print "<p>\n"; 
    print "<li>$MessageLine\n\n"; 
  } 

  print "</ul>\n"; 
  print "</center>\n";

  print "<hr>\n";
  &PrintMailto;
  print "<p>\n";
  &PrintReturnLink;
  &PrintPageFooter;
}


sub PrintErrorPage
{ 
  &PrintHeader;
  print <<ENDPRINT;
<title>Form Error</title>
</head>
<body bgcolor="$DefaultBgcolor" background="$DefaultBackground">

<h2>Form Error</h2>
<hr>

<ul>
ENDPRINT

  foreach $ErrorLine (@Errors) 
  { 
    print "<p>\n"; 
    print "<li>$ErrorLine\n\n"; 
  } 

  print <<ENDPRINT;
</ul>
</center>
<hr>
ENDPRINT

  &PrintMailto;
  &PrintReturnLink;
  &PrintPageFooter;
}


sub PrintDebugPage
{
  &PrintHeader;
  print <<ENDPRINT;
<html>
<head>
<title>Debug Page</title>
</head>
<body bgcolor="$DefaultBgcolor" background="$DefaultBackground">
ENDPRINT

  # script fields
  print "<i>Script fields:</i><br>\n";
  foreach $ScriptPair (@ScriptPairs)
  {
    ($ScriptKey, $ScriptVal) = split (/=/, $ScriptPair, 2);
    print "<b>$ScriptKey:</b> $ScriptVal<br>\n";
  }

  # user fields
  print "<hr>";
  print "<i>User fields:</i><br>\n";
  foreach $UserPair (@UserPairs)
  {
    ($UserKey, $UserVal) = split (/=/, $UserPair, 2);
    print "<b>$UserKey:</b> $UserVal<br>\n";
  }

  # required fields
  # missing field messages
  print "<hr>";
  print "<i>Required fields:</i><br>\n";
  foreach $RequiredField (@RequiredFields)
  {
    foreach $UserPair (@UserPairs)
    {
      ($UserKey, $UserVal) = split (/=/, $UserPair, 2);
      if ($RequiredField eq $UserKey)
      {
        print "<b>$UserKey:</b> $UserVal<br>\n";
      }
    }
  }
  print "<p><i>Missing field messages:</i><br>\n";
  foreach $MissingMessage (@MissingMessages)
  {
    print "<p>\n";
    print "$MissingMessage\n";
  }

  # errors
  print "<hr>";
  print "<i>Errors:</i><br>\n";
  foreach $ErrorLine (@Errors) 
  { 
    print "$ErrorLine\n\n"; 
  } 
}


sub PrintUserPairs
{
  foreach $UserPair (@UserPairs)
  {
    ($UserKey, $UserVal) = split (/=/, $UserPair, 2);
    print "<b>$UserKey:</b> $UserVal<br>\n";
  }
}


sub PrintMailto
{
  if ($MailtoPrompt)
  {
    $PrintPrompt = $MailtoPrompt;
  }
  else
  {
    $PrintPrompt = $DefaultMailtoPrompt;
  }

  if ($to)
  {
    print "$PrintPrompt <a href=\"mailto:$to\">$to</a>\n";
  }  
  elsif ($MailtoAddress)
  {
    if ($MailtoName)
    {
      print "$PrintPrompt <a href=\"mailto:$MailtoAddress\">$MailtoName</a>\n";
    }
    else
    {
      print "$PrintPrompt <a href=\"mailto:$MailtoAddress\">$MailtoAddress</a>\n";
    }
  }
  else
  {
    if ($DefaultMailtoAddress)
    {
      if ($DefaultMailtoName)
      {
        print "$DefaultMailtoPrompt <a href=\"mailto:$DefaultMailtoAddress\">$DefaultMailtoName</a>\n";
      }
      else
      {
        print "$DefaultMailtoPrompt <a href=\"mailto:$DefaultMailtoAddress\">$DefaultMailtoAddress</a>\n";
      }
    }
  }
}

  
sub PrintReturnLink
{
  # If the user's return link name is defined, print a link to it.
  # If not, but the referring page is known, print a link to it.
  # If not, then print a link to the default home page, if it's defined. 

  if ($ReturnLinkURL)
  {
    if ($ReturnLinkTitle)
    {
      print "<p>\n<b><a href=\"$ReturnLinkURL\">$ReturnLinkTitle</a></b>\n";
    }
    else
    {
      print "<p>\n<b>Return to <a href=\"$ReturnLinkURL\">$ReturnLinkURL</a></b>\n";
    }
  }
  else
  {
    if ($Referrer)
    {
      print "<p>\n<b><a href=\"$Referrer\">Return to the Form</a></b><br>\n";
    }
    else
    {
      if (($DefaultReturnURL) && ($DefaultReturnTitle))
      {
        print "<p>\n<b><a href=\"$ReturnLinkURL\">$ReturnLinkTitle</a></b>\n";
      }
    }
  }
}


sub PrintPageFooter
{
  print <<ENDPRINT;
</body>
</html>
ENDPRINT
}


sub SendMail 
{
  $CanSendMail = 0;

  if (open (MAIL,"|-") || exec "$MailProgram") 
  {
    if ($to)
    {
      $MailedTo = $to;
      $CanSendMail = 1;
    }
    else
    {
      if ($UseDefaultTo)
      {
        $MailedTo = $DefaultTo;
        $CanSendMail = 1;
      }
    }

    if ($email)
    {
      $MailedFrom = $email;
    }
    else
    {
      $MailedFrom = $DefaultFrom;
    }

    if ($subject)
    {
      $MailedSubject = $subject;
    }
    else
    {
      $MailedSubject = $DefaultSubject;
    }

    if ($CanSendMail)
    {
      print MAIL "To: $MailedTo\n";
      if ($cc)
      {
        print MAIL "Cc: $cc\n";
      }
      print MAIL "From: $MailedFrom\n";
      print MAIL "Subject: $MailedSubject\n\n";

      &MailSystemData;
      print MAIL "Subject: $MailedSubject\n";
      print MAIL "\n";
      &MailUserPairs;
      close (MAIL);
      $MailerMessage = "Mailed at $Time to <b>$MailedTo</b>\n";
      if ($cc)
      {
        $MailerMessage = $MailerMessage."<br>cc: to <b>$cc</b>\n";
      }
      if ($EmailOK)
      {
        &MailCopyToFormFiller;
      }
    }
    else
    {
      close (MAIL);
      $ErrorMessage = "Form data cannot be sent: no recipient.\n";
      &PrintErrorPage;
      exit;
    }
  }
  else
  {
    $ErrorMessage = "Could not open mail program.\n";
    &PrintErrorPage;
    exit;
  }
}


sub MailCopyToFormFiller
{
  # send a copy to whoever filled out the form
  if ($email)
  {
    if (open (MAIL,"|-") || exec "$MailProgram") 
    {
      print MAIL "To: $email\n";
      print MAIL "From: $MailedTo\n";
      print MAIL "Subject: $MailedSubject\n\n";

      &MailSystemData;
      print MAIL "$UserMailNote\n\n";

      print MAIL "Subject: $MailedSubject\n";
      print MAIL "\n";

      &MailUserPairs;
      close (MAIL);
      $MailerMessage = $MailerMessage."<br>Duplicate mailed to <b>$email</b>";
    }
  }
}


sub MailSystemData
{
  print MAIL "Data entered from: $Referrer\n";
  print MAIL "\n";
}


sub MailUserPairs
{
  foreach $UserPair (@UserPairs)
  {
    ($UserKey, $UserVal) = split (/=/, $UserPair, 2);
    $UserVal =~ s/<br>/\n/g;
    print MAIL "$UserKey: $UserVal\n";
  }
}


#=====================================================================
# GENERAL PURPOSE (BOILERPLATE) ROUTINES 
#=====================================================================

# from cgi-lib.pl v1.14 
# (these routines copyright by Steven Brenner)

sub ReadParse
{
  local (*in) = @_ if @_;
  local ($i, $key, $val);

  # Read in text
  if (&MethGet) 
  {
    $in = $ENV{'QUERY_STRING'};
  } 
  elsif (&MethPost) 
  {
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }

  @in = split(/[&;]/,$in); 

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

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

    # 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 scalar(@in); 
}

sub MethGet 
# true if this cgi call was using the GET request, false otherwise
{
  return ($ENV{'REQUEST_METHOD'} eq "GET");
}

sub MethPost 
# true if this cgi call was using the POST request, false otherwise
{
  return ($ENV{'REQUEST_METHOD'} eq "POST");
}

sub PrintHeader 
{
  print "Content-type: text/html\n\n";
  return;
}
