#!/usr/bin/perl ############################################################# ################## YFORM.CGI version 1.9 ################# ############################################################# # Modified Friday, 8/24/2001 Ashley Bass (abass@iname.com) # # Added Matt's v1.9 security updates. Fixed bug with '0' not accepted in required fields. # # This is a modified version of Donald E. Killen's xFormMail.cgi script # which is itself a modified version of Matthew M. Wright's FormMail.pl script. # As with their work, this script is made available freely to anyone who can use it. # By using this code you agree to indemnify Ashley B. Bass from any liability that # might arise from its use. # # FormMail.pl sends an email response from an HTML form to a specified email address. # xFormMail.cgi sends a courtesy reply email to the person who filled out the form. # YFORM.CGI further lets you # 1) specify more options for email, courtesy reply, and HTML response page # 2) chose whether or not to send the courtesy reply # 3) chose whether or not to save all form submissions to a text file on your sever # # The places where I added/changed something are introduced by an "ASHLEY:" comment. # See the YFORM.TXT file for a list of my added fields and instructions on their use. That same # file contains the full readme information for FormMail.pl ver 1.6 as well. # # If you obtained this script without the reference materials that go with it, please DL the # entire YFORM.ZIP archive currently available at www.fyi.net/~abass/domino/free.htm # before emailing me with any questions. Therein you will find the YFORM.TXT file and # a SAMPFORM.HTM file to build on. Thanks. # ############################################################################# # xFormMail.cgi 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.9 # # Copyright 1995-2001 Matt Wright mattw@worldwidemart.com # # Created 06/09/95 Last Modified 08/03/01 # # Matt's Script Archive, Inc.: http://www.worldwidemart.com/scripts/ # ############################################################################## # COPYRIGHT NOTICE # # Copyright 1995-2001 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 its 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 # ############################################################################## # ACCESS CONTROL FIX: Peter D. Thompson Yezek # # http://www.securityfocus.com/archive/1/62033 # ############################################################################## # Define Variables # Detailed Information found In YFORM.TXT 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. # ASHLEY: Place 'file:///' in the list to allow you to test your forms from your # PC without having to upload them to your sever every time you change them. #@referers = ('fyi.net','sewickley.org'); @referers = ('fyi.net','sewickley.org','file:///'); # @recipients defines the e-mail addresses or domain names that e-mail can # # be sent to. This must be filled in correctly to prevent SPAM and allow # # valid addresses to receive e-mail. Read the documentation to find out how # # this variable works!!! It is EXTREMELY IMPORTANT. # @recipients = @referers; # ACCESS CONTROL FIX: Peter D. Thompson Yezek # # @valid_ENV allows the sysadmin to define what environment variables can # # be reported via the env_report directive. This was implemented to fix # # the problem reported at http://www.securityfocus.com/bid/1187 # @valid_ENV = ('REMOTE_HOST','REMOTE_ADDR','REMOTE_USER','HTTP_USER_AGENT'); # Done # ##### END of variable declarations #### # Check Referring URL &check_url; # Retrieve Date &get_date; # Parse Form Contents &parse_form; # Check Required Fields &check_required; # Send E-Mail &send_mail; # Courtesy E-Mail to Visitor &send_courtesy; # Return HTML Page or Redirect User &return_html; #ASHLEY #Append Database &appendit; sub check_url { # Localize the check_referer flag which determines if user is valid. # local($check_referer) = 0; # If a referring URL was specified, for each valid referer, make sure # # that a valid referring URL was passed to FormMail. # if ($ENV{'HTTP_REFERER'}) { foreach $referer (@referers) { # ASHLEY: The second line below allows you to test your forms from # your pc without having to put them on your server if 'file:///' # is listed in the referer variable above. # if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$referer|i) { if ($ENV{'HTTP_REFERER'} =~ /$referer/i) { $check_referer = 1; last; } } } else { $check_referer = 1; } # If the HTTP_REFERER was invalid, send back an error. # if ($check_referer != 1) { &error('bad_referer') } } sub get_date { # Define arrays for the day of the week and month of the year. # @days = ('Sunday','Monday','Tuesday','Wednesday', 'Thursday','Friday','Saturday'); @months1 = ('1','2','3','4','5','6','7','8','9','10','11','12'); @months2 = ('January','February','March','April','May','June','July', 'August','September','October','November','December'); # Get the current time and format the hour, minutes and seconds. Add # # 1900 to the year to get the full 4 digit year. # ($sec,$min,$hour,$mday,$mon,$year,$year2,$wday) = (localtime(time))[0,1,2,3,4,5,5,6]; #$time = sprintf("%02d:%02d:%02d",$hour,$min,$sec); $time = sprintf("%02d:%02d",$hour,$min); $year2 += 1900; # Format the date. # $dater = "$days[$wday], $months2[$mon] $mday, $year2 at $time"; # ASHLEY: I use the short $date for the email and database, Matts' long one for HTML response # $date = "$months1[$mon]/$mday/$year2"; } sub parse_form { # Define the configuration associative array. # %Config = ('mail_recipient','', 'mail_subject','', # ASHLEY: I don't use 'email' and 'realname' as config fields as I want # them to appear in all my responses from this script without bothering # with the 'print_config' field; # 'email','', 'realname','', # ASHLEY: ############################# 'mail_top','', 'mail_listfields','', 'mail_bottom','', 'cour_send','', 'cour_top','', 'cour_listfields','', 'cour_bottom','', 'cour_close','', 'cour_myname','', 'cour_myemail','', 'cour_mywebsite','', 'cour_subject','', 'html_title','', 'html_top','', 'html_listfields','', 'html_bottom','', 'html_redirect','', 'html_return_link_title','', 'html_return_link_url','', 'data_filename','', 'data_fields_to_log','', 'data_env_to_log','', 'data_delimiter','', 'data_listvertical','', ####################################### 'bgcolor','', 'background','', 'link_color','', 'vlink_color','', 'text_color','', 'alink_color','', 'sort','', 'print_config','', 'required','', 'env_report','', 'print_blank_fields','', 'missing_fields_redirect',''); # Determine the form's REQUEST_METHOD (GET or POST) and split the form # # fields up into their name-value pairs. If the REQUEST_METHOD was # # not GET or POST, send an error. # 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');} # For each name-value pair: # foreach $pair (@pairs) { # Split the pair up into individual variables. # ($name, $value) = split(/=/, $pair); # Decode the form encoding on the name and value variables. # $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 # aren't a security risk if the html gets returned. Another # security hole plugged up. $value =~ s///g; # If the field name has been specified in the %Config array, it will # # return a 1 for defined($Config{$name}}) and we should associate # # this value with the appropriate configuration variable. If this # # is not a configuration form field, put it into the associative # # array %Form, appending the value with a ', ' if there is already a # # value present. We also save the order of the form fields in the # # @Field_Order array so we can use this order for the generic sort. # if (defined($Config{$name})) { $Config{$name} = $value; } else { if ($Form{$name} && $value) { $Form{$name} = "$Form{$name}, $value"; } # elsif ($value) { else { push(@Field_Order,$name); $Form{$name} = $value; } } } # The next six lines remove any extra spaces or new lines from the # # configuration variables, which may have been caused if your editor # # wraps lines after a certain length or if you used spaces between field # # names or environment variables. # $Config{'required'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $Config{'required'} =~ s/(\s+)?\n+(\s+)?//g; $Config{'env_report'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $Config{'env_report'} =~ s/(\s+)?\n+(\s+)?//g; $Config{'data_env_to_log'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $Config{'data_env_to_log'} =~ s/(\s+)?\n+(\s+)?//g; $Config{'print_config'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $Config{'print_config'} =~ s/(\s+)?\n+(\s+)?//g; # Split the configuration variables into individual field names. # @Required = split(/,/,$Config{'required'}); @Env_Report = split(/,/,$Config{'env_report'}); @Data_env_to_log = split(/,/,$Config{'data_env_to_log'}); @Print_Config = split(/,/,$Config{'print_config'}); # ACCESS CONTROL FIX: Only allow ENV variables in @valid_ENV in # # @Env_Report for security reasons. # foreach $env_item (@Env_Report) { foreach $valid_item (@valid_ENV) { if ( $env_item eq $valid_item ) { push(@temp_array, $env_item) } } } @Env_Report = @temp_array; } sub check_required { # Localize the variables used in this subroutine. # local($require, @error); if ($Config{'subject'} =~ /(\n|\r)/m || $Config{'mail_recipient'} =~ /(\n|\r)/m) { &error('no_recipient'); } if(!$Config{'mail_recipient'} eq '') { if (!$Config{'mail_recipient'}) { if (!defined(%Form)) { &error('bad_referer') } else { &error('no_recipient') } } else { # This block of code requires that the recipient address end with # # a valid domain or e-mail address as defined in @recipients. # $valid_recipient = 0; foreach $send_to (split(/,/,$Config{'mail_recipient'})) { foreach $mail_recipient (@recipients) { if ($send_to =~ /$mail_recipient$/i) { push(@send_to,$send_to); last; } } } if ($send_to < 0) { &error('no_recipient') } $Config{'mail_recipient'} = join(',',@send_to); } } # For each require field defined in the form: # foreach $require (@Required) { # ASHLEY: I couldn't get the missing_fields error to fire if there was only a # space character in a required field so I added the next line and all is well. $Form{$require} =~ s/^\s*//; # If it is a regular form field which has not been filled in or # # filled in with a space, flag it as an error field. # if ($Form{$require} eq '') { push(@error,$require); } # If the required field is the email field, the syntax of the email # # address if checked to make sure it passes a valid syntax. # elsif ($require eq 'email' && !&check_email($Form{$require})) { push(@error,$require); } # Otherwise, if the required field is a configuration field and it # # has no value or has been filled in with a space, send an error. # elsif (defined($Config{$require})) { if (!$Config{$require}) { push(@error,$require); } } } # If any error fields have been found, send error message to the user. # if (@error) { &error('missing_fields', @error) } } sub send_mail { if(!$Config{'mail_recipient'} eq '') { # Localize variables used in this subroutine. # local($print_config,$key,$sort_order,$sorted_field,$env_report); # Open The Mail Program open(MAIL,"|$mailprog -t"); print MAIL "To: $Config{'mail_recipient'}\n"; # print MAIL "From: $Config{'email'} ($Config{'name'})\n"; # ASHLEY: I prefer to have the email address and realname always returned. # I had to change 'Config' to 'Form' here as these fields are no longer in # the Config array established in the parse_form subroutine earlier print MAIL "From: $Form{'email'} ($Form{'name'})\n"; # Check for Message Subject if ($Config{'mail_subject'}) { print MAIL "Subject: $Config{'mail_subject'}\n\n" } else { print MAIL "Subject: WWW Form Submission\n\n" } # ASHLEY: I don't want the following in my emails to myself. # print MAIL "Below is the result of your feedback form. It was submitted by\n"; # print MAIL "$Config{'realname'} ($Config{'email'}) on $date\n"; # print MAIL "-" x 75 . "\n\n"; # ASHLEY: Here is the mailtp text which can be # specified by the form developer; it appears above the field list. if ($Config{'mail_top'}) {print MAIL "$Config{'mail_top'}\n\n"} print MAIL "date: $date\n"; if (@Print_Config) { foreach $print_config (@Print_Config) { if ($Config{$print_config}) {print MAIL "$print_config: $Config{$print_config}\n";} } } if ($Config{'mail_listfields'}) { # Sort alphabetically if specified: # # ASHLEY: This will PRINT_BLANK_FIELDS for the TEXT,TEXTAREA,PASSWORD # fields only. If you want full blank_field control, use sort/order: if ($Config{'sort'} eq 'alphabetic') { foreach $field (sort keys %Form) { # If the field has a value or the print blank fields option # # is turned on, print out the form field and value. # if ($Config{'print_blank_fields'} || $Form{$field} || $Form{$field} eq '0') { print MAIL "$field: $Form{$field}\n"; } } } # If a sort order is specified, sort the form fields based on that. # THIS IS THE ONLY SORTING CHOICE THAT WILL PRINT_BLANK_FIELDS FOR # THE INPUTS OF RADIO, CHECKBOX, OR SELECT. elsif ($Config{'sort'} =~ /^order:.*,.*/) { # Put Config(sort) into array so it is clean for other routines. # Remove extraneous line breaks and spaces, remove the order: # # directive and split the sort fields into an array. # $sort_order = $Config{'sort'}; $sort_order =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $sort_order =~ s/(\s+)?\n+(\s+)?//g; $sort_order =~ s/order://; @sorted_fields = split(/,/, $sort_order); # For each sorted field, if it has a value or the print blank # # fields option is turned on print the form field and value. # foreach $sorted_field (@sorted_fields) { if ($Config{'print_blank_fields'} || $Form{$sorted_field} || $Form{$sorted_field} eq '0') { print MAIL "$sorted_field: $Form{$sorted_field}\n"; } } } # Otherwise, default to the order in which the fields were sent. # # ASHLEY: This will PRINT_BLANK_FIELDS for the TEXT,TEXTAREA,PASSWORD # fields only. If you want full blank_field control, use sort/order: # else { # For each form field, if it has a value or the print blank # # fields option is turned on print the form field and value. # foreach $field (@Field_Order) { if ($Config{'print_blank_fields'} || $Form{$field} || $Form{$field} eq '0') { print MAIL "$field: $Form{$field}\n"; } } } } # Send any specified Environment Variables to recipient. # foreach $env_report (@Env_Report) { if ($ENV{$env_report}) { print MAIL "$env_report: $ENV{$env_report}\n"; } } # ASHLEY: Here is the mailbottom text which can be # specified by the form developer; it appears below the field list. if ($Config{'mail_bottom'}) {print MAIL "\n$Config{'mail_bottom'}\n"} close (MAIL); } } sub check_email { # Initialize local email variable with input to subroutine. # $email = $_[0]; # If the e-mail address contains: # if ($email =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ || # the e-mail address contains an invalid syntax. Or, if the # # syntax does not match the following regular expression pattern # # it fails basic syntax verification. # $email !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z0-9]+)(\]?)$/) { # Basic syntax requires: one or more characters before the @ sign, # # followed by an optional '[', then any number of letters, numbers, # # dashes or periods (valid domain/IP characters) ending in a period # # and then 2 or 3 letters (for domain suffixes) or 1 to 3 numbers # # (for IP addresses). An ending bracket is also allowed as it is # # valid syntax to have an email address like: user@[255.255.255.0] # # Return a false value, since the e-mail address did not pass valid # # syntax. # return 0; } else { # Return a true value, e-mail verification passed. # return 1; } } # Send courtesy reply email to the visitor. sub send_courtesy { if ($Config{'cour_send'}) { # ASHLEY: syntax check for submitted email so that # you don't have to make this field required. if ($Form{'email'} && &check_email($Form{'email'})) { open (MAIL,"|$mailprog -t"); print MAIL "To: $Form{'email'} ($Form{'name'})\n"; print MAIL "From: $Config{'cour_myemail'} ($Config{'cour_myname'})\n"; if ($Config{'cour_subject'}) { print MAIL "Subject: Thanks for your $Config{'cour_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 "the `$Config{'cour_subject'}` form.\n\n";} else {print MAIL "a WWW form.\n\n";} # ASHLEY: The following fields are for customizing the courtesy reply if ($Config{'cour_top'}) {print MAIL "$Config{'cour_top'}\n\n";} if ($Config{'cour_listfields'}) { # Sort alphabetically if specified: # # ASHLEY: This will PRINT_BLANK_FIELDS for the TEXT,TEXTAREA,PASSWORD # fields only. If you want full blank_field control, use sort/order: # if ($Config{'sort'} eq 'alphabetic') { foreach $field (sort keys %Form) { # If the field has a value or the print blank fields option # # is turned on, print out the form field and value. # if ($Config{'print_blank_fields'} || $Form{$field} || $Form{$field} eq '0') { print MAIL "$field: $Form{$field}\n"; } } } # If a sort order is specified, sort the form fields based on that. # # If a sort order is specified, sort the form fields based on that. # THIS IS THE ONLY SORTING CHOICE THAT WILL PRINT_BLANK_FIELDS FOR # THE INPUTS OF RADIO, CHECKBOX, OR SELECT. elsif ($Config{'sort'} =~ /^order:.*,.*/) { # Put Config(sort) into array so it is clean for other routines. # Remove extraneous line breaks and spaces, remove the order: # # directive and split the sort fields into an array. # $sort_order = $Config{'sort'}; $sort_order =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $sort_order =~ s/(\s+)?\n+(\s+)?//g; $sort_order =~ s/order://; @sorted_fields = split(/,/, $sort_order); # For each sorted field, if it has a value or the print blank # # fields option is turned on print the form field and value. # foreach $sorted_field (@sorted_fields) { if ($Config{'print_blank_fields'} || $Form{$sorted_field} || $Form{$sorted_field} eq '0') { print MAIL "$sorted_field: $Form{$sorted_field}\n"; } } } # Otherwise, default to the order in which the fields were sent. # # ASHLEY: This will PRINT_BLANK_FIELDS for the TEXT,TEXTAREA,PASSWORD # fields only. If you want full blank_field control, use sort/order: # else { # For each form field, if it has a value or the print blank # # fields option is turned on print the form field and value. # foreach $field (@Field_Order) { if ($Config{'print_blank_fields'} || $Form{$field} || $Form{$field} eq '0') { print MAIL "$field: $Form{$field}\n"; } } } print MAIL "\n"; } if ($Config{'cour_bottom'}) {print MAIL "$Config{'cour_bottom'}\n";} if ($Config{'cour_close'}) {print MAIL "\n$Config{'cour_close'}";} else {print MAIL "\n\nRegards,";} if ($Config{'cour_myname'}) {print MAIL "\n$Config{'cour_myname'}";} if ($Config{'cour_myemail'}) {print MAIL "\n$Config{'cour_myemail'}";} if ($Config{'cour_mywebsite'}) {print MAIL "\n$Config{'cour_mywebsite'}";} close (MAIL); } } } sub return_html { local($print_config,$key,$sort_order,$sorted_field,$env_report); if ($Config{'html_redirect'} =~ /http\:\/\/.*\..*/) { # If the redirect option of the form contains a valid url, # print the redirectional location header. print "Location: $Config{'html_redirect'}\n\n"; } else { print "Content-type: text/html\n\n"; print "\n \n"; # Print out title of page if ($Config{'html_title'}) { print " $Config{'html_title'}\n"; } else {print " Thank You\n";} print " \n \n
\n"; if ($Config{'html_top'}) {print "

