#!/usr/bin/perl # @referers allows forms to be located only on servers which are defined # in this field. This fixes a security hole in the last version which # allowed anyone on any server to use your FormMail script. @referers = ('www.synergy-development-llc.com'); ############################################################ # Check Referring URL &check_url; # Retrieve Date &get_date; # Load Registration Cookie &load_registration; # Parse Form Contents &parse_form; # Check Required Fields #&check_required; # 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) = (localtime(time))[0,1,2,3,4,5,6]; $time = sprintf("%02d:%02d:%02d",$hour,$min,$sec); $year += 1900; $date = "$days[$wday], $months[$mon] $mday, $year at $time"; $month=$mon + 1; $yr=$year - 2000; $day_stamp = sprintf("%02d/%02d/%02d",$month,$mday,$yr); $valid=time(); } sub enigma_out{ $_[0] =~ tr /oruxzmljihbdfaAMGQKEOIYUSWywvtsqpnkgcC ZeX9V857T46R3PN2LJ1HF0DB/A-Z0-9 a-z/; } sub load_registration{ @cookie_jar = split(/; /,$ENV{'HTTP_COOKIE'}); foreach $jar (@cookie_jar){ @recipe = split (/=/,$jar); $key = $recipe[0]; $cook_type{$key}= $recipe[1]; } %raw_data = split (/&/,$cook_type{'regist'}); foreach $raw_key (keys %raw_data){ $key = $raw_key; $key =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg; &enigma_out($key); $raw_data{$raw_key} =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack ("C", hex ($1))/eg; &enigma_out($raw_data{$raw_key}); $cookin_data{$key} = $raw_data{$raw_key}; } } sub parse_form { # link is after the ? passed from .html $link = "$ENV{QUERY_STRING}"; # Get the input read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Split the name-value pairs @pairs = split(/&/, $data); foreach $pair (@pairs){ ($name, $value) = split(/=/, $pair); $name =~ tr/+/ /; $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///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 'replyto' || $name eq 'realname' || $name eq 'redirect' || $name eq 'bgcolor' || $name eq 'background' || $name eq 'link_color' || $name eq 'vlink_color' || $name eq 'text_color' || $name eq 'title' || $name eq 'return_link_title' || $name eq 'return_link_url') { $CONFIG{$name} = $value; } elsif ($name eq 'required') { @required = split(/,/,$value); } elsif ($name eq 'env_report') { @env_report = split(/,/,$value); } else { if ($FORM{$name}) { $FORM{$name} = "$FORM{$name}, $value"; } else { $FORM{$name} = $value; } } } } sub check_required { foreach $require (@required) { if ($require eq 'recipient' || $require eq 'subject' || $require eq 'replyTo' || $require eq 'realname' || $require eq 'redirect' || $require eq 'bgcolor' || $require eq 'background' || $require eq 'link_color' || $require eq 'vlink_color' || $require eq 'text_color' || $require eq 'title' || $require eq 'return_link_title' || $require eq 'return_link_url') { if (!($CONFIG{$require}) || $CONFIG{$require} eq ' ') { push(@ERROR,$require); } } elsif (!($FORM{$require}) || $FORM{$require} eq ' ') { push(@ERROR,$require); } } if (@ERROR) { &error('missing_fields', @ERROR); } } sub return_html { if ($CONFIG{'redirect'} =~ /http\:\/\/.*\..*/) { # If the redirect option of the form contains a valid url, # print the redirectional location header. print "Location: $CONFIG{'redirect'}\n\n"; } else { print "Content-type: text/html\n\n"; print "\n \n"; print " \n \n "; ############################################################ # print"Emission Control, ltd. - Information and Sample Request Form print"Emission Control, ltd. - Information Request Form

Emission Control, ltd. - Information Request Form

"; #

Emission Control, ltd. - Information and Sample Request Form

"; print"
Please fill in all the required (*)fields of this form."; print"Use the TAB key and SHIFT & TAB to navigate between boxes.

"; print"Press the *Submit* button when you are done and your request will be processed.


"; print"
"; print"
*First & Last Name:
*Company:
*Mailing address:
*City:
*State:
*Zip:
*Country:
*Telephone number:
*e-mail address:


"; #
#
# Engineering samples are available for evaluation! # #
#
# # What products are you interested in? # #

#
# # # # # # # #
# # I would like information on Emission Control products.
# Please send an engineering catalog.
# Please have someone call me as soon as possible!
# "; #
Optionally, enter any comments:
print "
Please enter the specific information you are requesting:



"; ########################################################## # Check for a Return Link if ($CONFIG{'return_link_url'} =~ /http\:\/\/.*\..*/ && $CONFIG{'return_link_title'}) { print "\n"; } } sub error { ($error,@error_fields) = @_; print "Content-type: text/html\n\n"; if ($error eq 'bad_referer') { print "\n \n Bad Referrer - Access Denied\n \n"; print " \n
\n

Bad Referrer - Access Denied

\n
\n"; print "The form that is trying to use this FormMail Program\n"; print "resides at: $ENV{'HTTP_REFERER'}, which is not allowed to access this cgi script.

\n"; print "Sorry!\n"; print "\n"; } elsif ($error eq 'missing_fields') { print "\n \n Error: Blank Fields\n \n"; print " \n \n

\n"; print "

Error: Blank Fields

\n\n"; print "The following fields were left blank in your submission form:

\n"; # Print Out Missing Fields in a List. print "

    \n"; foreach $missing_field (@error_fields) { print "
  • $missing_field\n"; } print "
\n"; # Provide Explanation for Error and Offer Link Back to Form. print "


\n"; print "These fields must be filled out before you can successfully submit\n"; print "the form. Please return to the Fill Out Form and try again.\n"; print "\n"; } exit; }