#!/opt/bin/perl

$aucheck = 'AUBURN.EDU';
$sname = ($ENV{'HTTP_REFERER'});
chomp($sname);
$sname =~ tr/[a-z]/[A-Z]/;
$auauth = index($sname,$aucheck);
if ($auauth eq "-1") {
    exit(0); 
    }

# Modified for local use by Gene B. Stewart, Manager of Network Services,
# Division of University Computing, Auburn University, Alabama 
#
# Doug's WWW Mail Gateway 2.2
# 5/95
# All material here is Copyright 1995 Doug Stevenson.
#
# Use this script as a front end to mail in your HTML.  Not every browser
# supports the mailto: URLs, so this is the next best thing.  If you
# use this script, please leave credits to myself intact!  :)  You can
# modify it all you want, though.
#
# Documentation at:
#    http://www-bprc.mps.ohio-state.edu/mailto/mailto_info.html
#
# Configurable items are just below.  Also pay special attention to
# GET method arguments that this script accepts to specify defaults
# for some fields.
#
# I didn't exactly follow the RFCs on mail headers when I wrote this,
# so please send all flames my way if it breaks your mail client!!
# Also, you'll need cgi-lib.pl for the GET and POST parsing.  I use
# version 1.7.
#
# Requires cgi-lib.pl which can be found at
#    http://www.bio.cam.ac.uk/web/form.html
#
# PLEASE: Use this script freely, but leave credits to myself!!  It's
#         common decency!
#
########
# Doug Stevenson
# doug+@osu.edu

######################
# Configurable options
######################

# whether or not to actually allow mail to be sent -- for testing purposes
$active = 1;

# Logging flag.  Logs on POST method when mail is sent.
$logging = 1;
$logfile = '/usr/local/etc/httpd/logs/mailto_log';

# Physical script location.  Define ONLY if you wish to make your version
# of this source code available with GET method and the suffix '?source'
# on the url.
$script_loc = '/export/vol2/httpd/cgi-bin/mailto.pl';

# physical location of your cgi-lib.pl
$cgi_lib = '/export/vol2/httpd/cgi-bin/cgi-lib.pl';

# http script location
$script_http = 'http://www.auburn.edu/cgi-bin/mailto.pl';

# Path to sendmail and its flags.  Use the first commented version and
# define $listserver = 1if you want the gateway to be used for listserver
# subscriptions -- the -f switch might be neccesary to get this to work
# correctly.
#
# sendmail options:
#    -n  no aliasing
#    -t  read message for "To:"
#    -oi don't terminate message on line containing '.' alone
#$sendmail = "/usr/lib/sendmail -t -n -oi -f";  $listserver = 1;
$sendmail = "/usr/lib/sendmail -t ";

# set to 1 if you want the real addresses to be exposed from %addrs
#$expose_address = 1;

# Uncomment one of the below chunks of code to implement restricted mail

# List of address to allow ONLY - gets put in a HTML SELECT type menu.
#
#%addrs = ("Doug - main address", "doug+@osu.edu",
#	  "Doug at BPRC", "doug@polarmet1.mps.ohio-state.edu",
#	  "Doug at CIS", "stevenso@cis.ohio-state.edu",
#	  "Doug at the calc lab", "dstevens@mathserver.mps.ohio-state.edu",
#	  "Doug at Magnus", "dmsteven@magnus.acs.ohio-state.edu");

# If you don't want the actual mail addresses to be visible by people
# who view source, or you don't want to mess with the source, read them
# from $mailto_addrs:
#
#$mailto_addrs = '/usr/local/WWW/etc/mailto_addrs';
#open(ADDRS,$mailto_addrs);
#while(<ADDRS>) {
#    ($name,$address) = /^(.+)[ \t]+([^ ]+)\n$/;
#    $name =~ s/[ \t]*$//;
#    $addrs{$name} = $address;
#}

# version
$version = '2.2';

#############################
# end of configurable options
#############################


##########################
# source is self-contained
##########################

if ($ENV{'QUERY_STRING'} eq 'source' && defined($script_loc)) {
    print "Content-Type: text/plain\n\n";
    open(SOURCE, $script_loc) ||
	&InternalError('Could not open file containing source code');
    print <SOURCE>;
    close(SOURCE);
    exit(0);
}

require $cgi_lib;
&ReadParse();

#########################################################################
# method GET implies that we want to be given a FORM to fill out for mail
#########################################################################

