#!/usr/bin/perl -w
# FILE:           sendmail.pl
# DESCRIPTION:    Example code for sending mail in a Perl script.
# LAST MODIFIED:  1999.03.11

  use Socket;
  use strict;

  # Change these to values you'd like to use for your test.
  my($mailTo)     = 'user_name@somewhere.com';
  my($mailServer) = 'mail.my_isp.com';
  my($mailFrom)   = 'John';
  my($realName)   = "John Q. Public";
  my($subject)    = 'This mail message was sent via an SMTP conversation in Perl';
  my($body1)      = "Test Line One.\n";
  my($body2)      = "Test Line Two.\n";

  # These constants shouldn't need changing.
  my($packFormat) = 'S n a4 x8'; #Internet address format (AF_INET:portNumber:serverAddress:eightNulls)
  my($proto)      = getprotobyname("tcp")        || 6;
  my($a,$b, $port,$x)  = getservbyname("smtp", "tcp");
  my($name,$aliases,$addrtype,$len,@addrs) = gethostbyname($mailServer);
  my($serverAddr) = $addrs[0];

  if (! defined($len)) {
     die('gethostbyname failed.');
  }

  socket(SMTP, AF_INET(), SOCK_STREAM(), $proto)
     or die("socket: $!");

  connect(SMTP, pack($packFormat, AF_INET(), $port, $serverAddr))
     or die("connect: $!");

  select(SMTP); $| = 1; select(STDOUT);    # use unbuffered i/o.

  {
     my($inpBuf) = '';

     recv(SMTP, $inpBuf, 200, 0);
  }

  sendSMTP(1, "HELO\n");
  sendSMTP(1, "MAIL FROM: <$mailFrom>\n");
  sendSMTP(1, "RCPT TO: <$mailTo>\n");
  sendSMTP(1, "VRFY\n");
  sendSMTP(1, "DATA\n");

  sendSMTPnoresponse(1, "From: $realName\n");
  sendSMTPnoresponse(1, "Subject: $subject\n");
  sendSMTPnoresponse(1, "\n");
  sendSMTPnoresponse(1, $body1);
  sendSMTPnoresponse(1, $body2);
  sendSMTPnoresponse(1, "\n");
  sendSMTP(1, ".\n");
  sendSMTP(1, "QUIT\n");

  close(SMTP);

  sub closeSocket {     # close smtp socket on error
     close(SMTP);
     die("SMTP socket closed due to SIGINT\n");
  }

  sub send_to_smtp {
     my($debug)  = shift;
     my($response) = shift;
     my($buffer) = @_;

     print STDERR ("> $buffer") if $debug;
     send(SMTP, $buffer, 0);

     if ($response) {
       recv(SMTP, $buffer, 200, 0);
       print STDERR ("< $buffer") if $debug;
       return( (split(/ /, $buffer))[0] );
     }
  }

  sub sendSMTP {
    my ($debug) = shift;
    send_to_smtp($debug, 1, @_);
  }

  sub sendSMTPnoresponse {
    my ($debug) = shift;
    send_to_smtp($debug, 0, @_);
  }