#!/usr/bin/perl -w
use strict;
#-------------------------------------------------------------------------------#
# Variables
#-------------------------------------------------------------------------------#
# These variables may be modified as needed
my $redirect = "http://www.yoursite.com"; # where to redirect after form submission
my $sendmail = "/usr/sbin/sendmail"; # location of sendmail program
my $subject = "Form Submission Results"; # subject line for email sent - can also be sent as CGI parameter
my @recipients = qw/webmaster@yoursite.com/; # email address to send the email to
my @required = (); # comma seperated list of all required fields - can also be sent as CGI parameter
# These variables should not need to be changed
my (%formdata, $current_date, $remote_host, $remote_addr, $server_name);
#-------------------------------------------------------------------------------#
# Main
#-------------------------------------------------------------------------------#
&parse_form (\%formdata);
&set_variables (\%formdata, \@required, \$redirect, \$sendmail, \$subject, \@recipients);
&check_variables ($redirect, $sendmail, \@recipients);
&check_required (\%formdata, \@required);
&get_data (\$current_date, \$remote_host, \$remote_addr, \$server_name);
&send_email (\%formdata, \@recipients, $sendmail, $subject, $current_date, $remote_host, $remote_addr, $server_name);
&redirect($redirect);
#-------------------------------------------------------------------------------#
# Subroutines
#-------------------------------------------------------------------------------#
# gets the parameters sent via CGI and stores them in the %formdata hash
sub parse_form {
my ($formdata) = @_;
my (@pairs, $buffer, $value, $key, $pair);
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
}
else {
print "Content-type: text/html\n\n";
print "
Use Post or Get";
}
foreach $pair (@pairs) {
($key, $value) = split (/=/, $pair);
$key =~ tr/+/ /;
$key =~ 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;
$value =~s///g;
if ($$formdata{$key}) {
$$formdata{$key} .= ", $value";
}
else {
$$formdata{$key} = $value;
}
}
}
sub set_variables {
my ($formdata, $required, $redirect, $sendmail, $subject, $recipients) = @_;
@$required = split /,/, $$formdata{'required'} unless ($$formdata{'required'} eq "");
$$redirect = $$formdata{'redirect'} unless ($$formdata{'required'} eq "");
$$sendmail = $$formdata{'sendmail'} unless ($$formdata{'sendmail'} eq "");
$$subject = $$formdata{'subject'} unless ($$formdata{'subject'} eq "");
@$recipients = split /,/, $$formdata{'recipient'} unless ($$formdata{'recipient'} eq "");
}
sub check_variables {
my ($redirect, $sendmail, $recipients) = @_;
my $error_message = "";
# check the redirect link
$error_message .= "
redirect link does not appear to be valid" unless ($redirect =~ m!^http://(www.)?\w+\.\w\w(\w)?(.*)$!);
# verify sendmail will open
open (MAIL, "|$sendmail -t") or die &show_errors ("Unable to open $sendmail: $!", 0);
# verfity the recipient is valid
foreach (@$recipients) {
$error_message .= "$_ is not a valid address " unless ($_ =~ /^[_a-z0-9.-]+\@[_a-z0-9.-]*\.\w\w(\w)?$/i);
}
# show the errors if there are any
&show_errors ($error_message, 0) unless $error_message eq "";
# close the MAIL program - not needed currently
close (MAIL);
}
sub check_required {
my ($formdata, $required) = @_;
my $error_message = "";
# check each field in the array
foreach (@$required) {
$error_message .= "$_ is a required field" if $$formdata{$_} eq "";
}
# show any error messages
&show_errors ($error_message, 1) unless $error_message eq "";
}
sub get_data {
my ($current_date, $remote_host, $remote_addr, $server_name) = @_;
my ($year, $month, $day);
my @months = qw/January February March April May June July August September October November December/;
# get the current date
($day, $month, $year) = (localtime)[3,4,5];
$year += 1900;
$$current_date = "$months[$month] $day, $year";
# get the information about who submitted the form
$$remote_host = $ENV{'REMOTE_HOST'};
$$remote_addr = $ENV{'REMOTE_ADDR'};
$$server_name = $ENV{'SERVER_NAME'};
}
sub send_email {
my ($formdata, $recipients, $sendmail, $subject, $current_date, $remote_host, $remote_addr, $server_name) = @_;
my $message = "
------------------------------------------------------
End of Form Submission Results
------------------------------------------------------
";
# remove unwanted data from formdata
delete $$formdata{'recipient'};
delete $$formdata{'subject'};
delete $$formdata{'required'};
delete $$formdata{'redirect'};
delete $$formdata{'sendmail'};
foreach my $send_to (@$recipients) {
open (MAIL, "|$sendmail -t") or die &show_errors ("Unable to open $sendmail: $!", 0);
print MAIL "To: $send_to \nFrom: webmaster\@yoursite.com\n";
print MAIL "Subject: $subject\n";
print MAIL "Form Submission Results\n";
print MAIL "(c) Eric Milford - submit_form.pl\n";
print MAIL "http://www.yoursite.com\n\n";
print MAIL "------------------------------------------------------\n";
print MAIL "[Date Sent] - $current_date\n";
print MAIL "[Remote Host] - $remote_host\n";
print MAIL "[Remote Address] - $remote_addr\n";
print MAIL "[Server Name] - $server_name\n";
print MAIL "------------------------------------------------------\n\n";
foreach my $key (keys %$formdata) {
print MAIL "$key: $$formdata{$key}\n\n" unless $$formdata{$key} eq "";
}
print MAIL $message;
close (MAIL) or die &show_errors ("Unable to close $sendmail: $!", 0);
}
}
# redirects the user to the updated index page - or wherever specified
sub redirect {
use CGI qw(:cgi);
my $url = $_[0];
my $q = CGI->new();
print $q->redirect(
-url => $url
);
}
sub show_errors {
my ($error_message, $method) = @_;
$method = "An error with the script's installation has occured.
Please contact the webmaster with the error messages listed below!" if $method == 0;
$method = "An error occured with your submission. Please
check the errors and make any necessary modficiations!" if $method == 1;
print "Content-type: text/html\n\n";
print "\n";
print "There was unfortunately a problem |
\n";
print "$method
";
print "";
print " |
\n";
exit(0);
}