#!/usr/bin/perl

############################################################
# 			 mailto.cgi
# 			    v1.2.5
# 		       Meng Weng Wong
# 		Thu Feb 22 02:47:49 EST 1996
# $Id: mailto.cgi,v 1.6 1996/05/18 07:10:56 mengwong Exp mengwong $
# 
# accepts a form submission and mails all fields to an address
# specified within the form.
# 
# requires perl 5, available ftp.netlabs.com
# 
# PLEASE READ THE DOCUMENTATION
#    http://icg.resnet.upenn.edu/mailto.html
# 
# TO DO (planned upgrades)
# 
# I have another problem you might be able to help with. My purpose in
# setting up the form is to allow clients of my service bureau to fill out an
# order form, and then attach a file to the resulting email form. If
# possible, it would be nice if they could click an "Attach" button, get the
# usual Mac or Windows file dialog, pick a file, and return to the form, then
# when they click the "Submit" I would receive a form like your mailto.cgi
# script makes, with the chosen file attached.
# 
# Alternatively, after the mailto script sends the form to me, the following
# html page would provide an opportunity to send another message with file
# attached, or to send the file via ftp.
# 
############################################################

# ----------------------------------------------------------
# 		       initialization
# ----------------------------------------------------------

# if you've downloaded mailto.cgi for use as a local installation,
# you MUST change all the following information.

# who's in charge of this installation of webmail?
$maintainer = 'mengwong@pobox.com';

# what's my local Fully Qualified Domain Name?
$hostname   = "icg.resnet.upenn.edu";

# all webmails sent will be BCC'ed to this address
# (typically the maintainer).  comment out if you don't want
# such BCCs to be sent.
$autobcc = 'mengwong+webmail@pobox.com';

# where's sendmail located?
$mail = "/usr/lib/sendmail";

# who's the default From if none is given?  this address
# is supposed to bounce.
$default_from = 'sender.did.not.provide.an.email.address@webmail.gateway (WebMail gateway, no From given)';

# String to prepend to subject of every e-mail message
$subj_prefix = "WebMail: ";

# submissions that don't specify host in the "to" portion
# end up with this default one.
$home_host = "mengwong.com";

$disclaimer = "
 # --------------------------------------------------------------
 # This message comes to you via a Web-to-Email gateway.
 # The person who originated this message may not be provably
 # identifiable.  The webmail gateway takes no responsibility
 # for this message; it even encourages a healthy skepticism on
 # your part.  Our best guess at the identity of the originator,
 # which may or may not reassure you, is:
 #   real_remote_address
 # This experimental gateway is maintained as a public
 # service.  Please report any abuses to the maintainer,
 # $maintainer, who otherwise has and wants
 # nothing to do with this message whatsoever.
 # You can get more information about the gateway at
 #   http://icg.resnet.upenn.edu/mailto.html
 # --------------------------------------------------------------
";

# the bottom line on the "yes, your mail was sent" page
$credit = "submitted via <A HREF=\"http://icg.resnet.upenn.edu/mailto.html\">mailto.cgi</A>, a public service utility written by <A HREF=\"http://pobox.com/~mengwong/\">Meng Weng Wong</A>";

# what hosts are to be forbidden from posting to mailto.cgi?
@disallowed_regexps = ("saturn.caps.maine.edu", "www.iao.com");

# ----------------------------------------------------------
# no user-serviceable parts below this line
# ----------------------------------------------------------

$webmailversion = "v1.2.2";

$ENV{"PATH"} = "";
$ENV{'IFS'} = '';

@specialnames = ("to", "cc", "from", "body", "subject",
		 "continue_url", "continue_text",
		 "leading_spaces", "separator",
		 "required_fields", "sort_order",
		 "body_bgcolor", "body_background",
		 "body_link", "body_vlink", "body_text",
		 "first_line", "mailto_comment");

if (grep ($ENV{REMOTE_HOST} =~ /$_/, @disallowed_regexps)) {
    print "Content-type: text/html\n\nYou are not permitted to use this page.  Sorry.\n";
    exit;
}

# Tell WWW that we're an HTML document
&ReadParse;

if (! keys %in) {
    print "Location: http://icg.resnet.upenn.edu/mailto.html\n\nPlease check out <A HREF=\"http://icg.resnet.upenn.edu/mailto.html\">http://icg.resnet.upenn.edu/mailto.html</A>\n";
}

print "Content-type: text/html\n\n";

$remote_host = $ENV{"REMOTE_HOST"};
$remote_host = "unknown" if ($remote_host =~ /^\s*$/);
$remote_user = $ENV{"REMOTE_IDENT"};
$remote_user = "unknown" if ($remote_user =~ /^\s*$/);
$real_remote_address = substr("$remote_user\@$remote_host", 0, 200);
$disclaimer =~ s/real_remote_address/$real_remote_address/;

