\n"; # If a sort order is specified, sort the form fields based on that. # if ($Config{'sort'} =~ /^order:.*,.*/) { # Set the temporary $sort_order variable to the sorting order, # # 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) { local $sfname = &clean_html($sorted_field); if ($Config{'print_blank_fields'} || $Form{$sorted_field} ne '') { print "$sfname: $Form{$sorted_field}

\n"; } } } # Otherwise, use the order the fields were sent, or alphabetic. # else { # Sort alphabetically if requested. if ($Config{'sort'} eq 'alphabetic') { @Field_Order = sort @Field_Order; } # 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) { local $fname = &clean_html($field); if ($Config{'print_blank_fields'} || $Form{$field} ne '') { print "$fname: $Form{$field}

\n"; } } } print "

\n"; # Check for a Return Link and print one if found. # if ($Config{'return_link_url'} && $Config{'return_link_title'}) { print "

\n"; print "
• $safeConfig{'return_link_title'}\n"; print "\n"; } # Print the page footer. # print <<"(END HTML FOOTER)";

  ---

  FormMail V1.92 © 1995 - 2002 Matt Wright
  A Free Product of Matt's Script Archive, Inc. (END HTML FOOTER) } } sub send_mail { # Localize variables used in this subroutine. # local($print_config,$key,$sort_order,$sorted_field,$env_report); # Open The Mail Program open(MAIL,"|$mailprog"); print MAIL "To: $Config{'recipient'}\n"; print MAIL "From: $Config{'email'} ($Config{'realname'})\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 "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"; if (@Print_Config) { foreach $print_config (@Print_Config) { if ($Config{$print_config}) { print MAIL "$print_config: $Config{$print_config}\n\n"; } } } # If a sort order is specified, sort the form fields based on that. # if ($Config{'sort'} =~ /^order:.*,.*/) { # Remove extraneous line breaks and spaces, remove the order: # # directive and split the sort fields into an array. # local $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} ne '') { print MAIL "$sorted_field: $Form{$sorted_field}\n\n"; } } } # Otherwise, print fields in order they were sent or alphabetically. # else { # Sort alphabetically if specified: # if ($Config{'sort'} eq 'alphabetic') { @Field_Order = sort @Field_Order; } # 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} ne '') { print MAIL "$field: $Form{$field}\n\n"; } } } print MAIL "-" x 75 . "\n\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"; } } 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; } } # This was added into v1.91 to further secure the recipients array. Now, by # # default it will assume that valid recipients include only users with # # usernames A-Z, a-z, 0-9, _ and - that match your domain exactly. If this # # is not what you want, you should read more detailed instructions regarding # # the configuration of the @recipients variable in the documentation. # sub fill_recipients { local(@domains) = @_; local($domain,@return_recips); foreach $domain (@domains) { if ($domain =~ /^\d+\.\d+\.\d+\.\d+$/) { $domain =~ s/\./\\\./g; push(@return_recips,'^[\w\-\.]+\@\[' . $domain . '\]'); } else { $domain =~ s/\./\\\./g; $domain =~ s/\-/\\\-/g; push(@return_recips,'^[\w\-\.]+\@' . $domain); } } return @return_recips; } # This function will convert <, >, & and " to their HTML equivalents. # sub clean_html { local $value = $_[0]; $value =~ s/\&/\&/g; $value =~ s//\>/g; $value =~ s/"/\"/g; return $value; } sub body_attributes { # Check for Background Color if ($Config{'bgcolor'}) { print " bgcolor=\"$safeConfig{'bgcolor'}\"" } # Check for Background Image if ($Config{'background'}) { print " background=\"$safeConfig{'background'}\"" } # Check for Link Color if ($Config{'link_color'}) { print " link=\"$safeConfig{'link_color'}\"" } # Check for Visited Link Color if ($Config{'vlink_color'}) { print " vlink=\"$safeConfig{'vlink_color'}\"" } # Check for Active Link Color if ($Config{'alink_color'}) { print " alink=\"$safeConfig{'alink_color'}\"" } # Check for Body Text Color if ($Config{'text_color'}) { print " text=\"$safeConfig{'text_color'}\"" } } 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; my $referer = &clean_html($ENV{'HTTP_REFERER'}); print <<"(END ERROR HTML)"; Content-type: text/html

  Bad Referrer - Access Denied

  The form attempting to use FormMail resides at $referer, which is not allowed to access this cgi script. If you are attempting to configure FormMail to run with this form, you need to add the following to \@referers, explained in detail in the README file. Add '$host' to your \@referers array. FormMail V1.92 © 1995 - 2002 Matt Wright A Free Product of Matt's Script Archive, Inc.

  (END ERROR HTML) } else { print <<"(END ERROR HTML)"; Content-type: text/html

  FormMail

  Copyright 1995 - 2002 Matt Wright Version 1.92 - Released April 21, 2002 A Free Product of Matt's Script Archive, Inc.

  (END ERROR HTML) } } elsif ($error eq 'request_method') { print <<"(END ERROR HTML)"; Content-type: text/html

  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. FormMail V1.92 © 1995 - 2002 Matt Wright A Free Product of Matt's Script Archive, Inc.

  (END ERROR HTML) } elsif ($error eq 'no_recipient') { print <<"(END ERROR HTML)"; Content-type: text/html

  Error: Bad/No Recipient

  There was no recipient or an invalid recipient specified in the data sent to FormMail. Please make sure you have filled in the recipient form field with an e-mail address that has been configured in \@recipients. More information on filling in recipient form fields and variables can be found in the README file. FormMail V1.92 © 1995 - 2002 Matt Wright A Free Product of Matt's Script Archive, Inc.

  (END ERROR HTML) } elsif ($error eq 'invalid_headers') { print <<"(END ERROR HTML)"; Content-type: text/html

  Error: Bad Header Fields

  The header fields, which include recipient, email, realname and subject were filled in with invalid values. You may not include any newline characters in these parameters. More information on filling in these form fields and variables can be found in the README file. FormMail V1.92 © 1995 - 2002 Matt Wright A Free Product of Matt's Script Archive, Inc.

  (END ERROR HTML) } elsif ($error eq 'missing_fields') { if ($Config{'missing_fields_redirect'}) { print "Location: " . &clean_html($Config{'missing_fields_redirect'}) . "\n\n"; } else { foreach $missing_field (@error_fields) { $missing_field_list .= "
• " . &clean_html($missing_field) . "\n"; } print <<"(END ERROR HTML)"; Content-type: text/html

  Error: Blank Fields

  The following fields were left 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 and try again. FormMail V1.92 © 1995 - 2002 Matt Wright A Free Product of Matt's Script Archive, Inc.

  (END ERROR HTML) } } exit; }