#!c:\perl\bin\perl
# FORMant 1.5
# includes et vars
$mailprog = '/usr/sbin/sendmail -i -t';
@referers =
('naturalattachment.com','naturalattachment.net','naturalattachment.org','naturalattatchment.com','naturalattatchment.,'insectlabs.com','insectlabs.net','insectlabs.org','midnightrefuge.com','midnightrefuge.net','midnightrefuge.org','sumerland.org');
@recipients = &fill_recipients(@referers);
@valid_ENV =
('REMOTE_HOST','REMOTE_ADDR','REMOTE_USER','HTTP_USER_AGENT','HTTP_REFERER');
&check_url;
&get_date;
&parse_form;
&check_required;
&send_mail;
&return_html;
# Begin Script
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 FORMant.
#
if ($ENV{'HTTP_REFERER'}) {
foreach $referer (@referers) {
if ($ENV{'HTTP_REFERER'} =~ m|https?://([^/]*)$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');
@months = ('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,$wday) =
(localtime(time))[0,1,2,3,4,5,6];
$time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
$year += 1900;
# Format the date.
#
$date = "$days[$wday], $months[$mon] $mday, $year at $time";
}
sub parse_form {
# Define the configuration associative array.
#
%Config = ('recipient','', 'subject','',
'email','', 'realname','',
'redirect','', 'bgcolor','',
'background','', 'link_color','',
'vlink_color','', 'text_color','',
'alink_color','', 'title','',
'sort','', 'print_config','',
'required','', 'env_report','',
'return_link_title','', 'return_link_url','',
'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.
#
local($name, $value) = split(/=/, $pair);
# Decode the form encoding on the name and value variables.
#
# v1.92: remove null bytes
#
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$name =~ tr/\0//d;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/\0//d;
# 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} ne '') {
$Form{$name} = "$Form{$name}, $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{'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'});
@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);
# The following insures that there were no newlines in any fields
which #
# will be used in the header.
#
if ($Config{'subject'} =~ /(\n|\r)/m || $Config{'email'} =~ /(\n|\r)/m
||
$Config{'realname'} =~ /(\n|\r)/m || $Config{'recipient'} =~
/(\n|\r)/m) {
&error('invalid_headers');
}
if (!$Config{'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{'recipient'})) {
foreach $recipient (@recipients) {
if ($send_to =~ /$recipient$/i) {
push(@send_to,$send_to); last;
}
}
}
if ($#send_to < 0) { &error('no_recipient') }
$Config{'recipient'} = join(',',@send_to);
}
# 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} eq '') { push(@error,$require); }
}
# If it is a regular form field which has not been filled in or
#
# filled in with a space, fl #
# 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";
}
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{'e@[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;
$value =~ s/"/\"/g;
return $value;
}
sub body_attr_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
Bad Referrer - Access Denied |
The form attempting to use
FORMant resides at $referer, which is not allowed to access
this cgi script.
If you are attempting to configure FORMant to run with this form, you
need
to add the following to \@referers.
Add '$host' to your \@referers array.
|
(END ERROR HTML)
}
else {
print <<"(END ERROR HTML)";
Content-type: text/html
FORMant v1.5
Copyright 2004 Fr. 84
Version 1.5 - Released August 21, 2004
. |
(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.
|
(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 FORMant. Please
make sure you have filled in the recipient form field with
an e-mail
address that has been configured in \@recipients.
|
(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.
|
(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:
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.
|