$Config{'html_top'}

\n";} else {print "

Thank you for your submission

\n";} if ($Config{'html_listfields'}) { # print "to $Config{'mail_recipient'} on "; print "on "; print "$dater

\n"; # Original Table output to HTML added Don Killen 10/22/96 # Modified by ASHLEY 5/15/98 print "\n"; # Sort alphabetically if specified: # ASHLEY: This will PRINT_BLANK_FIELDS for the TEXT,TEXTAREA,PASSWORD # fields only. If you want full blank_field control, use sort/order: # if ($Config{'sort'} eq 'alphabetic') { foreach $field (sort keys %Form) { $Form{$field} =~ s/\r\n/
/g; # If the field has a value or the print blank fields option # # is turned on, print out the form field and value. # if ($Config{'print_blank_fields'} || $Form{$field} || $Form{$field} eq '0') { print "\n"; print " \n"; print " \n"; print "\n"; } } } # If a sort order is specified, sort the form fields based on that. # THIS IS THE ONLY SORTING CHOICE THAT WILL PRINT_BLANK_FIELDS FOR # THE INPUTS OF RADIO, CHECKBOX, OR SELECT. elsif ($Config{'sort'} =~ /^order:.*,.*/) { # Put Config(sort) into array so it is clean for other routines. # Remove extraneous line breaks and spaces, remove the order: # directive and split the sort fields into an array. $sort_order = $Config{'sort'}; $sort_order =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $sort_order =~ s/(\s+)?\n+(\s+)?//g; $sort_order =~ s/order://; @sorted_fields = split(/,/, $sort_order); # For each sorted field, if it has a value or the print blank # # fields option is turned on print the form field and value. # foreach $sorted_field (@sorted_fields) { $holder = $Form{$sorted_field}; $holder =~ s/\r\n/
/g; if ($Config{'print_blank_fields'} || $Form{$sorted_field} || $Form{$sorted_field} eq '0') { print "\n"; print " \n"; # print " \n"; print " \n"; print "\n"; } } } # Otherwise, default to the order in which the fields were sent. # # ASHLEY: This option will PRINT_BLANK_FIELDS for TEXT and TEXTAREA # fields only. If you want full blank_field control, use sort/order: # else { # For each form field, if it has a value or the print blank # # fields option is turned on print the form field and value. # foreach $field (@Field_Order) { $Form{$field} =~ s/\r\n/
/g; if ($Config{'print_blank_fields'} || $Form{$field} || $Form{$field} eq '0') { print "\n"; print " \n"; print " \n"; print "\n"; } } } print "
$field:$Form{$field}
$sorted_field:$Form{$sorted_field}$holder
$field:$Form{$field}

