Using Web Mail Form in Perl

email.cgi

#!/usr/bin/perl
# email.cgi
# (c) 1997 Bill Weinman
# a simple email form for the Web
#

$CRLF = "\x0d\x0a";
$user_agent  = $ENV{HTTP_USER_AGENT};
$remote_host = $ENV{REMOTE_HOST};
$remote_addr = $ENV{REMOTE_ADDR};
$servername  = $ENV{SERVER_NAME};  # this server
$scriptname  = $ENV{REDIRECT_URL} || $ENV{SCRIPT_NAME};  # this program's URI
$callback = "http://$servername$scriptname";  # how to call back
$sendmail = "/usr/lib/sendmail";
$switches = " -t -f webmaster\@$servername";
$mailto   = "Bill Weinman <testuser\@luna.bearnet.com>";
$xmagic   = "Magic Mailer 1.0";

print "Content-type: text/html$CRLF$CRLF";

# get the query vars, if any
%query = getquery();

# if there's no data, assume this is the first iteration
$state = 'first' unless %query;

# prevent users from entering 
# arbitrary HTML in thier entries
while(($qname, $qvalue) = each %query) {
  # convert any HTML entities
  $qvalue =~ s/</<\;/g;
  $qvalue =~ s/>/>\;/g;
  $qvalue =~ s/"/"\;/g; 
  $$qname = $qvalue; 
  }
$referer = $ENV{HTTP_REFERER} unless $referer;

# what now is
$date = localtime;

# the main jump table
if    ($state eq 'first') { first()    }
elsif ($state eq 'send' ) { mailvalid() }
elsif ($state eq 'edit' ) { mailedit() }
elsif ($state eq 'sent' ) { mailsent() }
else { unknown() }

exit;

# STATE SCREENS

sub first{
htmlhead("My Email");
htmlp("first.htmlp");
htmlfoot();
}

sub mailvalid{
$disp_message = $message;
$disp_message =~ s/\r\n/\n/g;       # fold the cr/lf pairs
$disp_message =~ s/\n{2}/<p>\n/g;   # format it for the screen

return error("'$email' is not a valid email address")
  unless ($email =~ /^[a-z][\w-.+]*\@[\w-]*[.][\w-.]*$/);

htmlhead("Sending Email");
htmlp("valid.htmlp");
htmlfoot();
}

sub mailedit{
htmlhead("My Email: Edit the Message");
htmlp("edit.htmlp");
htmlfoot();
}

sub mailsent{
if ($oops) { mailedit }
else {
  mailsend() or return 0;
  htmlhead("Email Sent");
  htmlp("sent.htmlp");
  htmlfoot();
  }
}

sub error{
local $error = shift;

htmlhead("My Email: $state");
htmlp("error.htmlp");
htmlfoot();
return 0;
}

sub unknown{
htmlhead("My Email: unknown state: $state");
print "<h1>Unknown state!</h1>\n";
printvars();
htmlfoot();
}

# COMMON HTML HEADER AND FOOTER
# htmlhead(title)
# print the top of the html file
#
sub htmlhead{
 local $title = shift;
 htmlp("header.htmlp");
}

# htmlfoot
# print the foot of the html file
#
sub htmlfoot{
 my $title = shift;
 htmlp("footer.htmlp");
}
# EMAIL ROUTINES
sub mailsend{
 return error(qq(cannot find $sendmail)) unless (-x $sendmail);
 open(MAIL, "| $sendmail $switches") or
  return error(qq(cannot open "$sendmail $switches": $!));
 print MAIL <<SENDMAIL;
 X-Mailer: $xmagic [$referer]
 To: $mailto
 From: $name <$email>
 Subject: [$subject]
 Referer:     [$referer]
 Remote Host: [$remote_host]
 Remote Addr: [$remote_addr]
 User Agent:  [$user_agent]
 $message
 ---
 This message was sent by $xmagic
 SENDMAIL
 close MAIL;
}

# UTILITY ROUTINES
# getquery
# returns hash of CGI query strings
sub getquery{
my $method = $ENV{'REQUEST_METHOD'};
my ($query_string, $pair);
my %query_hash;
$query_string = $ENV{'QUERY_STRING'} if $method eq 'GET';
$query_string = <STDIN> if $method eq 'POST';
return undef unless $query_string;
foreach $pair (split(/&/, $query_string)) {
  $pair =~ s/\+/ /g;
  $pair =~ s/%([\da-f]{2})/pack('c',hex($1))/ieg;
  ($_qsname, $_qsvalue) = split(/=/, $pair);
  $query_hash{$_qsname} = $_qsvalue;
  }
 return %query_hash;
}