#!/usr/bin/perl
# SMTPMAIL.PL
# by Robin S Chatterjee
# This is a script I cobbled together from the tcp Examples.
# It is meant to replace MAILER.CGI on NT servers which have access to Unix
# SMTP servers on the network.
#     USAGE
#     You use this script my putting special fields into your HTML form.
# They are as follows:
#
# <INPUT TYPE="HIDDEN" NAME="TO" VALUE="you@your.site.com">
#     Who to send the results to.  Multiple recipients will work fine.
# <INPUT TYPE="HIDDEN" NAME="SUBJECT" VALUE="Subject Line">
#     What the subject should be on the mail message send to recipients
# <INPUT TYPE="HIDDEN" NAME="REPLY-TO" VALUE="name@site.com">
#     Who should be listed in the "Reply-To" field of the mail message.
# <INPUT TYPE="HIDDEN" NAME="SMTPHOST" VALUE="smtphost.yourdomain">
#     Who should be listed in the Hosts file of the NT server,or have
# a valid DNS entry.
#     Inputs do not need to be hidden, but you'll probably want them
# that way.
#     The default response to give the user is at the very end.  Anything
# after __END__ will be put up as feedback.  Edit as you wish.  If you
# would like the responses to be sent in a specific format, you'll have
# to do that on your own.
#
# The CHECK_EMPTIES variable decides whether an error should be returned
# if a field is left blank.  If it is set to 1, an error message will
# be displayed.  If it is set to 0, blank fields are acceptable.

     $CHECK_EMPTIES=0;

# =========================
# END OF USER CONFIGURATION
print "Content-type: text/html\n\n";
sub ReadParse {
# slightly modified from the usual readparse
 local (*in) = @_ if @_;  local ($i, $loc, $key, $val);
 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) {
  $in[$i] =~ s/\+/ /g;    ($key, $val) = split(/=/,$in[$i],2);
  $FOUND=0;    foreach (@FIELDS) { $FOUND=1 if ($key eq $_); }
  if (($key ne 'TO')&&($key ne 'SMTPHOST')&&($key ne 'SUBJECT')&&($key ne 'REPLY-TO')&&($FOUND==0))
       {  push(@FIELDS,$key);  }
  $key =~ s/%(..)/pack("c",hex($1))/ge;
  $val =~ s/%(..)/pack("c",hex($1))/ge;
  $in{$key} .= "\0" if (defined($in{$key}));
  $in{$key} .= $val;  }  return 1; }

&ReadParse;
foreach (@FIELDS) {&MissingInfo if (($in{$_} eq '')&&($CHECK_EMPTIES==1));}
$in{'TO'} ='ROOT' if (!defined $in{'TO'});
$in{'SUBJECT'} ='NO SUBJECT' if (!defined $in{'SUBJECT'});
$in{'REPLY-TO'} ='CHATTERJEE_ROBIN@TANDEM.COM' if (!defined $in{'REPLY-TO'});
$in{'SMTPHOST'} ='localhost' if (!defined $in{'SMTPHOST'});
$ENV{'SERVER_ADDR'} ='LOCALHOST' if (!defined $ENV{'SERVER_ADDR'});
$SUBJECT=$in{'SUBJECT'};  delete $in{'SUBJECT'};
$REPLYTO=$in{'REPLY-TO'};  delete $in{'REPLY-TO'};
$SMTPHOST=$in{'SMTPHOST'}; delete $in{'SMTPHOST'};
$SERVERNAME=$ENV{'SERVER_NAME'};
$SERVERNAME=$ENV{'SERVER_ADDR'} if(!defined $ENV{'SERVER_NAME'});
# split up the "to" names for multiple recipients
$TO=$in{'TO'};  @TO=split('\0',$TO);

#( $them, $port ) = @ARGV;
$port = 25 unless $port;
$them = $SMTPHOST unless $them;
$AF_INET = 2;
$SOCK_STREAM = 1;
$SIG{'INT'} = 'dokill';
sub dokill {
    kill 9,$child if $child;
}

$sockaddr = 'S n a4 x8';

#chop($hostname = `hostname`);
($name,$aliases,$proto) = getprotobyname('tcp');
($name,$aliases,$port) = getservbyname($port,'tcp')
    unless $port =~ /^\d+$/;;
($name,$aliases,$type,$len,$thisaddr) =
        gethostbyname($hostname);
($name,$aliases,$type,$len,$thataddr) = gethostbyname($them);

$this = pack($sockaddr, $AF_INET, 0, $thisaddr);
$that = pack($sockaddr, $AF_INET, $port, $thataddr);
if (socket(S, $AF_INET, $SOCK_STREAM, $proto)) { 
#    print "socket ok\n";
}
else {
    die $!;
}

if (bind(S, $this)) {
#     print "bind ok\n";
}
else {
    die $!;
}

if (connect(S,$that)) {
#    print "connect ok\n";
}
else {
     die $!;
}

select(S); $| = 1; select(STDOUT);
$a=<S>;
print S "HELO ${SERVERNAME}\n";
$a=<S>;
print S "MAIL FROM:<SMTPMAIL>\n";
$a=<S>;
print S "RCPT TO:<@TO[0]>\n";
$a=<S>;
if ($#TO > 0) { foreach (1..$#TO) { print S "RCPT TO: @TO[$_]\n";$a=<S>; }
                  }
print S "DATA \n";
$a=<S>;
print S "To: @TO[0]\n";
if ($#TO > 0) { foreach (1..$#TO) { print S "Cc: @TO[$_]\n"; }
                  }
print S "Subject: $SUBJECT\n";
print S "Reply-To: $REPLYTO\n";
# Display each field and responses
foreach (@FIELDS) {
 $in{$_}=~ s/\0/\n\n   * /g;
 print S "---------------------------------------------------\n";
 print S "Input Field: $_\n";
 print S "Response:\n   * $in{$_}\n";
 }
print S "---------------------------------------------------\n";
print S ".\n";
$a=<S>;
print S "QUIT";
# Read in the response and print it.
undef $/;  $_=<DATA>;  print;

# What to display as the "missing information" error
sub MissingInfo {
  print <<EOF;
  <HTML>
  <HEAD>  <TITLE>Error</TITLE>  </HEAD>
  <BODY>
  <H1 ALIGN=CENTER>Error: Fields left empty</H1>
  <B>
  You are required to fill in all the fields in this response form.
  Please go back and fill in the fields with missing information.
  </B>
EOF
  exit(0);
}

# Everything down here is the default response.
__END__
<HTML>
<HEAD>  <TITLE>Thank You</TITLE>  </HEAD>
<BODY>
<H1 ALIGN=CENTER>Thank You!</H1>
<B>
Thanks for responding to this form.  Your responses have been mailed to
the correct person.<P>
</B>