#!/usr/bin/perl
##########################################################################
# POD Documentation

=head1 PROGRAM NAME AND AUTHOR

Simple Form - Version 2.3
Build Date: September 11, 2004

s_form.cgi
by Peter F. Brown
peterbrown@worldcommunity.com

=head1 COPYRIGHT

Copyright 2004 Peter F. Brown (The World Community Network)
This program complies with the GNU GENERAL PUBLIC LICENSE
and is released as "Open Source Software".
NO WARRANTY IS OFFERED FOR THE USE OF THIS SOFTWARE

=head1 BUG REPORTS AND SUPPORT

Send bug reports to peterbrown@worldcommunity.com.
Visit the author's web site at 'worldcommunity.com'
to view information about support, customer quotes
and fees for custom Perl/MySQL programming.

=head1 OBTAINING THE LATEST VERSION

==> Get the most recent version of this program at:
    http://worldcommunity.com/opensource

=head1 HISTORY

moved history to the bottom of this file

=head1 REQUIREMENTS

Perl 5
CGI.pm

CGI Note: This script doesn't allow the 'GET' method, as a discouragement to spammers.
(I realize that LWP allows the 'POST' method from scripts, but I felt that
 discouraging the GET method was at least one step in the right direction.)

Net::SMTP   (if you select the windows method of email)
A MailServer with a mail daemon such as Sendmail, Qmail, etc.

=head1 SIMPLE FORM SETUP INSTRUCTIONS

There are a TON of form processors, many of them great.
I wanted something simple and quick that could be used for any form,
so instead of checking out all the others, I rolled my own.
Was that a time saver? I don't know, but I enjoyed it. :-)

This script has been updated (as of v2.2) to make it hopefully
immune to a spammer's hijack attempt. (Programmers - I'd appreciate
your expert feedback :-).

