#!/usr/local/bin/perl -- -*- C -*-
#
# mailme.cgi - a script which sends an email message to the owner of this file
#	   should be placed in the SAME directory as your HTML form calling it.
#	   the form handler is: <form action="mailme.cgi" method="post">
# See mailme.html for a sample form that uses this script
#
# It expects the following fields to be present in the data from the client:
#    sender	- a valid fully qualified email address of the sender
#    recip	- MUST be the login name of the owner of this script
#    subject	- subject of the mail message (optional)
#    title	- title of the response sent to the client (optional)
#    arbitrary other fields and values	- placed in body of email
#
# It returns a thankyou to the caller and mails the field names and values
# supplied to the script owner with the specified subject.
# Title will be used as the title for the response page.
#
# Orignally written by Karl Auer 1 June 95
# Modified for general user use with cgiwrap by Lawrie Brown - Dec 95
# Rewritten to use the Perl5 CGI module by Lawrie Brown - Feb 2001

# use new Perl5 CGI module, sending errors to browser
use CGI;
use CGI::Carp qw(fatalsToBrowser);

# create a new CGI object to handle this request
$q = new CGI;
 
# find out who we're going to mail to
$to = (getpwuid($<))[0];     # get username for this process real uid

# grab the ones we need now
$sender = $q->param("sender");
$recip = $q->param("recip");
$subject = $q->param("subject");
$title = $q->param("title");

# throw them away so we don't send them as data
$q->delete('sender');
$q->delete('recip');
$q->delete('subject');
$q->delete('title');

# deal with a dud form...
$error  = "";	# no errors yet, unless ...
$error .= "No sender email provided.<br>\n" if ($sender =~ /^\s*$/);
$error .= "No recipient login provided.<br>\n" if ($recip =~ /^\s*$/);

# display standard HTML header stuff
print $q->header,
      $q->start_html("$title"),
      $q->h1("$title");

# put in defaults for optional variables
$subject = "Email from Web server"	if $subject =~ /^\s*$/;
$title   = "Email Sent"			if $title   =~ /^\s*$/;

# now do some sanity checks on the data
$error .= "Invalid sender email address ($sender), " .
		"please supply a fully qualified address.<br>\n"
	unless &IsValidEmailAddress($sender);
$error .= "Recipient login ($recip) does not match owner of this script, " .
		"please contact the script owner about this.<br>\n"
	unless $recip eq $to;
$error .= "Invalid subject ($subject), please re-enter it.<br>\n"
	if $subject =~ /[\r\n]/;	# single line subject only

# collect the remaining material as a single message looping over all names
$msg = "";
@names = $q->param;
foreach $n (@names) {
   $val = $q->param("$n");
   $msg .= "$n =\t$val\n";
}

# For our own protection, reject overly large messages
$error .= "Too much data as been supplied!<br>\n" if (length($msg) > 10240);

# now check for any errors and respond if any
if (length($error) > 0) {
   print "<h2>Ooops!</h2>\n";
   print "There is a problem with the information supplied:\n";
   print "<p>\n";
   print $error;
   print "<p>\n";
   print "Your input to the form has been discarded. Sorry about that.\n";
   print "You should go back and check that you have completed the form correctly.\n";
   print "If the problem persists you may need to advise the form's author.\n";
   print "<p>\n";
} elsif (length($msg) == 0) {
   # no message to send, so let user know
   print "<h2>Ooops!</h2>\n";
   print "You haven't actually provided any information to send!\n";
   print "Please go back and check that you have completed the form.\n";
} else {
   # otherwise let SendMail actually send the message
   &SendMail($sender, $to, $subject, $msg);
   # and let user know whats happened
   print "<center><h2>Thank you!</h2></center>\n";
   print "The following has been mailed to $to:\n<pre>\n";
   print "$msg\n";
   print "</pre>\n";
}

# and finish up with the HTML trailers
print $q->end_html;

exit(0);

############################################################################
# Sendmail
# Sends email to $recip with specified details below using $mailprog
#	(usually sendmail - if /bin/mail MUST filter out ~ from variables)
#
# Expects the following parameters from the html form response:
#	$sender	 - the email address of the sender (must be non-blank)
#	$recip	 - recipient email (must be non-blank)
#	$subject - the subject of the message (may be blank)
#	$msg	 - the comment to be sent (must be non-blank)
# Note - does NOT generate output - the calling function must deal
#        with responding to the user (if any response needed).
#
#
# ------------------------------------------------------------
# subroutine SendMail
sub SendMail {
    local($sender) = @_[0];
    local($recip) = @_[1];
    local($subject) = @_[2];
    local($msg) = @_[3];
    
    local($mailprog) = '/usr/lib/sendmail';	# mail program used on this system
 
    # do some sanity checks on the parameters, just to be sure
    die "Error - Invalid sender email address ($sender)\n" unless
	&IsValidEmailAddress($sender);	# valid full email address wanted
    die "Error - Invalid recipient address ($recip)\n" unless
	&IsValidShortEmail($recip);	# valid email address wanted
    die "Error - Invalid subject ($subject)\n" if
	$subject =~ /[\r\n]/;		# has a single line subject only

    # open MAIL for content of email and build mail message
    open (MAIL, "|$mailprog $recip") || die "Error - Can't open mail program: $mailprog!\n";
    print MAIL "To: $recip\n";
    print MAIL "Reply-to: $sender\n";
    print MAIL "Subject: $subject\n\n";
    print MAIL "$sender sent the following message:\n";
    print MAIL "\n---------------------------------------------------------\n";
    print MAIL "$msg";
    print MAIL "\n---------------------------------------------------------\n";
    print MAIL "Sent from remote host: $ENV{'REMOTE_HOST'} [$ENV{'REMOTE_ADDR'}] ";
    print MAIL "$ENV{'REQUEST_METHOD'} $ENV{'SERVER_PROTOCOL'}\n";
    close (MAIL);
}

############################################################################
# IsValidEmailAddress
# Returns non-zero if the passed email address is a valid looking
#	fully qualified type email address. ie xxx@hhh.yyy.zzz
#
sub IsValidEmailAddress
{
   local($address) = @_[0] ;

   return $address =~
      m:^[-A-Za-z0-9_.=/][-A-Za-z0-9_.=%!/@ ]*@[-A-Za-z0-9_.]+$:;
}

############################################################################
# IsValidShortEmail
# Returns non-zero if the passed email address is a valid looking
#	partial or fully qualified type email address.
#
sub IsValidShortEmail
{
   local($address) = @_[0] ;

   return $address =~
      m:^[-A-Za-z0-9_.=/][-A-Za-z0-9_.=%!/@ ]*$:;
}
############################################################################
1;