($Config{'ccrecipient'} =~ /\w/ && !recipients_allowed($Config{'ccrecipient'})) { &error('illegal_recipients') } elsif ($recip_list{$Config{'bccrecipient'}}) { $Config{'bccrecipient'} = $recip_list{$Config{'bccrecipient'}}; } elsif ($Config{'bccrecipient'} =~ /\w/ && !recipients_allowed($Config{'bccrecipient'})) { &error('illegal_recipients') } } # For each require field defined in the form: # foreach $require (@Required) { # If the required field is the email field, the syntax of the email # # address if checked to make sure it passes a valid syntax. # if ($require eq 'email' && !&check_email($Config{$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 it is a regular form field which has not been filled in or # # filled in with a space, flag it as an error field. # elsif (!$Form{$require}) { push(@error,$require); } } # If any error fields have been found, send error message to the user. # if (@error) { &error('missing_fields', @error) } } sub convert_chevrons { my ($str) = @_; $str =~ s/\/>/g; return $str; } sub return_html { # Local variables used in this subroutine initialized. # local($key,$sort_order,$sorted_field); # If redirect option is used, print the redirectional location header. # if ($Config{'redirect'}) { print "Location: $Config{'redirect'}\n\n"; } # Otherwise, begin printing the response page. # else { # Print HTTP header and opening HTML tags. # print "Content-type: text/html\n\n"; print "\n \n"; # Print out title of page # if ($Config{'title'}) { print " ".convert_chevrons($Config{'title'})."\n" } else { print " Thank You\n" } print " \n \n
\n"; # Print custom or generic title. # if ($Config{'title'}) { print "

".convert_chevrons($Config{'title'})."

\n" } else { print "

Thank You For Filling Out This Form

\n" } print "
\n"; print "Below is what you submitted to $Config{'recipient'} on "; print "$date

\n"; # Sort alphabetically if specified: # 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}) { print "$field: ".convert_chevrons($Form{$field})."

\n"; } } } # If a sort order is specified, sort the form fields based on that. # elsif ($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) { if ($Config{'print_blank_fields'} || $Form{$sorted_field}) { print "$sorted_field: ".convert_chevrons($Form{$sorted_field})."

\n"; } } } # Otherwise, default to the order in which the fields were sent. # 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}) { print "$field: ".convert_chevrons($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 the page footer. # print <<"(END HTML FOOTER)";

(END HTML FOOTER) } } sub remove_newlines_and_other_nasties { my ($str) = @_; $str =~ s/[\(\)\<\>\015\012\014\177\000]//g; return $str; } sub send_mail { # Localize variables used in this subroutine. # local($print_config,$key,$sort_order,$sorted_field,$env_report); # Open The Mail Program if ($Config{'pgp'} =~ /\w/) { open (MAIL, "|/etc/support/pgpencrypt $Config{'pgp'}"); } elsif ($Config{'pgp_key'} =~ /\w/) { open (MAIL, "|/etc/support/pgpencrypt $Config{'pgp_key'}"); } else { open(MAIL,"|$mailprog -t"); } $Config{'subject'} = remove_newlines_and_other_nasties($Config{'subject'}); $Config{'realname'} = remove_newlines_and_other_nasties($Config{'realname'}); # addresses are now validated before they get this far #$Config{'email'} = validated_email_syntax($Config{'email'}); #$Config{'recipient'} = validated_email_syntax($Config{'recipient'}); #$Config{'ccrecipient'} = validated_email_syntax($Config{'ccrecipient'}); #$Config{'bccrecipient'} = validated_email_syntax($Config{'bccrecipient'}); print MAIL "To: $Config{'recipient'}\n"; if ($Config{'ccrecipient'}) { print MAIL "CC: $Config{'ccrecipient'}\n"; } if ($Config{'bccrecipient'}) { print MAIL "BCC: $Config{'bccrecipient'}\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"; } } } # Sort alphabetically if specified: # 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\n"; } } } # If a sort order is specified, sort the form fields based on that. # elsif ($Config{'sort'} =~ /^order:.*,.*/) { # Remove extraneous line breaks and spaces, remove the order: # # directive and split the sort fields into an array. # $Config{'sort'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g; $Config{'sort'} =~ s/(\s+)?\n+(\s+)?//g; $Config{'sort'} =~ s/order://; @sorted_fields = split(/,/, $Config{'sort'}); # 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\n"; } } } # Otherwise, default to the order in which the fields were sent. # 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\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; } } sub convert_chevrons { my ($str) = @_; $str =~ s/\/>/g; return $str; } sub body_attributes { # Check for Background Color if ($Config{'bgcolor'}) { print " bgcolor=\"".convert_chevrons($Config{'bgcolor'})."\"" } # Check for Background Image if ($Config{'background'}) { print " background=\"".convert_chevrons($Config{'background'})."\"" } # Check for Link Color if ($Config{'link_color'}) { print " link=\"".convert_chevrons($Config{'link_color'})."\"" } # Check for Visited Link Color if ($Config{'vlink_color'}) { print " vlink=\"".convert_chevrons($Config{'vlink_color'})."\"" } # Check for Active Link Color if ($Config{'alink_color'}) { print " alink=\"".convert_chevrons($Config{'alink_color'})."\"" } # Check for Body Text Color if ($Config{'text_color'}) { print " text=\"".convert_chevrons($Config{'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; print <<"(END ERROR HTML)"; Content-type: text/html Bad Referrer - Access Denied

Bad Referrer - Access Denied
The form attempting to use FormMail resides at $ENV{'HTTP_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.9 © 1995 - 2001 Matt Wright
A Free Product of Matt's Script Archive, Inc.
(END ERROR HTML) } else { print <<"(END ERROR HTML)"; Content-type: text/html FormMail v1.9
FormMail
Copyright 1995 - 2001 Matt Wright
Version 1.9 - Released August 3, 2001
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
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.9 © 1995 - 2001 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
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 Medex Direct Ltd.