# ----------------------------------------------------------
# 		    build the <BODY> tag
# ----------------------------------------------------------

@bodyattributes = grep(/^body_/ && $in{$_} =~ /\S/, @specialnames);
if (@bodyattributes) {
    $bodytag = "<BODY";
    for (@bodyattributes) {
	$tentativetag = $in{$_};
	if ($_ =~ /bgcolor|link|vlink|text/ && $tentativetag =~ /^[0-9a-f]{6}$/i) {
	    $tentativetag = "#$tentativetag";
	}
	($attributename = uc($_)) =~ s/^BODY_//;
	$bodytag .= " $attributename=\"$tentativetag\"";
    }
    $bodytag .= ">";
}

# ----------------------------------------------------------
# 	 make sure all required fields are present
# ----------------------------------------------------------

@required_fields = ("to", split(/\s*,\s*|\000/, $in{'required_fields'}));
@missing_fields = grep ($in{$_} !~ /\S/, @required_fields);
if (@missing_fields) {
    $errormessage = "You did not provide sufficient information.\nYou are required to fill out the following:\n\n<UL>";
    $errormessage .= join("\n<LI> ", "", @missing_fields);
    $errormessage .= "\n</UL>\n\nPlease go back and fill out the form again.\n";
    &Exit("Insufficient Information", $errormessage);
}

# ----------------------------------------------------------
# 		       build the To:
# ----------------------------------------------------------

# Untaint so we don't get nasty shell metacharacters.
$to = $in{"to"};
$to_orig = $to;
$to =~ /^([\w, \.\%\!\@-]*)$/;  $to = $1; # Untaint it
$to =~ s/^\s+//; s/\s+$//;
&Exit("Illegal characters found in \"To\" address.") if ($to ne $to_orig);

$to = "$to\@$home_host" if ($to !~ /\@\S+/);

# ----------------------------------------------------------
# 			same for cc
# ----------------------------------------------------------

$cc = $in{"cc"};
$cc_orig = $cc;
$cc =~ /^([\w, \.\%\!\@-]*)$/;  $cc = $1; # Untaint it
undef $cc if ($cc ne $cc_orig);
undef $cc if ($cc !~ /\@\S+$/);

if (defined($cc)) {
    $ccline = "CC: $cc\n";
    $cclinehtml = "<EM>CC:</EM> $cc<BR>\n";
}

# ----------------------------------------------------------
# 		   and for mailto_comment
# ----------------------------------------------------------

if ($in{"mailto_comment"} =~ /\S/) {
    $mailtocomment = $in{'mailto_comment'};
    $mailtocommenthtml = "<EM>X-Mailto-Comment:</EM> $mailtocomment<BR>\n";
    $mailtocomment = "X-Mailto-Comment: $in{'mailto_comment'}\n";
}

# ----------------------------------------------------------
# 		   and for first_line
# ----------------------------------------------------------

if ($in{"first_line"} =~ /\S/) {
    $firstline = $in{'first_line'} . "\n\n";
}

# ----------------------------------------------------------
# 		      make up the from
# ----------------------------------------------------------

$from = $in{"from"};
if ($in{'from'} eq "") { $from = $default_from; }
elsif ($from !~ /\@/)  { $from = "$real_remote_address ($from)"; }
elsif (defined($in{'name'})) { $in{'name'} = substr($in{'name'}, 0, 200);
			       $from .= " ($in{'name'})"; }

# ----------------------------------------------------------
# 	   do we get to mention an http_referer?
# ----------------------------------------------------------

if (defined $ENV{'HTTP_REFERER'}) {
    $http_referer = "X-HTTP-Referer: $ENV{'HTTP_REFERER'}\n";
}

# ----------------------------------------------------------
# 		    get the body working
# ----------------------------------------------------------

$body = $in{"body"};

# ----------------------------------------------------------
# 		     build the subject
# ----------------------------------------------------------

$subject = $in{"subject"};
$subject = $subj_prefix . $subject;

# ----------------------------------------------------------
# 	  do key/value pairs want leading spaces?
# 		and how do we separate them?
# 		  and how do we sort them?
# ----------------------------------------------------------

$leading_spaces = $in{"leading_spaces"};
$leadingspaces = "    " if (! defined ($leading_spaces) ||
			    $leading_spaces =~ /^(1|yes|true|y|t|do|want)$/i);

$separator = $in{'separator'};
$separator = " = " unless (defined ($separator));
   if ($separator =~ /colon/)  { $separator = ": "; }
