#!/usr/bin/perl # # YFORM.cgi # # # Modified Version 1/29/97 Ashley Bass (abass@fyi.net) # # NEW: # I added to Don Killen's 10/22/96 mods of courtesy email so that the form could # decide whether or not to send the courtesy, and the form could decide whether or not # to append submisisons to a database file. This new version meets my needs for form-email # and is admittedly not 100% robust. I hope that it helps you. # yada, yada, yada: # By using this code you agree to indemnify Ashley Bass from any# # liability arising from it's use. You also agree to the conditions outlined below.# # # Modified Version 1.0 # # Modifications Copyright (c) 1996 Donald E. Killen, All Rights Reserved. # # This version of FormMail may be used and modified free of charge by anyone # # so long as this copyright notice and the one below by Matthew Wright remain# # intact. By using this code you agree to indemnify Donald E. Killen from any# # liability arising from it's use. You also agree that this code cannot be # # sold to any third party without prior written consent of both Don Killen # # and Matthew M. Wright. # # # ############################################################################## # FormMail Version 1.5 # # Copyright 1996 Matt Wright mattw@worldwidemart.com # # Created 6/9/95 Last Modified 1/29/97 # # Scripts Archive at: http://www.worldwidemart.com/scripts/ # ############################################################################## # # COPYRIGHT NOTICE # # Copyright 1996 Matthew M. Wright All Rights Reserved. # # # # FormMail may be used and modified free of charge by anyone so long as this # # copyright notice and the comments above remain intact. By using this # # code you agree to indemnify Matthew M. Wright from any liability that # # might arise from it's use. # # # # Selling the code for this program without prior written consent is # # expressly forbidden. In other words, please ask first before you try and # # make money off of my program. # # # # Obtain permission before redistributing this software over the Internet or # # in any other medium. In all cases copyright and header must remain intact # ############################################################################## # Define Variables # Detailed Information Found In README File. # $mailprog defines the location of your sendmail program on your unix # system. $mailprog = '/usr/lib/sendmail'; # @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.nauticom.net','file:///'); ##### END of variable declarations #### # Check Referring URL &check_url; # Retrieve Date &get_date; # Parse Form Contents &parse_form; # Check Required Fields &check_required; # Return HTML Page or Redirect User &return_html; # Courtesy E-Mail to Visitor &send_courtesy; # Send E-Mail &send_mail; #Append Database &appendit; ##### MAIN ends here (only subroutines follow)############################# ############################################################################# 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 = ('1','2','3','4','5','6','7', '8','9','10','11','12'); ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); if ($hour < 10) { $hour = "0$hour"; } if ($min < 10) { $min = "0$min"; } if ($sec < 10) { $sec = "0$sec"; } # Ashley: I use the short $date for the email and database, the long for HTML response # $dater = "$days[$wday], $months[$mon]/$mday/$year at $hour\:$min"; $date = "$months[$mon]/$mday/$year"; } ############################################################################# sub parse_form { if ($ENV{'REQUEST_METHOD'} eq 'GET') { # Split the name-value pairs @pairs = split(/&/, $ENV{'QUERY_STRING'}); } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { # Get the input read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); # Split the name-value pairs @pairs = split(/&/, $buffer); } else { &error('request_method'); } 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 'redirect' || $name eq 'bgcolor' || $name eq 'background' || $name eq 'link_color' || $name eq 'vlink_color' || $name eq 'text_color' || $name eq 'alink_color' || $name eq 'title' || $require eq 'data' || $name eq 'weare' || $name eq 'callat' || $name eq 'sort' || $name eq 'return_link_title' || $name eq 'return_link_url' && ($value)) { $CONFIG{$name} = $value; } elsif ($name eq 'required') { @required = split(/,/,$value); } elsif ($name eq 'env_report') { @env_report = split(/,/,$value); } else { if ($FORM{$name} && ($value)) { $FORM{$name} = "$FORM{$name}, $value"; } elsif ($value) { $FORM{$name} = $value; } } } } ############################################################################# sub check_required { foreach $require (@required) { if ($require eq 'recipient' || $require eq 'subject' || $require eq 'redirect' || $require eq 'bgcolor' || $require eq 'background' || $require eq 'link_color' || $require eq 'vlink_color' || $require eq 'alink_color' || $require eq 'text_color' || $require eq 'sort' || $require eq 'data' || $require eq 'title' || $name eq 'weare' || $name eq 'callat' || $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 out title of page if ($CONFIG{'title'}) { print " $CONFIG{'title'}\n"; } else { print " Thank You\n"; } print " \n
Make your own free website on Tripod.com
\n
\n"; if ($FORM{'thanka'}) { #Ashley: Print Top line in

# print "

$FORM{'thanka'}

\n"; } else { print "

Thank You For Filling Out This Form

\n"; } # Check for a Return Link if ($CONFIG{'return_link_url'} =~ /http\:\/\/.*\..*/ && $CONFIG{'return_link_title'}) { print "
\n"; print "\n"; print "
"; } print "Below is what you submitted to $CONFIG{'recipient'} on "; print "$dater


\n"; # Table output to HTML added Don Killen 10/22/96 print ""; #Ashley: I always require Name and Email # # print ""; print "\n"; } } print "
Id:$CONFIG{'name'} at $CONFIG{'email'}\n\n"; if ($CONFIG{'sort'} =~ /^order:.*,.*/) { $sort_order = $CONFIG{'sort'}; $sort_order =~ s/order://; @sorted_fields = split(/,/, $sort_order); foreach $sorted_field (@sorted_fields) { # Print the name and value pairs in FORM array to html. if ($FORM{$sorted_field}) { print "
$sorted_field:$FORM{$sorted_field}

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