if ($ENV{'REQUEST_METHOD'} eq 'GET') {
    # try to get as much info as possible for fields
    # To:     comes from $in{'to'}
    # Cc:     comes from $in{'cc'}
    # From:   comes from REMOTE_IDENT@REMOTE_HOST || $in{'from'} || REMOTE_USER
    # Subject: comes from $in{'sub'}
    # body comes from $in{'body'}

    $destaddr = $in{'to'};
    $cc = $in{'cc'};
    $subject = $in{'sub'};
    $body = $in{'body'};
    $nexturl = $in{'nexturl'};

    if ($in{'from'}) {
	$fromaddr = $in{'from'};
    }
    # this is for NetScape pre-1.0 beta users - probably obsolete code
    elsif ($ENV{'REMOTE_USER'}) {
	$fromaddr = $ENV{'REMOTE_USER'};
    }
    # this is for Lynx users, or any HTTP/1.0 client giving From header info
    elsif ($ENV{'HTTP_FROM'}) {
	$fromaddr = $ENV{'HTTP_FROM'};
    }
    # if all else fails, make a guess
    else {
	$fromaddr = "$ENV{'REMOTE_IDENT'}\@$ENV{'REMOTE_HOST'}";
    }

    # Convert multiple bodies (separated by \0 according to CGI spec)
    # into one big body
    $body =~ s/\0//;

    # Make a list of authorized addresses if %addrs exists.
    if (%addrs) {
	$selections = '<SELECT NAME="to">';
	foreach (sort keys %addrs) {
	    if ($in{'to'} eq $addrs{$_}) {
		$selections .= "<OPTION SELECTED>$_";
	    }
	    else {
		$selections .= "<OPTION>$_";
	    }
	    if ($expose_address) {
		$selections .= " &lt;$addrs{$_}>";
	    }
	}
	$selections .= "</SELECT>\n";
    }

    # give them the form
    print &PrintHeader();
    print <<EOH;
<HTML>
<HEAD>
<TITLE> WWW Mail Gateway $version</TITLE>
</HEAD>
<BODY TEXT="#000066" BGCOLOR="#FFFFFF" LINK="#3300ff" VLINK="#666699">

<A HREF="http://www.auburn.edu/cgi-bin/imagemap/map/header.map">
<IMG SRC="/map/header.gif" ISMAP border=0 height=25 width=589></A>

<H1>WWW Mail Gateway</H1>

<P>The <B>To</B>: field should contain the <B>full</B> E-mail address
that you want to mail to.  The <B>Your Email</B>: field needs to
contain your mail address so replies go to the right place.  Type your
message into the text area below. If the <B>To</B>: field is invalid,
or the mail bounces for some reason, you will receive notification
if <B>Your Email</B>: is set correctly.  <I>If <B>Your Email</B>:
is set incorrectly, all bounced mail will be sent to the bit bucket.</I></P>

<FORM ACTION="$script_http" METHOD=POST>
EOH
    ;
    print "<P><PRE>        <B>To</B>: ";

    # give the selections if set, or INPUT if not
    if ($selections) {
	print $selections;
    }
    else {
	print "<INPUT VALUE=\"$destaddr\" SIZE=40 NAME=\"to\">\n";
	print "        <B>Cc</B>: <INPUT VALUE=\"$cc\" SIZE=40 NAME=\"cc\">\n";
    }

    print <<EOH;
<B>Your Name</B>:  <INPUT VALUE="$fromname" SIZE=40 NAME="name">
<B>Your Email</B>: <INPUT VALUE="$fromaddr" SIZE=40 NAME="from">
<B>Subject</B>:    <INPUT VALUE="$subject" SIZE=40 NAME="sub"></PRE>
<INPUT TYPE="submit" VALUE="Send the mail">
<INPUT TYPE="reset" VALUE="Start over"><BR>
<TEXTAREA ROWS=20 COLS=60 NAME="body">$body</TEXTAREA><BR>
<INPUT TYPE="submit" VALUE="Send the mail">
<INPUT TYPE="reset" VALUE="Start over"><BR>
<INPUT TYPE="hidden" NAME="nexturl" VALUE="$nexturl"></P>
</FORM>
<HR>
<FONT SIZE=-1>Copyright &copy; 1997 &middot; Auburn&nbsp;University
&middot; Alabama&nbsp;36849 &middot; (334)&nbsp;844-4000 <BR>
</BODY>
</HTML>
EOH
    ;
}

#########################################################################
# Method POST implies that they already filled out the form and submitted
# it, and now it is to be processed.
#########################################################################

elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
    # get all the variables in their respective places
    $destaddr = $in{'to'};
    $cc       = $in{'cc'};
    $fromaddr = $in{'from'};
    $fromname = $in{'name'};
    $replyto  = $in{'from'};
    $sender   = $in{'from'};
    $errorsto = $in{'from'};
    $subject  = $in{'sub'};
    $body     = $in{'body'};
    $nexturl  = $in{'nexturl'};
    $realfrom = $ENV{'REMOTE_HOST'} ? $ENV{'REMOTE_HOST'}: $ENV{'REMOTE_ADDR'};

    # check to see if required inputs were filled - error if not
    unless ($destaddr && $fromaddr && $body && ($fromaddr =~ /^.+\@.+/)) {
        print &PrintHeader();
	print <<EOH;

<HTML><HEAD><TITLE>Mailto error</TITLE></HEAD>
<BODY><H1>Mailto error</H1>
<P>One or more of the following necessary pieces of information was missing
from your mail submission:
<UL>
<LI><B>To</B>:, the full mail address you wish to send mail to</LI>
<LI><B>Your Email</B>: your full email address</LI>
<LI><B>Body</B>: the text you wish to send</LI>
</UL>
Please go back and fill in the missing information.</P></BODY></HTML>
EOH
    exit(0);
    }

    # do some quick logging - you may opt to have more/different info written
    if ($logging) {
	open(MAILLOG,">>$logfile");
	print MAILLOG "$realfrom\n";
	close(MAILLOG);
    }

    # Log every CGI variable except for the ones reserved for mail info.
    # Valid vars go into @data.  Text output goes into $data and gets.
    # appended to the end of the mail.
    # First, get an ORDERED list of all cgi vars from @in to @keys
    for (0 .. $#in) {
	local($key) = split(/=/,$in[$_],2);
	$key =~ s/\+/ /g;
	$key =~ s/%(..)/pack("c",hex($1))/ge;
	push(@keys,$key);
    }
    # Now weed out the ones we want
    @reserved = ('to', 'cc', 'from', 'name', 'sub', 'body', 'nexturl');
    local(%mark);
    foreach (@reserved) { $mark{$_} = 1; }
    @data = grep(!$mark{$_}, @keys);
    foreach (@data) {
	$data .= "$_ -> $in{$_}\n";
    }

    # Convert multiple bodies (separated by \0 according to CGI spec)
    # into one big body
    $body =~ s/\0//;

    # now check to see if some joker changed the HTML to allow other
    # mail addresses besides the ones in %addrs, if applicable
    if (%addrs) {
	if (!scalar(grep($_." <$addrs{$_}>" eq $destaddr ||
			 $destaddr eq $_, keys(%addrs)))) {
	    print &PrintHeader();
	    print <<EOH;
<HTML><HEAD><TITLE>WWW Mail Gateway: Mail address not allowed</TITLE></HEAD>
<BODY>
<H1>Mail address not allowed</H1>
<P>The mail address you managed to submit, <B>$destaddr</B>, to this script is
not one of the pre-defined set of addresses that are allowed.  Go back and
try again.</P>
</BODY></HTML>
EOH
    ;
	    exit(0);
	}
    }

    # if we just received an alias, then convert that to an address
    $realaddr = $destaddr;
    if ($addrs{$destaddr}) {
	$realaddr = "$destaddr <$addrs{$destaddr}>";
    }

    # fork over the mail to sendmail and be done with it
    if ($active) {
	if ($listserver) {
	    open(MAIL,"| $sendmail$fromaddr") ||
		&InternalError('Could not fork sendmail with -f switch');
	}
	else {
	    open(MAIL,"| $sendmail") ||
		&InternalError('Could not fork sendmail with -f switch');
	}

	# only print Cc if we got one
	print MAIL "Cc: $cc\n" if $cc;
	print MAIL <<EOM;
From: $fromname <$fromaddr>
To: $realaddr
Reply-To: $replyto
Errors-To: $errorsto
Sender: $sender
Subject: $subject
X-Mail-Gateway: Doug\'s WWW Mail Gateway $version
X-Real-Host-From: $realfrom

$body

$data
EOM
    close(MAIL);
    }

    # give some short confirmation results
    #
    # if the cgi var 'nexturl' is given, give out the location, and let
    # the browser do the work.
    if ($nexturl) {
	print "Location: $nexturl\n\n";
    }
    # otherwise, give them the standard form.
    else {
	print &PrintHeader();
	print <<EOH;
<HTML><HEAD><TITLE>Mailto results</TITLE></HEAD>
<BODY><H1>Mailto results</H1>
<P>Mail sent to <B>$destaddr</B>:<BR><BR></P>
<PRE>
<B>Subject</B>: $subject
<B>From</B>: $fromname &lt;$fromaddr>

$body</PRE>
<HR>
<A HREF="$script_http">Back to the WWW Mailto Gateway</A>
</BODY></HTML>
EOH
    ;
    }
}				# end if METHOD=POST

#####################################
# What the heck are we doing here????
#####################################

else {
    print <<EOH;
<HTML><HEAD><TITLE>Mailto Gateway error</TITLE></HEAD>
<BODY><H1>Mailto Gateway error</H1>
<P>Somehow your browser generated a non POST/GET request method and it
got here.  You should get this fixed!!</P></BODY></HTML>
EOH
}

exit(0);


#
# Deal out error messages to the user.  Gets passed a string containing
# a description of the error
#
sub InternalError {
    local($errmsg) = @_;

    print &PrintHeader();
    print <<EOH;
Content-type: text/html
Status: 502 Bad Gateway

<HTML><HEAD><TITLE>Mailto Gateway Internal Error</TITLE></HEAD>
<BODY><H1>Mailto Gateway Internal Error</H1>
<P>Your mail failed to send for the following reason:<BR><BR>
<B>$errmesg</B></P></BODY></HTML>
EOH
    exit(0);
}


##
## end of mailto.pl
##