#! perl -w
use Socket;
# BEGIN LOCAL CONFIG PORTION
# Declare the name of the host we're pawning the mail off onto. localhost
# is probably the best option if we've got a mailserver on this
# machine. If not, change it to another host. *YOU MUST HAVE MAIL RELAY
# PERMISSION ON THIS HOST!*
my $mailhost_name = "localhost";  # Fill this in with your local SMTP host name
my $mailhost_ip = ""; # The IP address for the mailhost. If left blank,
                      # we'll go try to figure it out. Should be in
                      # packed format, so no 1.2.3.4 here.
my $mailhost_port = 25; # The port to connect to. Except in the most
                        # bizarre of circumstances, this'll be 25.
my $we_are = ""; # Who we are. Fill this in if your mailserver needs to
                 # know. The only way to find this out locally is with
                 # POSIX::uname. Not everyone has it, and POSIX is a
                 # memory pig anyway. If you don't, we'll try a reverse
                 # lookup from the IP address on this end of things after
                 # the connection to the mailserver.
#
# END OF LOCAL CONFIG PORTION

# smailer - quicko sub to send mail. Takes from, a reference to an array
# with the to addresses in it, and a reference to an array with
# the actual formatted mail message in it, minus line terminators.
sub smailer ($\@\@){
  my ($from, $to_ref, $message_ref) = @_;


  my $mailhost_paddr; # Where the packed IP address & port will get stuck
  my $they_said;

  # Translate the port to a number if it's a name
  $mailhost_port = getservbyname($mailhost_port, 'tcp')  if $mailhost_port =~ /\D/;
  # Figure the IP address if we need to
  $mailhost_ip ||= inet_aton($mailhost_name);
  # Build the packed socket address
  $mailhost_paddr = sockaddr_in($mailhost_port, $mailhost_ip);

  # Create the socket
  socket(MAILSOCK, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket:$!";
  # Open the socket
  connect(MAILSOCK, $mailhost_paddr) || die "Connect error: $!";
  # Dup it
  open(MAILOUTSOCK, ">&MAILSOCK") || die "Erro dupping, $! $^E";
  select(MAILSOCK);
  $| = 1;
  select(MAILOUTSOCK);
  $| = 1;
  select(STDOUT);

  # Unless we know who we are, we'd better go figure it out
  my $stuff = getsockname(MAILSOCK) || die "Hey! $^E $!";
  my ($foo, $bar) = unpack_sockaddr_in($stuff);
  $we_are = gethostbyaddr($bar, AF_INET) unless $we_are;

  # Talk to the server. First fetch the initial 'hi there' message
  $they_said = <MAILSOCK>;
  
  # Say hi
  syswrite(MAILOUTSOCK, "HELO $we_are\cM\cJ", length($we_are) + 7);

  # Wait for them to say hi back
  $they_said = <MAILSOCK>;
  # Make sure we like it
  if (substr($they_said, 0, 1) ne '2') {
    # not a 2 response. Bail
    close(MAILSOCK);
    die "server said $they_said (why?)";
  }

  # Tell it who the mail's from
  syswrite(MAILOUTSOCK, "MAIL FROM: $from\cM\cJ", length($from) + 13);

  # was it OK?
  $they_said = <MAILSOCK>;
  chomp $they_said;
  # Make sure we like it
  if (substr($they_said, 0, 1) ne '2') {
    # not a 2 response. Bail, but not badly
    close(MAILSOCK);
    die "server said $they_said (why?)";
  }

  # Tell 'em who it's going to
  foreach my $recipient (@$to_ref) {
    # Tell it who the mail's from
    syswrite(MAILOUTSOCK, "RCPT TO: $recipient\cM\cJ", length($recipient) + 11);
    
    # was it OK?
    $they_said = <MAILSOCK>;
    chomp $they_said;
    # Make sure we like it
    if (substr($they_said, 0, 1) ne '2') {
      # not a 2 response. Bail, but not badly
      close(MAILSOCK);
      die "server said $they_said (why?)";
    }
  }
  
  # Time for the message
  syswrite(MAILOUTSOCK, "DATA\cM\cJ", 6);
  
  # was it OK?
  $they_said = <MAILSOCK>;
  chomp $they_said;
  # Make sure we like it
  if ((substr($they_said, 0, 1) ne '2')&& (substr($they_said, 0, 1) ne '3')) {
    # not a 2 response. Bail, but not badly
    close(MAILSOCK);
    die "server said $they_said (why?)";
  }
  
  # Send the message. If a line's got just a period, then send a double
  # period. (SMTP protocol dictates that a message ends with a single
  # period, and we don't want it ending before we're ready)
  foreach my $line (@$message_ref) {
    if ($line eq '.') {
      syswrite(MAILOUTSOCK, "..\cM\cJ", 4);
    } else {
      syswrite(MAILOUTSOCK, "$line\cM\cJ", length($line)+2);
    }
  }
    
  # 'Kay, send the closing period
  syswrite(MAILOUTSOCK, ".\cM\cj", 3);
  # Did they like the mail?
  $they_said = <MAILSOCK>;
  chomp $they_said;
  # Make sure we like it
  if (substr($they_said, 0, 1) ne '2') {
    # not a 2 response. Bail, but not badly
    close(MAILSOCK);
    die "server said $they_said (why?)";
  }
  
  # Go away
  syswrite(MAILOUTSOCK, "QUIT\cM\cJ", 6);
  close MAILSOCK;
  close MAILOUTSOCK;
  return 1;
}