\n"; print "\n"; } } ############################################################################# sub send_mail { # Open The Mail Program open(MAIL,"|$mailprog -t"); print MAIL "To: $CONFIG{'recipient'}\n"; print MAIL "From: $FORM{'email'} ($FORM{'name'})\n"; # Check for Message Subject if ($CONFIG{'subject'}) { print MAIL "Subject: $CONFIG{'subject'}\n\n"; } else { print MAIL "Subject: WWW Form Submission\n\n"; } print MAIL "date: $date\n"; if ($CONFIG{'sort'} eq 'alphabetic') { foreach $key (sort keys %FORM) { # Print the name and value pairs in FORM array to mail. print MAIL "$key: $FORM{$key}\n\n"; } } elsif ($CONFIG{'sort'} =~ /^order:.*,.*/) { $CONFIG{'sort'} =~ s/order://; @sorted_fields = split(/,/, $CONFIG{'sort'}); foreach $sorted_field (@sorted_fields) { # Print the name and value pairs in FORM array to mail. if ($FORM{$sorted_field}) { print MAIL "$sorted_field: $FORM{$sorted_field}\n"; } } } else { foreach $key (keys %FORM) { # Print the name and value pairs in FORM array to html. print MAIL "$key: $FORM{$key}\n\n"; } } # Send Any Environment Variables To Recipient. foreach $env_report (@env_report) { print MAIL "$env_report: $ENV{$env_report}\n"; } close (MAIL); } #######Append to a Database file code by Ashley Bass 1/29/97 ##################### sub appendit { if ($FORM{'appenddatabase'}) { if (-w $FORM{'appenddatabase'}) { &lockit ("$FORM{'appenddatabase'}.lock"); open (DATABASE, ">>$FORM{'appenddatabase'}"); print DATABASE "$date"; foreach $sorted_field (@sorted_fields) { if ($FORM{$sorted_field}) { print DATABASE "$FORM{'delimiter'}$FORM{$sorted_field}"; } else { print DATABASE "$FORM{'delimiter'}"; } } print DATABASE "\n"; close (DATABASE); &unlockit ("$FORM{'appenddatabase'}.lock"); } } } ############################################################################# # Send courtesy email to the visitor thanking him, etc. See individual forms for # content which must be in 'texta' and 'textb' hidden fields. # sub send_courtesy { if ($FORM{'courtesy'}) # if ($courtesy eq "yes") { open (MAIL,"|$mailprog -t"); print MAIL "To: $FORM{'email'} ($FORM{'name'})\n"; print MAIL "From: $CONFIG{'callat'}\n"; if ($CONFIG{'subject'}) { print MAIL "Subject: Thanks for your $CONFIG{'subject'}\n\n"; $subjflag = 1; } else { print MAIL "Subject: Thank you - $date\n\n"; $subjflag = 0; } print MAIL "On $date you responded to "; if ( $subjflag ) { print MAIL "our `$CONFIG{'subject'}` form.\n\n"; } else { print MAIL "a WWW form.\n\n"; } if ($FORM{'texta'}) { print MAIL "$FORM{'texta'}\n"; } if ($FORM{'textb'}) { print MAIL "$FORM{'textb'}\n\n"; } print MAIL "Regards,\n"; print MAIL "$CONFIG{'weare'}\n"; print MAIL "$CONFIG{'callat'}\n"; close (MAIL); } } ############################################################################# 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 'request_method') { print "\n \n Error: Request Method\n \n"; print "\n \n

\n\n"; print "

Error: Request Method

\n
\n\n"; print "The Request Method of the Form you submitted did not match\n"; print "either GET or POST. Please check the form, and make sure the\n"; print "method= statement is in upper case and matches GET or POST.\n"; print "


\n"; print "

\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 "These required 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 "Use your browser's Back button to return to your current form or\n"; print "click here for a blank one.\n"; print "\n"; } exit; } ############################################################################# sub body_attributes { # Check for Background Color and Assorted Other Stuff if ($CONFIG{'bgcolor'}) { print " bgcolor=\"$CONFIG{'bgcolor'}\""; } if ($CONFIG{'background'} =~ /http\:\/\/.*\..*/) { print " background=\"$CONFIG{'background'}\""; } if ($CONFIG{'link_color'}) { print " link=\"$CONFIG{'link_color'}\""; } if ($CONFIG{'vlink_color'}) { print " vlink=\"$CONFIG{'vlink_color'}\""; } if ($CONFIG{'alink_color'}) { print " alink=\"$CONFIG{'alink_color'}\""; } if ($CONFIG{'text_color'}) { print " text=\"$CONFIG{'text_color'}\""; } } ####################################################################### sub lockit { local ($lock_file) = @_; local ($endtime); $endtime = 20; $endtime = time + $endtime; while (-e $lock_file && time < $endtime) { sleep(1); } open(LOCK_FILE, ">$lock_file") || &file_open_error ("$lock_file", "Lock File Routine", __FILE__, __LINE__); } ####################################################################### sub unlockit { local ($lock_file) = @_; close(LOCK_FILE); unlink($lock_file); } ####################################################################### sub file_open_error { local ($bad_file, $script_section, $this_file, $line_number) = @_; print "Content-type: text/html\n\n"; &CgiDie ("I am sorry, but I was not able to access $bad_file.") }