The script has a number of checks, including stronger checks for the
HTTP_REFERER variable, as well as the removal of the 'admin_email_to'
and 'admin_email_from' variables from the FORM. You can set them in the
script (you should, in order to get error messages) and you can also set
them in a secondary perl file called 's_form_admin_emails.pl' (which can
be copied and renamed, allowing multiple forms, all pointing to different
email files, thus allowing ONE script to service many forms (according
to the approved domains).

From vesion 2.3, you can now use customized html templates for the
response pages, as well as a 'hook' for a calculation script
(the names of which can be passed from the form hidden fields, thus
allowing for multiple calculation scripts and multiple html templates
while still using the same script).

The calculation script allows for extra validation checking and many
other things, such as adding a PayPal button at the end, or
sending the total over to a live credit card company.

FAST AND EASY SETUP:

NOTE: You MUST set up the variables listed after this POD documentation,
within this script (not the form). There aren't very many, but they're
very important (at least the *required* ones).

This form script requires the following hidden fields in the form:
--------------------------------------------------------------------------------

- form_email_subject    # form email subject sent to admin, eg: 'Response Form'

- form_response_title   # response title for output after submit, eg: 'Response Form'
- form_return_url       # return url displayed after submit, eg: 'domain.com'
- form_return_url_title # return url title displayed after submit, eg: 'My Domain'

- form_fields           # form field names, separated with a |, eg: 'name|phone|zip'
- required_fields       # required form fields, separated with a |, eg: 'name|zip'

The fields listed above are required to have values set in the form.

For example (with required fields ONLY):

<FORM method="post" action="s_form.cgi">
<input type="HIDDEN" name="form_email_subject" value="Our Form Data">
<input type="HIDDEN" name="form_response_title" value="Thanks for filling out our Form!">
<input type="HIDDEN" name="form_return_url" value="http://domain.com">
<input type="HIDDEN" name="form_return_url_title" value="Our Domain Top Page">
<input type="HIDDEN" name="form_fields" value="name|city|state|zip">
<input type="HIDDEN" name="required_fields" value="name|zip">
.... your input fields ... with names corresonding to 'form_fields'
<input type=submit value="Submit with Preview">
</form>

SLIGHTLY MORE COMPLEX SETUP:
In addition, the following fields can optionally be used (they're not required):
--------------------------------------------------------------------------------

- admin_emails_from_file # set to "yes" if used. If yes, will look for
                         # 'admin_emails_filename' - if not found, script will fail

- admin_emails_filename  # file containing admin emails,
                         # usually, "s_form_admin_emails.pl"
                         # you can have many copies of this, for different
                         # users, all with different file names.
                         # NOTE: All the files must be in the authorized
                         # directory, set in the script var below.
                         # ($auth_email_dir)

- email_from_windows_machine # set to 'yes' if you use it
                        # to select Windows compatible (Net::SMTP) method of
                        # sending email.
                        # NOTE: you must also install Net::SMTP and
                        # UNCOMMENT the line below that enables Net::SMTP
                        # (use Net::SMTP;)
                        # you must also set the $mailserver variable

- use_email_in_form     # if set to 'yes', use this INSTEAD OF admin_email_from
                        # for the email "From:" address
                        # NOTE!!! With version 2.2,
                        # admin_email_to and admin_email_from
                        # are set in the script
                        # NOT in the form, to prevent use by spammers

- email_field_name      # field name in form to use for "From:"

- subject_tag_fields    # field names to replace tag of same name in subject line
                        # note: surround the tag in the subject line with :!:,
                        # e.g. subject = "Email from :!:first_name:!:"
                        # NOTE: leave it blank if you don't use it.
                        # To use more than one, separate them with | pipes
                        # e.g: "First Name|Last Name"

- required_either_or_fields # allows alternate required fields
                        # i.e. either one of the checkboxes or the alternate
                        # syntax:
                        # 'main_field1:alternate_field1|main_field2:alternate_field2'
                        # Note: don't place these fields in the regular required
                        # field list. They'll be parsed separately, with one of
                        # the fields required.
                        # NOTE: leave it blank if you don't use it.

                        # NOTE2: you may use a string of multiple fields
                        # on the left, divided by , commas, such as:
                        # 'checkbox1a,checkbox1b,checkbox1c:alternate_field1|

                        # this is non-standard, since most multiple checkboxes, etc,
                        # will have one fieldname and multiple values.
                        # However, at least one client wanted to have a list of
                        # multiple checkbox fields with different names, for the
                        # purpose of importing into a database. Thus, this routine.
                        # NOTE3: if the field on the left of the : has no , commas
                        # then the program will treat it as one field

- show_blank_checks_radios # if set to 'yes', shows blank checkboxes or radio buttons

- preview_data           # if set to 'yes', the user will be shown a preview screen
- preview_response_title # e.g: "PREVIEW of Order<br>Please Click SUBMIT Below!"
- final_submit_label     # e.g: "Submit Data"

- page_color            # background page color of results table
- page_background       # background graphic of results table

- table_color               # background color of results table
- table_cellpadding         # cellpadding value
- table_cellspacing         # cellspacing value

- table_border_width        # table border width value
- bordercolorlight          # table border color light
- bordercolordark           # table border color dark
- bordercolor               # table border color

- table_width               # table_width_value
- table_cell_label_color    # background color of 'label' cells
- table_cell_data_color     # background color of 'data' cells
- table_align               # table align value

- header_footer_cell_color  # top row of response table - background color
- header_footer_field_color # top row of response table - data color
- field_color               # color of field names in results table
- value_color               # color of field values in results table

- pad_email_output      # If 'yes', pad's with spaces
                        # to right justify. If not yes, then left justifies.
                        # (Previously, it always padded.)

- pad_character         # character to pad with, e.g: '_'

- email_output_delimiter # (e.g: ': ', or ' = ')
                         # since the email output is sometimes imported, the delimiter
                         # may be useful
                         # If not specified, set to ' = '

- use_calc_include_file  # set to "yes"
- calc_include_file_name # e.g: "/home_dir/s_form.calc.include.pl"
                         # this allows someone to 'hook' into the main script
                         # and calculate totals, etc. just before preview
                         # or final display, as well as adding totals to the
                         # email message to the admin.
                         # see s_form.calc.include.pl for examples.

                         # look in this script for the line:
                         # require $calc_include_file_name;
                         # that's when all the action in the include file happens

- use_response_template  # set to "yes"
- path_to_template_files # e.g: "/home_dir"
- response_template_file # e.g: "response.template.htm"
                         # don't use a dir path with response_template_file
                         # because the script looks in 'path_to_template_files'
                         # (it needs that dir also for the include files below)

- text_tag               # e.g: ":!:body_text:!:"
- use_include_files      # set to "yes"
- include_file_vars      # e.g: "header|menu|footer"
                         # Note about include_file_vars : use 'filename' but not
                         # 'extension', i.e. 'menu.html' would use the var 'menu'

                         # Note: all include files listed in this array must have
                         # the same extension and be in the same directory
                         # (the path_to_template_files)

- include_file_extension # e.g: ".html"
                         # Note: with $include_file_extension,
                         # (use . before letter extension)

The fields listed above are NOT required to have values set in the form.
(If the color fields are not set, they'll be initialized in the script.)

For example (with optional fields):

<FORM method="post" action="s_form.cgi">
<input type="HIDDEN" name="admin_emails_from_file" value="no">
<input type="HIDDEN" name="admin_emails_filename" value="s_form_admin_emails.pl">

<input type="HIDDEN" name="email_from_windows_machine" value="no">
<input type="HIDDEN" name="use_email_in_form" value="yes">
<input type="HIDDEN" name="email_field_name" value="Email">

<input type="HIDDEN" name="form_email_subject" value="Product Order from :!:First Name:!: :!:Last Name:!:">
<input type="HIDDEN" name="subject_tag_fields" value="First Name|Last Name">

<input type="HIDDEN" name="form_response_title" value="<b><font color=red size=+1>
To Complete Your Order</font></b><br>
<font color=red>Either Click the 'Pay with a Credit Card' Button Below</font><br>
or Print Out This Page and Mail it<br>
(with your Shipping Address) to:<br>Some Address, City, State, Zip">

<input type="HIDDEN" name="form_return_url" value="http://domain.com">
<input type="HIDDEN" name="form_return_url_title" value="Our Domain Top Page">

<input type="HIDDEN" name="form_fields" value="First Name|Last Name|City|State|Zip">
<input type="HIDDEN" name="required_fields" value="First Name|Last Name|Zip">
<input type="HIDDEN" name="required_either_or_fields" value="main_field1:alternate_field1|main_field2:alternate_field2">

<input type="HIDDEN" name="show_blank_checks_radios" value="yes">
<input type="HIDDEN" name="preview_data" value="yes">
<input type="HIDDEN" name="preview_response_title" value="PREVIEW of Form Data<br>Please Click SUBMIT Below!">
<input type="HIDDEN" name="final_submit_label" value="Submit Data">

<input type="HIDDEN" name="page_color" value="white">
<input type="HIDDEN" name="page_background" value="">

<input type="HIDDEN" name="table_color" value="">
<input type="HIDDEN" name="table_cellpadding" value="5">
<input type="HIDDEN" name="table_cellspacing" value="5">
<input type="HIDDEN" name="table_border_width" value="1">
<input type="HIDDEN" name="bordercolorlight" value="#CC9900">
<input type="HIDDEN" name="bordercolordark" value="#006666">
<input type="HIDDEN" name="bordercolor" value="#CC9900">
<input type="HIDDEN" name="table_width" value="">
<input type="HIDDEN" name="table_cell_label_color" value="darkblue">
<input type="HIDDEN" name="table_cell_data_color" value="#F0F0F0">
<input type="HIDDEN" name="table_align" value="center">
<input type="HIDDEN" name="header_footer_cell_color" value="white">
<input type="HIDDEN" name="header_footer_field_color" value="darkblue">
<input type="HIDDEN" name="field_color" value="white">
<input type="HIDDEN" name="value_color" value="black">

<input type="HIDDEN" name="pad_email_output" value="no">
<input type="HIDDEN" name="pad_character" value=" ">
<input type="HIDDEN" name="email_output_delimiter" value=": ">

<input type="HIDDEN" name="use_calc_include_file" value="yes">
<input type="HIDDEN" name="calc_include_file_name" value="/some_dir/s_form.calc.include.pl">
<input type="HIDDEN" name="use_response_template" value="yes">
<input type="HIDDEN" name="path_to_template_files" value="/home_dir">
<input type="HIDDEN" name="response_template_file" value="s_form_response.html">
<input type="HIDDEN" name="text_tag" value=":!:body_text:!:">
<input type="HIDDEN" name="use_include_files" value="no">
<input type="HIDDEN" name="include_file_vars" value="header|menu|footer">
<input type="HIDDEN" name="include_file_extension" value=".html">

.... your input fields

<input type=submit value="Submit with Preview">
</form>

The script itself has only a few setup params (in setup section below)
NOTE: The setup vars below are mandatory.
............................................................................

There you have it. Not complicated, but good for simple and quick form usage.

=cut

##############################################################################
# SCRIPT AREA - SEE SETUP VARS BELOW

use File::Basename;

use CGI qw(:all -private_tempfiles escapeHTML unescapeHTML);
use CGI::Carp qw(fatalsToBrowser cluck);
$CGI::POST_MAX=1024 * 50;  # max 50K posts
$q = new CGI;

### ***SETUP AREA***
### ............................................................................
### UNCOMMENT THE LINE:
### use Net::SMTP;
### IF YOU SET THE VARIABLE
### $email_from_windows_machine TO "yes"

# use Net::SMTP;

# UNCOMMENT THE LINE ABOVE if necessary
# !!!

$script_name       = 's_form.2.3.cgi';

$auth_email_dir    = '/your_home_dir';
                   # the only directory where the 'admin_emails_filename' file
                   # can be stored - thus preventing a user from
                   # using a form in a virtual server, pointing
                   # to a different script in a different virtual server
                   # on the same machine. Overkill? Maybe. Blame the spammers.

$admin_email_to    = 'you@yourdomain.com';
                   # email(s) to send the form data to, eg: 'you@domain.com'

$admin_email_from  = 'webmaster@yourdomain.com';
                   # from email, eg: 'you@domain.com'

$return_path       = $admin_email_to;
                   # return path email for bounces

$mailprog          = "/var/qmail/bin/qmail-inject -h";
# $mailprog        = '/usr/lib/sendmail -t -oi';
# $mailprog        = '/usr/sbin/sendmail -t -oi';

$mailserver        = 'localhost';
                   # set to 'localhost' usually - only used if
                   # email_from_windows_machine is set to "yes"

$restrict_to_hosts = 'yes';
                   # set to 'yes' or 'no'
                   # I STRONGLY ENCOURAGE YOU TO SET THIS TO YES
                   # SO THAT SPAMMERS DON'T TRY TO USE THE SCRIPT
                   # AS AN OPEN MAIL RELAY TO SEND SPAM.
                   # THERE ARE OTHER CHECKS IN THE SCRIPT, BUT THIS
                   # VARIABLE IS IMPORTANT.

@allowed_domains   = qw[
                        yourdomain.com
                        www.yourdomain.com
                       ];
                   # allowed domains, eg: domain1.com domain2.com
                   # note that you should use the 'www' syntax as one of
                   # your domains, in case users type that. eg:
                   # www.worldcommunity.com
                   # worldcommunity.com

# end of setup area
# You normally don't have to change anything below this line.
# ............................................................................
# ............................................................................

print "Content-type: text/html\n\n";

&process_data;

exit;

##############################################################################
# process_data
sub process_data
{

my($q) = @_;

# get system file parameters
$use_calc_include_file  = param('use_calc_include_file');
$calc_include_file_name = param('calc_include_file_name');
$use_response_template  = param('use_response_template');
$path_to_template_files = param('path_to_template_files');
$response_template_file = "$path_to_template_files/" . param('response_template_file');
$text_tag               = param('text_tag');
$use_include_files      = param('use_include_files');
@include_file_vars      = split /\|/, param('include_file_vars');
$include_file_extension = param('include_file_extension');

# get environment vars

$referring_url  = $ENV{'HTTP_REFERER'};
$host_name      = $ENV{'HTTP_HOST'};
$request_uri    = $ENV{'REQUEST_URI'};
$request_method = $ENV{'REQUEST_METHOD'};

($e1, $e2, $from_server, @e3) = split (/\//, $referring_url);

$vars = qq~
REFERRING_URL: $referring_url
PREFIX1: $e1
PREFIX1: $e2
SERVER: $from_server
FILENAME: @e3
REQUEST_METHOD: $request_method
REQUEST_URI (URL): $request_uri
------------------------------------\n~;

foreach $key ( keys %ENV )
  {
  $value = $ENV{$key};
  $vars .= "$key - $value <br>\n";
  }

# get color variables / or set them

$page_color                = param('page_color');
$page_background           = param('page_background');
$table_color               = param('table_color');
$table_cellpadding         = param('table_cellpadding');
$table_cellspacing         = param('table_cellspacing');
$table_border_width        = param('table_border_width');
$bordercolorlight          = param('bordercolorlight');
$bordercolordark           = param('bordercolordark');
$bordercolor               = param('bordercolor');
$table_width               = param('table_width');
$table_cell_label_color    = param('table_cell_label_color');
$table_cell_data_color     = param('table_cell_data_color');
$table_align               = param('table_align');
$header_footer_cell_color  = param('header_footer_cell_color');
$header_footer_field_color = param('header_footer_field_color');
$field_color               = param('field_color');
$value_color               = param('value_color');

unless ( $page_color =~ /\w+/ )               {$page_color                = "white";}
unless ( $page_background =~ /\w+/ )          {$page_background           = "";}

unless ( $table_color =~ /\w+/ )              {$table_color               = "";}
unless ( $table_cellpadding =~ /\d+/ )        {$table_cellpadding         = '5';}
unless ( $table_cellspacing =~ /\d+/ )        {$table_cellspacing         = '0';}
unless ( $table_border_width =~ /\d+/ )       {$table_border_width        = '2';}

unless ( $bordercolorlight =~ /\w+/ )         {$bordercolorlight          = '#CC9900';}
unless ( $bordercolordark =~ /\w+/ )          {$bordercolordark           = '#006666';}
unless ( $bordercolor =~ /\w+/ )              {$bordercolor               = '#CC9900';}

unless ( $table_width =~ /\d+/ )              {$table_width               = '';}
unless ( $table_cell_label_color =~ /\w+/ )   {$table_cell_label_color    = 'darkblue';}
unless ( $table_cell_data_color =~ /\w+/ )    {$table_cell_data_color     = '#F0F0F0';}
unless ( $table_align =~ /\w+/ )              {$table_align               = 'center';}

unless ( $header_footer_cell_color  =~ /\w+/ ){$header_footer_cell_color  = "white";}
unless ( $header_footer_field_color =~ /\w+/ ){$header_footer_field_color = "darkblue";}
unless ( $field_color =~ /\w+/ )              {$field_color               = "white";}
unless ( $value_color =~ /\w+/ )              {$value_color               = "black";}

if ( $use_response_template ne 'yes' )
      {
      # print body tag
      print qq~<body bgcolor="$page_color" background="$page_background">~;
      }

# FIRST, check for admin_email_to, etc.

$admin_emails_from_file = param('admin_emails_from_file');
$admin_emails_filename  = param('admin_emails_filename');

if ( $admin_emails_from_file eq 'yes' )
      {
      # strip possible path elements
      # (to prevent usage by other users on same server)
      # and reassemble with authorized path

      my $dirname = dirname($admin_emails_filename);

      if ( $dirname =~ /\w+/ or $dirname =~ /\.\./ )
            {
            &error_message(qq~
            Error!<p>The Admin Emails Filename cannot contain
            a directory path. <br>
            Directory Used: $dirname <br>
            Only use the actual filename,
            without "../" or etc.
            ~);
            }

      my $input_file = basename($admin_emails_filename);
      my $email_file = "$auth_email_dir/$input_file";

      if ( -e "$email_file" )
              {
              require "$email_file";
              }
      else
              {
              &error_message(qq~
              Error!<p>
              The email file [$input_file] does not exist.
              <p>
              ~);
              }

      # now check addresses

      $admin_email_to   = &check_email('admin_email_to',$admin_email_to);
      $admin_email_from = &check_email('admin_email_from',$admin_email_from);
      $return_path      = &check_email('return_path',$return_path);
      }

# check for get method

if (
    "$request_method" eq 'GET' or
    $request_uri      =~ /\&/  or
    $request_uri      =~ /\?/
   )
      {
      $msg = qq~
      Someone tried to use your form incorrectly at $host_name.
      FORM REQUEST METHOD of GET or
      REQUEST_URI (URL) had \& or \? characters in it.
      $vars
      ~;
      $msg =~ s/^\s+//mg;

      &mail_to($admin_email_to, $admin_email_from, "$host_name Form Abuse", $msg, $admin_email_from);

      &error_message(qq~
      Error!<br><br>
      You don't have permission to use this form.
      ~);
      }

# check for restricted hosts

if ( $restrict_to_hosts eq "yes" )
        {
        if ( $referring_url !~ /\w+/ )
            {
            $msg = qq~
            Someone tried to use your form incorrectly at $host_name.
            BAD or BLANK Referring URL
            $vars
            ~;
            $msg =~ s/^\s+//mg;

            &mail_to($admin_email_to, $admin_email_from, "$host_name Form Abuse", $msg, $admin_email_from);

            &error_message(qq~
            Error!<br><br>
            You don't have permission to use this form.
            ~);
            }

        $found = 'no';
        foreach $allowed_domain ( @allowed_domains )
                {
                if ( "$allowed_domain" eq "$from_server" )
                        {
                        $found = 'yes';
                        last;
                        }
                }

        unless ( $found eq 'yes' )
                {
                $msg = qq~
                Someone tried to use your form incorrectly at $host_name.
                BAD Referring URL
                $vars
                ~;
                $msg =~ s/^\s+//mg;

                &mail_to($admin_email_to, $admin_email_from, "$host_name Form Abuse", $msg, $admin_email_from);

                &error_message(qq~
                Error!<br><br>
                You don't have permission to use this form.
                ~);
                }
        }

# check for required SYSTEM hidden fields
# (We'll check for user hidden fields below)

@req_hidden = qw[
                form_email_subject
                form_response_title
                form_return_url
                form_return_url_title
                form_fields
                required_fields
                ];

$rqh_string = join ', ', @req_hidden;

foreach my $rqh ( @req_hidden )
        {
        my $rqh_val = param($rqh);
        $rqh_val =~ s/^\s+//g;
        $rqh_val =~ s/\s+$//g;

        if ( length($rqh_val) < 1 )
                {
                &error_message(qq~
                <b>Script Error!</b>
                <p>
                The following HIDDEN fields are required,
                and must have values.
                <br>
                [$rqh_string\]
                <p>
                The field that generated this error is<br>
                [$rqh\]
                <p>
                Please contact the sysadmin.
                ~);
                }
        }

# get form data

$email_from_windows_machine = param('email_from_windows_machine');

if ( param('use_email_in_form') eq 'yes' )
      {
      $email_field_name = param('email_field_name');
      $admin_email_from = param($email_field_name);
      $admin_email_from = &check_email($email_field_name,$admin_email_from);
      }
else
      {
      $admin_email_from = &check_email('admin_email_from',$admin_email_from);
      }

if ( param('use_email_in_form') eq 'yes' )
        {
        param($email_field_name, $admin_email_from);
        }

$preview_data             = param('preview_data');
$form_response_title      = param('form_response_title');
$preview_response_title   = param('preview_response_title');
$final_submit_label       = param('final_submit_label');

unless ( $preview_response_title =~ /\w+/ )
       { $preview_response_title = qq~PREVIEW of Form Data<br>Please Click SUBMIT Below!~;}

unless ( $final_submit_label =~ /\w+/ )
       { $final_submit_label = "Submit Data"; }

if ( $preview_data eq 'yes' )
      {
      $form_response_title = $preview_response_title;
      }

$form_email_subject       = param('form_email_subject');

# get rid of linefeeds to protect from spammers using \nCc:
$form_email_subject       =~ s/\n+/ /g;
$form_email_subject       =~ s/\r+/ /g;
$form_email_subject       =~ s/\\n+/ /g;
$form_email_subject       =~ s/\\r+/ /g;
param('form_email_subject', $form_email_subject);

@subject_tag_fields       = split /\|/, param('subject_tag_fields');

if ( scalar(@subject_tag_fields) > 0 )
      {
      foreach $subject_tag_field ( @subject_tag_fields )
            {
            my $subject_tag_field_text = param($subject_tag_field);
            $form_email_subject =~ s/:!:$subject_tag_field:!:/$subject_tag_field_text/g;
            }
      }

$form_return_url          = param('form_return_url');

if ( $form_return_url =~ /$script_name/ )
      {
      &error_message(qq~
      Error!<p>Your return url cannot contain the script name.
      <p>
      The form return url that was used was:<br>
      $form_return_url
      <p>
      ~);
      }

$form_return_url_title    = param('form_return_url_title');
$show_blank_checks_radios = param('show_blank_checks_radios');

$pad_email_output         = param('pad_email_output');
$pad_character            = param('pad_character');
unless ( $pad_character ) {$pad_character = ' ';}

$email_output_delimiter   = param('email_output_delimiter');
unless ( $email_output_delimiter ){$email_output_delimiter = ' = ';}

$form_fields           = param('form_fields');
@form_fields           = split /\|/, $form_fields;

$required_fields       = param('required_fields');
@required_fields       = split /\|/, $required_fields;
$required_fields       =~ s/\|/, /g;

foreach $rq ( @required_fields )
        {
        $rq_data = 'none';

        @rq_values = param($rq);

        foreach $rq_val ( @rq_values )
            {
            $rq_val =~ s/^\s+//g;
            $rq_val =~ s/\s+$//g;

            if ( $rq_val =~ /\w+/ and $rq_val !~ 'Select from List' )
                  {
                  $rq_data = 'exists';
                  }
            }

        if ( $rq_data eq 'none' )
                {
                &error_message(qq~
                <b>Error!</b>
                <p>
                The following fields are required to have values.
                <br>
                [$required_fields\]
                <p>
                The field that generated this error is<br>
                [$rq\]
                <p>
                Please hit back and try again.
                ~);
                }
        }

# process $required_either_or_fields

$required_either_or_fields      = param('required_either_or_fields');
@required_either_or_field_pairs = split /\|/, $required_either_or_fields;
$required_either_or_fields      =~ s/\|/<font color=red> \|<\/font><br>/g;
$required_either_or_fields      =~ s/\:/<font color=red> or <\/font>/g;

foreach $rq_pair ( @required_either_or_field_pairs )
        {
        $either_or_data = 'none';

        ($rq1, $rq2) = split /\:/, $rq_pair;

        if ( $rq1 =~ /,/ )
            {
            # check for multiple fields on the left
            # this is non-standard, since most multiple checkboxes, etc,
            # will have one fieldname and multiple values.
            # However, at least one client wanted to have a list of
            # multiple checkbox fields with different names, for the
            # purpose of importing into a database. Thus, this routine.

            @rq1_fields = split /,/, $rq1;

            foreach $rq1_field ( @rq1_fields )
                  {
                  @rq1_values = param($rq1_field);

                  foreach $rq1_val ( @rq1_values )
                        {
                        $rq1_val =~ s/^\s+//g;
                        $rq1_val =~ s/\s+$//g;

                        if ( $rq1_val =~ /\w+/ and $rq1_val !~ /Select from List/ )
                              {
                              $either_or_data = 'exists';
                              }
                        }
                  }
            }
        else
            {
            # check $rq1 as a single field

            @rq1_values = param($rq1);

            foreach $rq1_val ( @rq1_values )
                  {
                  $rq1_val =~ s/^\s+//g;
                  $rq1_val =~ s/\s+$//g;

                  if ( $rq1_val =~ /\w+/ and $rq1_val !~ /Select from List/ )
                      {
                      $either_or_data = 'exists';
                      }
                  }
            }

        # now check $rq2

        @rq2_values = param($rq2);

        foreach $rq2_val ( @rq2_values )
            {
            $rq2_val =~ s/^\s+//g;
            $rq2_val =~ s/\s+$//g;

            if ( $rq2_val =~ /\w+/ and $rq2_val !~ /Select from List/ )
                  {
                  $either_or_data = 'exists';
                  }
            }

        # if data doesn't exist in either field, then print error

        if ( $either_or_data eq 'none' )
            {
            $rq_pair =~ s/\:/<font color=red> or <\/font>/g;

            &error_message(qq~
            <b>Error!</b>
            <p>
            The following "either or fields" are required to have values.
            <br>
            (That is, you have to fill in one or the other.)<br>
            [$required_either_or_fields\]
            <p>
            <font color=red>
            The field pair that generated this error is<br>
            </font>
            [$rq_pair\]
            <p>
            Please hit back and try again.
            ~);
            }
        }

# continue processing

$html_text = qq~
<br>
<table width="$table_width" border="$table_border_width"
cellspacing="$table_cellspacing" cellpadding="$table_cellpadding"
align="$table_align" bgcolor="$table_color" bordercolorlight = "$bordercolorlight"
bordercolordark = "$bordercolordark" bordercolor = "$bordercolor">

<tr><td align=center colspan=2 bgcolor="$header_footer_cell_color">
<font color="$header_footer_field_color"><b>$form_response_title</b></font>
</td></tr>
~;

$mail_body = '';

# get maximum length of field NAMES for email formatting

$max_length = 1;
foreach $field ( @form_fields )
        {
        if ( length($field) > $max_length ){$max_length = length($field);}
        }

foreach $field ( @form_fields )
        {
        if ( $pad_email_output eq 'yes' )
            {
            $pad   = ($max_length - length($field)) + 3;
            $space = $pad_character x $pad;
            }
        else
            {
            $space = $pad_character;
            }

        # now get field values
        # fixed this in v1.1 (I wasn't placing the values in an array
        # which of course didn't work for checkboxes or multiple select popdowns.)
        # Oy Vey :-)

        @values = param($field);

        if ( scalar(@values) == 0 and $show_blank_checks_radios eq 'yes' )
            {
            push @values, '';
            }

        foreach $true_value ( @values )
            {
            $mail_body .= $space . $field . $email_output_delimiter . $true_value . "\n";

            $escape_value = escapeHTML($true_value);

            $html_text .= qq~<tr>
                         <td width="30%" align=right bgcolor="$table_cell_label_color">
                         <font color="$field_color"><b>$field</b></font>
                         </td>
                         <td bgcolor="$table_cell_data_color">
                         <font color="$value_color">$escape_value &nbsp;</font>
                         </td></tr>
                        ~;
            }
        }

## calculate special values
## using an external file 'hooked' into this one

# why doesn't this work? if both vars are blank, Perl acts as if both are true.
# if ( $use_calc_include_file eq 'yes' and -e "$calc_include_file_name" )

if ( $use_calc_include_file eq 'yes' )
      {
      if ( -e "$calc_include_file_name" )
            {
            require $calc_include_file_name;
            }
      else
            {
            &error_message(qq~
            <br>Error!<p>
            Calc Include File ($calc_include_file_name\) not found.<br>
            Please contact the system administrator.
            <p>
            ~);
            }
      }

## process for preview or submit

$html_text .= qq~
<tr><td align=center colspan=2 bgcolor="$header_footer_cell_color" nowrap>
<font color="$header_footer_field_color"><b>
~;

if ( $preview_data eq 'yes' )
      {
      param(preview_data, 'no');

      $script_name = $0;
      @script_parts = split /\//, $script_name;
      $script_name  = $script_parts[$#script_parts];

      $html_text .= qq~<FORM method="post" action="$script_name">~;

      foreach my $field ( param )
            {
            # fixed this in v2.3 (I wasn't placing the values in an array
            # which of course didn't work for checkboxes or multiple select popdowns.)
            # Oy Vey :-) again!

            my @values = param($field);

            foreach my $true_value ( @values )
                  {
                  my $value_hidden = escapeHTML($true_value);
                  $html_text .= qq~<input type="hidden" name="$field" value="$value_hidden">\n~;
                  }
            }

      $html_text .= qq~
      <input type="submit" name="Submit" value="$final_submit_label"><br>
      </form>
      ... or ...<br>
      ~;
      }
else
      {
      if ( $email_from_windows_machine eq 'yes' )
            {
            &mail_to_win($admin_email_to, $admin_email_from, $form_email_subject, $mail_body, $admin_email_from);
            }
      else
            {
            &mail_to($admin_email_to, $admin_email_from, $form_email_subject, $mail_body, $admin_email_from);
            }
      }

$html_text .= qq~
Return to <a href="$form_return_url">$form_return_url_title</a>
</b></font>
</td></tr>
</table>
<br>
~;

if ( $use_response_template eq 'yes' )
      {
      $response_template_text = &get_response_template_text($html_text);
      print $response_template_text;
      }
else
      {
      print $html_text;
      }

exit;

}
##############################################################################
# mail_to
sub mail_to
{

# &mail_to($email_to, $email_from, $subject, $mail_body, $reply_to);

my ($email_to, $email_from, $subject, $mail_body, $reply_to) = @_;

if ( $reply_to !~ /\@/ ){$reply_to = $email_from;}

$return_path =~ s/[\r\n]/ /gs;
$email_to    =~ s/[\r\n]/ /gs;
$email_from  =~ s/[\r\n]/ /gs;
$subject     =~ s/[\r\n]/ /gs;
$reply_to    =~ s/[\r\n]/ /gs;

open (MAIL, "|$mailprog") or &error_message(qq~Error: Can't open $mailprog! - $!~);

print MAIL "Return-Path: $return_path\n";
print MAIL "To: $email_to\n";
print MAIL "From: $email_from\n";
print MAIL "Subject: $subject\n";
print MAIL "Reply-To: $reply_to\n";
print MAIL "\n";
print MAIL "$mail_body";
print MAIL "\n";
close (MAIL);

}
##############################################################################
# mail_to_win
sub mail_to_win
{

# &mail_to($email_to, $email_from, $subject, $mail_body, $reply_to);

my ($email_to, $email_from, $subject, $mail_body, $reply_to) = @_;

# set additional vars

if ( $reply_to !~ /\@/ ){$reply_to = $email_from;}

$return_path =~ s/[\r\n]/ /gs;
$email_to    =~ s/[\r\n]/ /gs;
$email_from  =~ s/[\r\n]/ /gs;
$subject     =~ s/[\r\n]/ /gs;
$reply_to    =~ s/[\r\n]/ /gs;

$mail_to_in  = $email_to; # e.g: $mail_to_in  =
                          # 'peterbrown@worldcommunity.com, pfb2@worldcommunity.com';

# split email_to, and mail separately

@mail_to_array = split /,/, $mail_to_in;

foreach $mail_to ( @mail_to_array )
      {
      $mail_to =~ s/^\s+//;
      $mail_to =~ s/\s+$//;

      # print "sending mail from $email_from to $mail_to ...<br>";

      $smtp = Net::SMTP->new( $mailserver )           or &error_message(qq~Error connecting to $mailserver - $!~);

      $smtp->mail( $email_from )                      or &error_message(qq~Error with To: $email_from - $!~);
      $smtp->to( $mail_to )                           or &error_message(qq~Error with From: $mail_to - $!~);
      $smtp->data()                                   or &error_message(qq~Error starting Data message - $!~);

      # Send the header.
      $smtp->datasend("Return-Path: $return_path\n")  or &error_message(qq~Error with Return-Path: $return_path - $!~);
      $smtp->datasend("Reply-To: $reply_to\n")        or &error_message(qq~Error with Reply-To: $reply_to - $!~);
      $smtp->datasend("To: $mail_to\n")               or &error_message(qq~Error with To: $mail_to - $!~);
      $smtp->datasend("From: $email_from\n")          or &error_message(qq~Error with From: $email_from - $!~);
      $smtp->datasend("Subject: $subject\n")          or &error_message(qq~Error with Subject: $subject - $!~);
      $smtp->datasend("\n")                           or &error_message(qq~Error with Header Blank Line - $!~);

      # Send the body.
      $smtp->datasend($mail_body)                     or &error_message(qq~Error with Message Body - $!~);
      $smtp->dataend()                                or &error_message(qq~Error with Data End - $!~);
      $smtp->quit                                     or &error_message(qq~Error with SMTP Quit - $!~);

      # print "sent mail ... <br>";
      }

}
###################################################################################
#check_email
sub check_email
{

# $email = &check_email($email);

my ($fieldname, $email) = @_;

if (
        length($email) < 5 or
        $email !~ /\@/     or
        $email !~ /\./     or
        $email =~ /\s+/    or
        $email =~ /\\n+/   or
        $email =~ /\n+/    or
        $email =~ /\\r+/   or
        $email =~ /\r+/
   )
        {
        &error_message(qq~
        <p>
        Sorry...
        <p>
        The email address [$email\] (from field: $fieldname)
        is incorrect. <br>
        It can't
        contain any spaces or linefeeds, <br>
        and it must of course
        contain an \@ symbol and a . (dot).
        <p>
        Please hit your back button and try again,<br>
        or contact the form administrator.
        <p>
        ~);
        }

# get rid of linefeeds to protect from spammers using \nCc:
$email =~ s/\n+//g;
$email =~ s/\r+//g;
$email =~ s/\\n+//g;
$email =~ s/\\r+//g;

return($email);

}
###################################################################################
# error_message
sub error_message
{

# &error_message($error_text);

my ($error_text) = @_;

$body_text = qq~
                <table width="80%" border="1" cellpadding="5" align="center" bgcolor="$table_color">
                <tr><td align=center bgcolor="$table_cell_label_color">
                <font color="$field_color"><b>
                $error_text
                </b></font>
                </td></tr>
                </table>
               ~;

if ( $use_response_template eq 'yes' )
      {
      $response_template_text = &get_response_template_text($error_text);
      print $response_template_text;
      }
else
      {
      print $body_text;
      }

exit;

}
###################################################################################
# get_response_template_text
sub get_response_template_text
{

# $response_template_text = &get_response_template_text;

my ($body_text) = @_;

# don't use &include_file to avoid loop

my $filesize;
my $response_template_text;

#obtain size of file
$filesize = -s $response_template_file;

# open file
unless ( open(FILE, $response_template_file ))
      {
      print qq~<br><br><p align=center><b>Script Error!<br>
               Can't open File $response_template_file.<br>
               Please inform the System Administrator<br>
               <a href="mailto:$admin_email_to">
               $admin_email_to</a>
               <br><br>
               Original Message was:<br>
               $body_text
               </p>
              ~;
      exit;
      }

# read whole file into variable
read (FILE, $response_template_text, $filesize);
close(FILE);

$response_template_text =~ s/$text_tag/$body_text/;

if ( $use_include_files eq 'yes' )
      {
      foreach my $include_var ( @include_file_vars )
            {
            my $i_file = $path_to_template_files . '/' .
                         $include_var . $include_file_extension;

            # get include file (don't use include_file or error_message
            # to avoid endless loop)

            my($filesize);
            my($i_text);

            #obtain size of file
            $filesize = -s $i_file;

            # open file
            unless ( open(INCLUDE_FILE, $i_file ))
                  {
                  print qq~<br><br><p align=center><b>Script Error!<br>
                           Can't open File $i_file.<br>
                           Please inform the System Administrator<br>
                           <a href="mailto:$admin_email_to">
                           $admin_email_to</a>
                           <br><br>
                           Original Message was:<br>
                           $body_text
                           </p>
                          ~;
                  exit;
                  }

            # read whole file into variable
            read (INCLUDE_FILE, $i_text, $filesize);
            close(INCLUDE_FILE);

            # replace template with file

            $response_template_text =~ s/:!:$include_var:!:/$i_text/;
            }
      }

return($response_template_text);

}
###################################################################################
# include_file
sub include_file
{

my($i_file) = @_;
my($filesize);
my($i_text);

#obtain size of file
$filesize = -s $i_file;

# open file
unless ( open(INCLUDE_FILE, $i_file ))
{
    &error_message(qq~Error!<p>
    Can't open File $i_file.~);
}

# read whole file into variable
read (INCLUDE_FILE, $i_text, $filesize);

close(INCLUDE_FILE);

return($i_text);

}
##############################################################################

=head1 HISTORY
---------------------------------------------------------------

- v2.3      - September 11, 2004
            - added routine to remove linefeeds from email headers
              in subroutines &mail_to and &mail_to_win.
              I did the same thing in other places, but this is just one more step.
              Thanks to Justin Mason, co-author of a security analysis
              document regarding the script "FormMail 1.9", written by Matt Wright.
              (I based a number of my 2.2 changes on the analysis in that doc.)

            - fixed problem with checkboxes - multiple values with preview function

            - added ability to use an html template for response pages
              the parameters for this are in the hidden html form fields

            - added ability to use "include files" inside the html response files
              by placing :!:tags:!: representing the include files where the normal
              <!--#include virtual="/header.html" --> include SSI commands would go.
              For example, instead of using the above SSI command, you would place a
              tag, :!:header:!: in that spot. Then, in the form hidden field called
              "include_file_vars", you would place the tag name "header". You can use
              more than one, separated by | pipes.

            - added error checks to see if html template and include files exist
            - reworked error_message to use html template if exists

            - added a hook to include a Perl include file that contains various
              calculations on the form fields - such as totaling orders, etc.
              Thus, the script can be expanded without modification.
              Note that the code in the include file has to be aware of what's
              going on in the form and the script.

            - added two hidden fields: "preview_response_title" and "final_submit_label"
              to input form, for customization

            - added new table variables for output, i.e:
            - table_cellpadding         # cellpadding value
            - table_cellspacing         # cellspacing value
            - table_border_width        # table border width value
            - bordercolorlight          # table border color light
            - bordercolordark           # table border color dark
            - bordercolor               # table border color
            - table_width               # table_width_value
            - table_cell_label_color    # background color of 'label' cells
            - table_cell_data_color     # background color of 'data' cells
            - table_align               # table align value

            - changed 'subject_tag_fields' to 'subject_tag_fields' (plural)
              to allow for multiple tags in the subject line, i.e.
              e.g. subject = "Email from :!:First Name:!: :!:Last Name:!:"
              To use more than one, separate them with | pipes in the
              subject_tag_fields value, e.g: "First Name|Last Name"

- v2.2      - August 9, 2004
            - removed earlier versions of script from website
              THIS VERSION is a STRONGLY recommended upgrade!

            - removed admin_email_to and admin_email_from from the form
              parameters to stop spammers from potentially setting the to
              and from fields via the url line. the vars are now set in the script

            - added ability to store admin_email_to, admin_email_from and
              return_path emails in secondary script file, providing for
              multiple form usage.

            - checked for linefeeds in the email and subject lines to stop
              spammers from using a \nCc: syntax
            - added a var, $script_name, to check to make sure the return url
              does not contain the script name, setting up a potential loop
            - added a var $return_path for bounces
            - added an error_message subroutine
            - added additional checks to trap use from other hosts
              when $restrict_to_hosts = 'yes'
            - added check for GET method of form submission - blocks such usage
            - added output of ENV variables with email sent to admin user
              of form abuse
            - added check_emails subroutine

- v2.1      - March 30, 2004
            - added $pad_character to the form fields so that one could
              change the pad character. The default is ' '.

- v2.0      - September 14, 2003

            - added $show_blank_checks_radios eq 'yes/no'
              if set to 'yes', shows blank checkboxes and radio buttons
              on output

            - added 'subject_tag_field' so that if one places a form field
              name in the subject string, surrounded by special delimiters,
              as in "Email from :!:first_name:!:" and then places the
              value "first_name" in the subject_tag_field hidden field,
              at run time the value in that field will replace the tag in
              the subject line. It should be a 'required' field; however,
              if the field is blank, it will simply replace the tag with ''.

            - added a field 'required_either_or_fields'
              the syntax is 'main_field1:alternate_field1|main_field2:alternate_field2'
              Note: don't place these fields in the regular required field list.
              They'll be parsed separately, with one of the fields required.

              NOTE2: you may use a string of multiple fields
              on the left, divided by , commas, such as:
              'checkbox1a,checkbox1b,checkbox1c:alternate_field1|

              this is non-standard, since most multiple checkboxes, etc,
              will have one fieldname and multiple values.
              However, at least one client wanted to have a list of
              multiple checkbox fields with different names, for the
              purpose of importing into a database. Thus, this routine.
              NOTE3: if the field on the left of the : has no , commas
              then the program will treat it as one field

            - added a field 'preview_data' - set to 'yes/no'
              if set to 'yes', the user will be shown a preview screen

            - added color codes for headers and footer rows

            - added field ('email_from_windows_machine' / 'yes/no')
              to select Windows compatible (Net::SMTP) method of sending email.

            - moved color variables to hidden fields in form, for ease of use
              this also allows one to use different colors for different forms.

            - added color and graphic variables: page_color, page_background

            - added a field 'pad_email_output'. If 'yes', pad's with spaces
              to right justify. If not yes, then left justifies.
              (Previously, it always padded.)

            - added a field 'email_output_delimiter' (e.g: ': ', or ' = ')
              since the email output is sometimes imported, the delimiter
              may be useful

- v1.1      - April 7, 2002
            - Fixed problem with checkboxes - multiple values weren't being
              grabbed - Oy vey - what a stupid oversite - my apologies!
            - Added some code to check for invalid email addresses.
            - Added some table code wrapped around the error messages.

- v1.0      - June 4, 2001
            - First Initial Release

=cut

##############################################################################