\n"; print "

\n"; } if ($Config{'html_bottom'}) {print "

$Config{'html_bottom'}


\n"; } # Check for a Return Link if ($Config{'html_return_link_url'} =~ /http\:\/\/.*\..*/ && $Config{'html_return_link_title'}) { # print "
\n"; # print "\n"; # print "
\n"; print "\n"; print "$Config{'html_return_link_title'}\n"; print "\n"; } print "\n"; } } # ASHLEY: The code to write form submissions to a text file on your server # This feature ONLY WORKS IF you specify fields in the "data_fields_to_log" # and/or "data_env_to_log" in your form config. sub appendit { # Localize variables used in this subroutine. # local($sort_order,$sort_env,$sorted_field,$sorted_env); if ($Config{'data_fields_to_log'} || $Config{'data_env_to_log'}) { if ($Config{'data_filename'}) { if (-w $Config{'data_filename'}) { &lockit ("$Config{'data_filename'}.lock"); open (Database, ">>$Config{'data_filename'}"); # Put Config(data_fields_to_log) into array. # For each field, replace all Return codes in fields (unless Vertical listing) # with ¶ (alt+0182)to avoid line breaks within our database # rows and then print the form field and value. $sort_order = $Config{'data_fields_to_log'}; $sort_order =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $sort_order =~ s/(\s+)?\n+(\s+)?//g; @sorted_fields = split(/,/, $sort_order); print Database "$date"; print Database "$Config{'data_delimiter'}"; #use this only if loggin date AND time print Database "$time"; foreach $sorted_field (@sorted_fields) { $holder = $Form{$sorted_field}; if ($Config{'data_listvertical'}) { print Database "\n$sorted_field: $holder"; ### the line above writes empty fields; the line below does not #### #if ($Form{$sorted_field}) {print Database "\n$sorted_field: $holder";} } else { $holder =~ s/\r\n/¶/g; print Database "$Config{'data_delimiter'}$holder"; } } foreach $sorted_envfield (@Data_env_to_log) { $holder = $ENV{$sorted_envfield}; if ($Config{'data_listvertical'}) { print Database "\n$sorted_envfield: $holder"; ### the line above writes empty fields; the line below does not #### #if ($Form{$sorted_envfield}) {print Database "\n$sorted_field: $holder";} } else { $holder =~ s/\r\n/¶/g; print Database "$Config{'data_delimiter'}$holder"; } } if ($Config{'data_listvertical'}) {print Database "\n\n==============================\n\n";} else {print Database "\n"; } close (Database); &unlockit ("$Config{'data_filename'}.lock"); } } } } # ASHLEY: A required routine for the database append feature 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__); } # ASHLEY: Another required routine for the database append feature sub unlockit { local ($lock_file) = @_; close(LOCK_FILE); unlink($lock_file); } # ASHLEY: Another required routine for the database append feature 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.") } sub error { # Localize variables and assign subroutine input. # local($error,@error_fields) = @_; local($host,$missing_field,$missing_field_list); if ($error eq 'bad_referer') { if ($ENV{'HTTP_REFERER'} =~ m|^https?://([\w\.]+)|i) { $host = $1; print "Content-type: text/html\n\n"; print <<"(END ERROR HTML)"; Bad Referrer - Access Denied
Bad Referrer - Access Denied
The form attempting to use YFORM.CGI resides at $ENV{'HTTP_REFERER'}, which is not allowed to access this cgi script.

If you are attempting to configure YFORM.CGI to run with this form, you need to add the following to \@referers, explained in detail in the YFORM.TXT file.

Add '$host' to your \@referers array.

(END ERROR HTML) } else { print <<"(END ERROR HTML)"; Content-type: text/html YFORM.CGI ver 1.9
YFORM.CGI
Ashley Bass
Version 1.9 - Released Saturday, 8/25/01
(END ERROR HTML) } } elsif ($error eq 'request_method') { print <<"(END ERROR HTML)"; Content-type: text/html Error: Request Method
Error: Request Method
The Request Method of the Form you submitted did not match either GET or POST. Please check the form and make sure the method= statement is in upper case and matches GET or POST.

(END ERROR HTML) } elsif ($error eq 'no_recipient') { print "Content-type: text/html\n\n"; print <<"(END ERROR HTML)"; Error: Invalid Recipient Email Address
Error: Invalid Recipient Email Address
The Recipient specified in the data sent to the YFORM script is invalid. Please make sure you have filled in the 'recipient' form field with a valid email address that is allowed to use the YFORM script. More information on filling in Recipient form fields can be found in the YFORM.TXT file.
(END ERROR HTML) } elsif ($error eq 'missing_fields') { if ($Config{'missing_fields_redirect'}) { print "Location: $Config{'missing_fields_redirect'}\n\n"; } else { foreach $missing_field (@error_fields) { $missing_field_list .= "
  • $missing_field\n"; } print "Content-type: text/html\n\n"; print <<"(END ERROR HTML)"; Error: Invalid Submission
    Error: Invalid Submission
    The following required field(s) were invalid or blank in your submission form:
      $missing_field_list
    These fields must be filled in before you can successfully submit the form.

    Please use your browser's back button to return to the form.

    (END ERROR HTML) } } exit; } sub body_attributes { # Check for Background Color if ($Config{'bgcolor'}) { print " bgcolor=\"$Config{'bgcolor'}\"" } # Check for Background Image if ($Config{'background'}) { print " background=\"$Config{'background'}\"" } # Check for Link Color if ($Config{'link_color'}) { print " link=\"$Config{'link_color'}\"" } # Check for Visited Link Color if ($Config{'vlink_color'}) { print " vlink=\"$Config{'vlink_color'}\"" } # Check for Active Link Color if ($Config{'alink_color'}) { print " alink=\"$Config{'alink_color'}\"" } # Check for Body Text Color if ($Config{'text_color'}) { print " text=\"$Config{'text_color'}\"" } }