elsif ($separator =~ /dash/)   { $separator = " - "; }
elsif ($separator =~ /hyphen/) { $separator = " -- "; }
elsif ($separator =~ /line/)   { $separator = " --- "; }
elsif ($separator =~ /equal/)  { $separator = " = "; }
elsif ($separator =~ /space/)  { $separator = " "; }
elsif ($separator =~ /tab/)    { $separator = "\t"; }

$sort_order = $in{'sort_order'};
if (defined ($sort_order)) {
    $sortorder = sub {$a cmp $b}            if ($sort_order =~ /alphabetical/i);
    $sortorder = sub {lc($a) cmp lc($b)}    if ($sort_order =~ /alphabetical, case insensitive/i);
    $sortorder = sub {$b cmp $a}            if ($sort_order =~ /reverse alphabetical/i);
    $sortorder = sub {lc($b) cmp lc($a)}    if ($sort_order =~ /reverse alphabetical, case insensitive/i);
    undef ($sortorder)                      if ($sort_order =~ /undefined|none|as.?is/i);
}

# sorted_in_keys is predefined in ReadParse, thus sort_order=none by default

if (defined ($sortorder)) {
    @sorted_in_keys = sort { &$sortorder($a, $b) } keys %in;
}

foreach $key (@sorted_in_keys) {
    next if (grep($key eq $_, @specialnames));
    $pad = " " x length("$leadingspaces$key$separator");
    $in{$key} =~ s/[\000\n]/\n$pad/g;
    $instuff .= "$leadingspaces$key$separator$in{$key}\n";
}

# ----------------------------------------------------------
# 	      now we're ready to send the mail
# ----------------------------------------------------------

if (($autobcc eq "mengwong+webmail\@pobox.com") && ($hostname eq "icg.resnet.upenn.edu")) { $realautobcc = $autobcc; }
										     else { $realautobcc = ""; }

# print STDERR "opening \"|$mail $to $cc $realautobcc\"\n";
open(MAIL,"|$mail $to $cc $realautobcc") ||  &Exit("Could not execute \"$mail\"");

print MAIL <<"TAG";
X-Mailer: Meng's mailto.cgi $webmailversion at $hostname
From: $from
X-Ident-From: $real_remote_address
Subject: $subject
To: $to
Precedence: bulk
$ccline$http_referer$mailtocomment
$firstline$instuff
$body

$disclaimer
TAG

close(MAIL);

if (defined($in{'continue_text'}) &&
    defined($in{'continue_url'})) {
    $continue = "<A HREF=\"$in{'continue_url'}\">$in{'continue_text'}</A>";
}

# If we are here, then success -- print a happy message
$toprinttostdout = <<TAG;
<TITLE>Submission Receipt</TITLE>
$bodytag
<H1>Your message has been sent!</H1>
$continue
<HR>
<EM>To:</EM> $to<BR>
$mailtocommenthtml$cclinehtml<EM>From:</EM> $from<BR>
<EM>Subject:</EM> $subject<BR>
<EM>Submitted by:</EM> $real_remote_address<P>

<PRE>$firstline$instuff
$body</PRE>
<HR>
$credit
TAG

print $toprinttostdout;

# ----------------------------------------------------------
# 			 functions
# ----------------------------------------------------------

# Exit the script displaying the appropriate error message. (format 2)
sub Exit {
    local($errorheader) = shift(@_);

    print "<TITLE>Webmail: $errorheader</TITLE>\n";
    print $bodytag;
    print "<H1>$errorheader</H1>\n";
    print @_;
    print "<P><HR>Unable to send the message.\n";

    exit(2);
}

sub ReadParse {
    local (*in) = @_ if @_;

    local ($i, $key, $val);

    # Read in text
    if    ($ENV{'REQUEST_METHOD'} eq "GET") { $in = $ENV{'QUERY_STRING'}; }
    elsif ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN,$in,$ENV{'CONTENT_LENGTH'}); }

    @in = split(/&/,$in);

    foreach $i (0 .. $#in) {
	# Convert plus's to spaces
	$in[$i] =~ s/\+/ /g;

	# Split into key and value.  
	($key, $val) = split(/=/,$in[$i],2); # splits on the first =.

	# Convert %XX from hex numbers to alphanumeric
	$key =~ s/%(..)/pack("c",hex($1))/ge;
	$val =~ s/%(..)/pack("c",hex($1))/ge;

	push (@sorted_in_keys, $key) unless defined($in{$key});

	# Associate key and value
	$in{$key} .= "\000" if (defined($in{$key})); # \0 is the multiple separator
	$in{$key} .= $val;
    }

    return 1; # just for fun
}