#!/usr/bin/perl

use strict;

use IO::Socket qw();
use Sys::Hostname;
use Getopt::Long;
use Time::Local;

my($p_name)   = $0 =~ m|/?([^/]+)$|;
my $p_version = "20040404.1";
my $p_usage   = "Usage: $p_name [--help|--version] (see --help for details)";
my $p_cp      = <<EOM;
        Copyright (c) 2003-2004 John Jetmore <jj33\@pobox.com>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
EOM
ext_usage(); # before we do anything else, check for --help

my($from,$to,$helo,$data,$server,$port,$a_type,$a_user,$a_pass,
   $lint,$timeout,%O) = (undef);
my $user     = getpwuid($<);
my $hostname = get_hostname();

Getopt::Long::Configure("bundling_override");
GetOptions(
  'l|input-file=s'  => \$O{option_file},   # (l)ocation of input data
  'f|from:s'        => \$O{mail_from},     # envelope-(f)rom address
  't|to:s'          => \$O{mail_to},       # envelope-(t)o address
  'h|helo|ehlo:s'   => \$O{mail_helo},     # (h)elo string
  's|server:s'      => \$O{mail_server},   # (s)erver to use
  'p|port:i'        => \$O{mail_port},     # (p)ort to use
  'd|data:s'        => \$O{mail_data},     # (d)ata portion ('\n' for newlines)
  'timeout:s'       => \$O{timeout},       # timeout for each trans (def 30s)
  'g'               => \$O{data_on_stdin}, # (g)et data on stdin 
  'm'               => \$O{emulate_mail},  # emulate (M)ail command
  'q|quit|quit-after=s' => \$O{quit_after}, # (q)uit after
  'n|suppress-data' => \$O{supress_data},  # do (n)ot print data portion
  'a|auth:s'        => \$O{auth},          # force auth, exit if not supported
  'au|auth-user:s'  => \$O{auth_user},     # user for auth
  'ap|auth-password:s' => \$O{auth_pass},  # pass for auth
  'am|auth-map=s'   => \$O{auth_map},      # auth type map
  'ahp|auth-hide-password' => \$O{auth_hidepw}, # hide passwords when possible
  'apt|auth-plaintext' => \$O{auth_showpt}, # translate base64 strings
  'ao|auth-optional:s' => \$O{auth_optional}, # auth optional (ignore failure)
  'support'         => \$O{get_support},   # report capabilties
  'li|local-interface:s' => \$O{lint},     # local interface to use
  'tls'             => \$O{tls},           # use TLS
  'tlso|tls-optional' => \$O{tls_optional}, # use tls if available
  'tlsc|tls-on-connect' => \$O{tls_on_connect}, # use tls if available
  'S|silent+'       => \$O{silent},        # suppress output to varying degrees
  'nsf|no-strip-from' => \$O{no_strip_from}, # Don't strip From_ line from DATA
  'nth|no-hints'    => \$O{no_hints},      # Don't show transaction hints
  'hr|hide-receive' => \$O{hide_receive},  # Don't show reception lines
  'hs|hide-send'    => \$O{hide_send},     # Don't show sending lines
  'stl|show-time-lapse:s' => \$O{show_time_lapse}, # print lapse for send/recv
  'ndf|no-data-fixup' => \$O{no_data_fixup}, # don't touch the data
  'dump'            => \$O{dump_args}      # build options and dump
) || exit(1);

load_modules({
  'Basic AUTH'             => ['MIME::Base64'],
  'AUTH CRAM-MD5'          => ['Digest::MD5'],
  'AUTH NTLM'              => ['Authen::NTLM'],
  'AUTH DIGEST-MD5'        => ['Authen::DigestMD5'],
  'MX lookups'             => ['Net::DNS'],
  'High resolution timing' => ['Time::HiRes'],
  'TLS'                    => ['Net::SSLeay'],
}, \%G::modules);
exit(0) if ($O{get_support}); # --support means report capabilities only

# We need to fix things up a bit and set a couple of global options
my $opts = process_args(\%O);

if ($G::dump_args) {
  print "from       = $opts->{from}\n";
  print "to         = $opts->{to}\n";
  print "helo       = $opts->{helo}\n";
  print "server     = $opts->{server}\n";
  print "port       = $opts->{port}\n";
  print "tls        = ";
  if ($G::tls) {
    print "starttls (", $G::tls_optional ? 'optional' : 'required', ")\n";
  } elsif ($G::tls_on_connect) {
    print "on connect (required)\n";
  } else { print "no\n"; }
  print "auth       = ";
  if ($opts->{a_type}) {
    print $G::auth_optional ? 'optional' : 'yes', " type='$opts->{a_type}' ",
          "user='$opts->{a_user}' pass='$opts->{a_pass}'\n";
  } else { print "no\n"; }
  print "quit after = $G::quit_after\n";
  print "local int  = $opts->{lint}\n";
  print "timeout    = $opts->{timeout}\n";
  print "data       = <<.\n$opts->{data}\n";
  exit(0);
}

sendmail($opts->{from}, $opts->{to}, $opts->{helo}, $opts->{data},
         $opts->{server}, $opts->{port}, $opts->{a_user}, $opts->{a_pass},
         $opts->{a_type}, $opts->{lint}, $opts->{timeout});

exit(0);

sub sendmail {
  my $from    = shift;	# envelope-from
  my $to      = shift;	# envelope-to
  my $helo    = shift;	# who am I?
  my $data    = shift;	# body of message (content after DATA command)
  my $host    = shift;	# receiving host
  my $port    = shift;	# where's the remote smtp process live?
  my $a_user  = shift;	# what user to auth with?
  my $a_pass  = shift;	# what pass to auth with
  my $a_type  = shift;	# what kind of auth (this must be set to to attempt)
  my $lint    = shift;	# what local interface to use
  my $timeout = shift;	# timeout for all transactions
  my $ehlo    = {};	# If server is esmtp, save advertised features here
  $|          = 1;

  print_transaction(11, "Trying $host:$port...");
  my $s       = IO::Socket::INET->new( PeerAddr  => $host, PeerPort => $port,
		                       Proto     => 'tcp', Timeout  => $timeout,
                                       LocalAddr => $lint);

  if ($@) {
    print_transaction(12,"Error connecting $lint to $host:$port:\n\t$@");
    exit(2);
  }
  print_transaction(11, "Connected to $host.");

  # start up tls if -tlsc specified
  if ($G::tls_on_connect) {
    if (start_tls($s)) {
      print_transaction(11, "TLS started w/ cipher $G::tls_cipher");
    } else {
      print_transaction(12, "TLS startup failed ($G::tls_res)");
      exit(29);
    }
  }

  # read the server's 220 banner
  if (!do_smtp_gen($s, undef, '220', $timeout)) {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(21);
  }

  # QUIT here if the user has asked us to do so
  if ($G::quit_after eq 'connect') {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(0);
  }

  # Send a HELO string
  if (!do_smtp_helo($s, $helo, $timeout, $ehlo)) {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(22);
  }

  # QUIT here if the user has asked us to do so
  if ($G::quit_after eq 'first-helo') {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(0);
  }

  # handle TLS here if user has requested it
  if ($G::tls) {
    if (!do_smtp_tls($s, $timeout, $ehlo) && !$G::tls_optional)
    {
      do_smtp_gen($s, 'QUIT', '221', $timeout);
      exit(29);
    }
  }

  # QUIT here if the user has asked us to do so
  if ($G::quit_after eq 'tls') {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(0);
  }

  if ($G::tls_active && $ehlo->{STARTTLS}) {
    # According to RFC3207, we need to forget state info and re-EHLO here
    $ehlo = {};
    if (!do_smtp_helo($s, $helo, $timeout, $ehlo)) {
      do_smtp_gen($s, 'QUIT', '221', $timeout);
      exit(32);
    }
  }

  # QUIT here if the user has asked us to do so
  if ($G::quit_after eq 'helo') {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(0);
  }

  # handle auth here if user has requested it
  if ($a_type) {
    if (!do_smtp_auth($s, $timeout, $ehlo, $a_type, $a_user, $a_pass, $host)
         && !$O{auth_optional})
    {
      do_smtp_gen($s, 'QUIT', '221', $timeout);
      exit(28);
    }
  }

  # QUIT here if the user has asked us to do so
  if ($G::quit_after eq 'auth') {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(0);
  }

  # send MAIL
  if (!do_smtp_gen($s, "MAIL FROM:<$from>", '250', $timeout)) {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(23);
  }

  # QUIT here if the user has asked us to do so
  if ($G::quit_after eq 'mail') {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(0);
  }

  # send RCPT
  my $num_accepted = 0;
  foreach my $r (split(/,/, $to)) {
    $num_accepted++ if (do_smtp_rcpt($s, $r, $timeout));
  }
  if (!$num_accepted) {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(24);
  }

  # QUIT here if the user has asked us to do so
  if ($G::quit_after eq 'rcpt') {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(0);
  }

  # send DATA
  if (!do_smtp_gen($s, "DATA", '354', $timeout)) {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(25);
  }

  # send the actual data
  if (!do_smtp_gen($s, "$data", '250', $timeout, undef, $O{supress_data})) {
    do_smtp_gen($s, 'QUIT', '221', $timeout);
    exit(26);
  }

  # send QUIT
  if (!do_smtp_gen($s, "QUIT", '221', $timeout)) {
    exit(27);
  }

  print_transaction(11,  "Connection closed by foreign host.");
}

sub start_tls {
  my $s = shift;
  $G::tls_res = undef; # shut up -w

  Net::SSLeay::load_error_strings();
  Net::SSLeay::SSLeay_add_ssl_algorithms();
  Net::SSLeay::randomize();
  $G::tls_con    = Net::SSLeay::CTX_new() || return(0);
  Net::SSLeay::CTX_set_options($G::tls_con, &Net::SSLeay::OP_ALL); # error check
  $G::tls_ssl    = Net::SSLeay::new($G::tls_con) || return(0);
  Net::SSLeay::set_fd($G::tls_ssl, fileno($s)); # error check?
  $G::tls_active = Net::SSLeay::connect($G::tls_ssl) == 1 ? 1 : 0;
  $G::tls_res    = Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
                       if (!$G::tls_active);
  $G::tls_cipher = Net::SSLeay::get_cipher($G::tls_ssl);

  return($G::tls_active);
}

sub print_transaction {
  my $c = shift;  # transaction flag
  my $m = shift;  # message to print
  my $b = shift;  # be brief in what we print
  my $o = \*STDOUT;
  my $f;

  return if (($O{hide_send}    && int($c/10) == 2) ||
             ($O{hide_receive} && int($c/10) == 3));

  # global option silent controls what we echo to the terminal
  # 0 - print everything
  # 1 - don't show anything until you hit an error, then show everything
  #     received after that (done by setting option to 0 on first error)
  # 2 - don't show anything but errors
  # >=3 - don't print anything
  if ($O{silent} > 0) {
    return if ($O{silent} >= 3);
    return if ($O{silent} == 2 && $c%2 != 0);
    if ($O{silent} == 1) {
      if ($c%2 != 0) {
        return();
      } else {
        $O{silent} = 0;
      }
    }
  }

  # 1x is program messages
  # 2x is smtp send
  # 3x is smtp recv
  # x = 1 is info/normal
  # x = 2 is error
  # program info
  if ($c == 11) { $f = '==='; }
  # program error
  elsif ($c == 12) { $f = '***'; $o = \*STDERR; }
  # smtp send info
  elsif ($c == 21) { $f = $G::tls_active ? ' ~>' : ' ->'; }
  # smtp send error
  elsif ($c == 22) { $f = $G::tls_active ? '*~>' : '**>'; }
  # smtp recv info
  elsif ($c == 31) { $f = $G::tls_active ? '<~ ' : '<- '; }
  # smtp recv error
  elsif ($c == 32) { $f = $G::tls_active ? '<~*' : '<**'; }
  # something went unexpectedly
  else { $c = '???'; }

  $f .= ' ';
  $f = '' if ($O{no_hints} && int($c/10) != 1);

  if ($b) {
    # split to tmp list to prevent -w gripe
    my @t = split(/\n/ms, $m); $m = scalar(@t) . " lines sent";
  }
  $m =~ s/\n/\n$f/msg;
  print $o "$f$m\n";
}

sub do_smtp_tls {
  my $s  = shift; # socket
  my $t  = shift; # timeout
  my $e  = shift; # ehlo config hash

  if (!$e->{STARTTLS}) {
    print_transaction(12, "STARTTLS not supported");
    return $G::tls_optional ? 1 : 0;
  } elsif (!do_smtp_gen($s, "STARTTLS", '220', $timeout)) {
    return $G::tls_optional ? 1 : 0;
  } elsif (!start_tls($s)) {
    print_transaction(12, "TLS startup failed ($G::tls_res)");
    return $G::tls_optional ? 1 : 0;
  }

  print_transaction(11, "TLS started w/ cipher $G::tls_cipher");
  return(1);
}

sub do_smtp_auth {
  my $s  = shift; # socket
  my $t  = shift; # timeout
  my $e  = shift; # ehlo config hash
  my $at = shift; # auth type
  my $au = shift; # auth user
  my $ap = shift; # auth password
  my $h  = shift; # host (used by digest-md5)

  # the auth_optional stuff is handled higher up, so tell the truth about
  # failing here

  if (($at ne 'ANY' && !$e->{AUTH}{$at}) || !$e->{AUTH}) {
    print_transaction(12, "$at authentication not supported");
    return(0);
  }

  if ($G::modules{"Digest::MD5"}) {
    foreach my $type (@{$G::auth_map_t{'CRAM-MD5'}}) {
      if (($at eq $type || $at eq 'ANY') && $e->{AUTH}{$type}) {
        return(1) if (do_smtp_auth_cram($s, $t, $au, $ap, $type));
      }
    }
  }
  if ($G::modules{"Authen::DigestMD5"}) {
    foreach my $type (@{$G::auth_map_t{'DIGEST-MD5'}}) {
      if (($at eq $type || $at eq 'ANY') && $e->{AUTH}{$type}) {
        return(1) if (do_smtp_auth_digest($s, $t, $au, $ap, $type, $h));
      }
    }
  }
  if ($G::modules{"Authen::NTLM"}) {
    foreach my $type (@{$G::auth_map_t{'NTLM'}}) {
      if (($at eq $type || $at eq 'ANY') && $e->{AUTH}{$type}) {
        return(1) if (do_smtp_auth_ntlm($s, $t, $au, $ap, $type));
      }
    }
  }
  foreach my $type (@{$G::auth_map_t{'PLAIN'}}) {
    if (($at eq $type || $at eq 'ANY') && $e->{AUTH}{$type}) {
      return(1) if (do_smtp_auth_plain($s, $t, $au, $ap, $type));
    }
  }
  foreach my $type (@{$G::auth_map_t{'LOGIN'}}) {
    if (($at eq $type || $at eq 'ANY') && $e->{AUTH}{$type}) {
      return(1) if (do_smtp_auth_login($s, $t, $au, $ap, $type));
    }
  }

  print_transaction(12, "No authentication type succeeded");
  return(0);
}

sub do_smtp_auth_ntlm {
  my $s = shift; # socket
  my $t = shift; # timeout
  my $u = shift; # auth user
  my $p = shift; # auth password
  my $as = shift; # auth type (since NTLM might be SPA or MSN)
  my $r = '';    # will store smtp response
  my $domain;
  ($u,$domain) = split(/%/, $u);
  
  my $auth_string = "AUTH $as";
  do_smtp_gen($s, $auth_string, '334', $t) || return(0);

  my $d = decode_base64(Authen::NTLM::ntlm());

  $auth_string = encode_base64("$d", '');
  do_smtp_gen($s, $auth_string, '334', $t, \$r, '', $G::auth_showpt ? "$d" : '',
              $G::auth_showpt ? \&unencode_smtp : '') || return(0);

  $r =~ s/^....//; # maybe something a little better here?
  Authen::NTLM::ntlm_domain($domain);
  Authen::NTLM::ntlm_user($u);
  Authen::NTLM::ntlm_password($p);
  $d = decode_base64(Authen::NTLM::ntlm($r));

  $auth_string = encode_base64("$d", '');
  do_smtp_gen($s, $auth_string, '235', $t, \$r, '',
              $G::auth_showpt ? "$d" : '') || return(0);

  return(1);
}

sub do_smtp_auth_digest {
  my $s = shift; # socket
  my $t = shift; # timeout
  my $u = shift; # auth user
  my $p = shift; # auth password
  my $as = shift; # auth string
  my $h = shift; # host (used in digest-uri)
  my $r = '';    # will store smtp response
  
  my $auth_string = "AUTH $as";
  do_smtp_gen($s, $auth_string, '334', $t, \$r, '', '',
              $G::auth_showpt ? \&unencode_smtp : '')
      || return(0);

  $r =~ s/^....//; # maybe something a little better here?
  $r = decode_base64($r);
  my $req = Authen::DigestMD5::Request->new($r);
  my $res = Authen::DigestMD5::Response->new();
  $res->got_request($req);
  $res->set('username' => $u, 'realm' => '',
            'digest-uri' => "smtp/$h");
  $res->add_digest(password => $p);
  my $d = $res->output();
  $auth_string = encode_base64("$d", '');

  do_smtp_gen($s, $auth_string, '334', $t, \$r, '', $G::auth_showpt ? "$d" : '',
              $G::auth_showpt ? \&unencode_smtp : '')
      || return(0);
  $r =~ s/^....//; # maybe something a little better here?
  $r = decode_base64($r);
  $req->input($r);
  return(0) if (!$req->auth_ok);

  do_smtp_gen($s, "", '235', $t, undef, '',
              $G::auth_showpt ? "" : '') || return(0);
  return(1);
}

sub do_smtp_auth_cram {
  my $s  = shift; # socket
  my $t  = shift; # timeout
  my $u  = shift; # auth user
  my $p  = shift; # auth password
  my $as = shift; # auth string
  my $r  = '';    # will store smtp response
  
  my $auth_string = "AUTH $as";
  do_smtp_gen($s, $auth_string, '334', $t, \$r, '', '',
              $G::auth_showpt ? \&unencode_smtp : '')
      || return(0);

  $r =~ s/^....//; # maybe something a little better here?
  my $d = get_digest($p, $r);
  $auth_string = encode_base64("$u $d", '');

  do_smtp_gen($s, $auth_string, '235', $t, undef, '',
              $G::auth_showpt ? "$u $d" : '') || return(0);
  return(1);
}

sub do_smtp_auth_login {
  my $s = shift; # socket
  my $t = shift; # timeout
  my $u = shift; # auth user
  my $p = shift; # auth password
  my $as = shift; # auth string
  my $z = '';
  
  my $auth_string = "AUTH $as";
  do_smtp_gen($s, $auth_string, '334', $t, undef, '', '', 
              $G::auth_showpt ? \&unencode_smtp : '') || return(0);
  $auth_string = encode_base64($u, '');
  $z = $u if ($G::auth_showpt);
  do_smtp_gen($s, $auth_string, '334', $t, undef, '', $z,
              $G::auth_showpt ? \&unencode_smtp : '') || return(0);
  $auth_string = encode_base64($p, '');
  $z = $p if ($G::auth_showpt);
  do_smtp_gen($s, $auth_string, '235', $t, undef, '', $z) || return(0);
  return(1);
}

sub do_smtp_auth_plain {
  my $s = shift; # socket
  my $t = shift; # timeout
  my $u = shift; # auth user
  my $p = shift; # auth password
  my $as = shift; # auth string
  
  my $auth_string = "AUTH $as " . encode_base64("\0$u\0$p", '');
  my $z = '';
  if ($G::auth_showpt) {
    $z = "AUTH $as \\0$u\\0$p";
  }
  return(do_smtp_gen($s, $auth_string, '235', $t, undef, '', $z));
}

sub do_smtp_helo {
  my $s = shift;  # socket
  my $h = shift;  # helo string to use
  my $t = shift;  # timeout
  my $e = shift;  # this is a hashref that will be populated w/ server options
  my $r = '';     # this'll be populated by do_smtp_gen

  if (do_smtp_gen($s, "EHLO $h", '250', $t, \$r)) {
    # $ehlo is designed to hold the advertised options, but I'm not sure how
    # to store them all - for instance, SIZE is a simple key/value pair, but
    # AUTH lends itself more towards a multilevel hash.  What I'm going to do
    # is come here and add each key in the way that makes most sense in each
    # case.  I only need auth for now.
    # XXX I don't think I'm handling AUTH=LOGIN right.  I think it just means
    # LOGIN and the = is not important - something to check if it's a problem.
    foreach my $l (split(/\n/, $r)) {
      $l =~ s/^....//;
      if ($l =~ /^AUTH(.*)$/) {
        map { $e->{AUTH}{$_} = 1 } (split(' ', $1));
      } elsif ($l =~ /^STARTTLS$/) {
        $e->{STARTTLS} = 1;
      }
    }
    return(1);
  } elsif (do_smtp_gen($s, "HELO $h", '250', $t)) {
    return(1);
  }

  return(0);
}

sub do_smtp_rcpt {
  my $s = shift;  # socket
  my $m = shift;  # string of comma separated recipients
  my $t = shift;  # timeout
  my $f = 0;      # The number of failures we've experienced

  my @a = split(/,/, $m);
  foreach my $addr (@a) {
    $f++ if (!do_smtp_gen($s, "RCPT TO:<$addr>", '250', $t));
  }

  # if at least one addr succeeded, we can proceed, else we stop here
  return $f == scalar(@a) ? 0 : 1;
}

sub do_smtp_gen {
  my $s = shift; # socket
  my $m = shift; # string to send
  my $e = shift; # String we're expecting to get back
  my $t = shift; # timeout
  my $p = shift; # this is a scalar ref, assign the server return string to it
  my $b = shift; # be brief in the data we send
  my $x = shift; # if this is populated, print this instead of $m
  my $c = shift; # if this is a code ref, call it on the return value b4 print
  my $r = '';    # This'll be the return value from transact()
  my $time;

  print_transaction(21, $x ? $x : $m, $b) if (defined($m));
  if ($G::show_time_lapse) {
    if ($G::show_time_hires) {
      $time = [Time::HiRes::gettimeofday()]
    } else {
      $time = time() if ($G::show_time_lapse);
    }
  }
  $r  = transact($s, $m, '', $t);
  $$p = $r;
  
  if ($G::show_time_lapse) {
    if ($G::show_time_hires) {
      $time = sprintf("%0.03f", Time::HiRes::tv_interval($time,
                               [Time::HiRes::gettimeofday()]));
    } else {
      $time = time() - $time;
    }
    print_transaction(11, "response in ${time}s");
  }

  $r = &$c($r) if (ref($c) eq 'CODE');
  if ($r !~ /^$e /m) {
    print_transaction(32, $r);
    return(0);
  } else {
    print_transaction(31, $r);
    return(1);
  }
}

sub transact {
  my $s    = shift;       # This is my IO::Socket object
  my $send = shift;       # This is the string to send
  my $buff = shift;       # we will store and manipulate the return value here.
  my $alrm = shift || 0; # change timeout here so we can have it wait forever

  eval {
    local $SIG{'ALRM'} = sub {
      $buff = "Timeout ($alrm secs) waiting for server response";
      die;
    };
    if (defined($send)) {
      if ($G::tls_active) {
        my $res = Net::SSLeay::write($G::tls_ssl, "$send\r\n");
      } else {
        print $s $send, "\r\n";
      }
    }
    alarm($alrm);
    if ($buff) {
      $buff = '';
    } else {
      # The 'do' allows for multi-line responses
      if ($G::tls_active) {
        $buff = Net::SSLeay::read($G::tls_ssl);
      } else {
        do {
          $buff .= <$s>;
        } while ($buff !~ /^\d\d\d /m);
      }
      $buff =~ s/\r//msg;
      chomp($buff);
    }
    alarm(0);
  };
  return($buff);
}

sub unencode_smtp {
  my $t = shift;

  my @t = split(' ', $t);
  return("$t[0] " . decode_base64($t[1]));
}

sub process_file {
  my $f = shift;
  my $h = shift;

  if (! -e "$f") {
    print_transaction(12, "File $f does not exist, skipping");
    return;
  } elsif (! -f "$f") {
    print_transaction(12, "File $f is not a file, skipping");
    return;
  } elsif (!open(I, "<$f")) {
    print_transaction(12, "Couldn't open $f, skipping... ($!)");
    return;
  }

  while (<I>) {
    chomp;
    next if (/^#?\s*$/); # skip blank lines and those that start w/ '#'
    my($key,$value) = split(' ', $_, 2);
    $h->{uc($key)} = $value;
  }
  return;
}

sub interact {
  my($prompt) = shift;
  my($regexp) = shift;
  my($continue) = shift;
  my($response) = '';

  do {
    print "$prompt";
    chomp($response = <STDIN>);
  } while ($regexp ne 'SKIP' && $response !~ /$regexp/);

  return($response);
}

sub get_hostname {
  # in some cases hostname returns value but gethostbyname doesn't.
  my $h = hostname();
  return("") if (!$h);
  my $l = (gethostbyname($h))[0];
  return($l || $h);
}

sub get_server {
  my $addr   = shift;
  my $pref   = -1;
  my $server = "localhost";

  if ($addr =~ /\@\[(\d+\.\d+\.\d+\.\d+)\]$/) {
    # handle automatic routing of domain literals (user@[1.2.3.4])
    return($1);
  } elsif ($addr =~ /\@\#(\d+)$/) {
    # handle automatic routing of decimal domain literals (user@#16909060)
    $addr = $1;
    return(($addr/(2**24))%(2**8) . '.' . ($addr/(2**16))%(2**8) . '.'
          .($addr/(2**8))%(2**8)  . '.' . ($addr/(2**0))%(2**8));
  }

    
  
  if (!$G::modules{"Net::DNS"}) {
    print_transaction(12,
      "MX requirement Net::DNS not installed, using $server as mail server");
    return($server);
  }
  my $res = new Net::DNS::Resolver;

  return($server) if ($addr !~ /\@/);

  $addr =~ s/^.*\@([^\@]*)$/$1/;
  return($server) if (!$addr);
  $server = $addr;

  my @mx = mx($res, $addr);
  foreach my $rr (@mx) {
    if ($rr->preference < $pref || $pref == -1) {
      $pref   = $rr->preference;
      $server = $rr->exchange;
    }
  }
  return($server);
}

sub try_load {
  my $mod = shift;

  eval("use $mod");
  return $@ ? 0 : 1;
}

sub get_digest {
  my $secr = shift;
  my $chal = shift;
  my $retr = '';
  my $ipad = chr(0x36);
  my $opad = chr(0x5c);
  my($isec, $osec) = undef;

  if ($chal !~ /^</) {
    chomp($chal = decode_base64($chal));
  }

  if (length($secr) > 64) {
    $secr = Digest::MD5::md5($secr);
  } else {
    $secr .= chr(0) x (64 - length($secr));
  }

  foreach my $char (split(//, $secr)) {
    $isec .= $char ^ $ipad;
    $osec .= $char ^ $opad;
  }

  map { $retr .= sprintf("%02x", ord($_)) }
            split(//,Digest::MD5::md5($osec.Digest::MD5::md5($isec . $chal)));
  return($retr);
}

sub load_modules {
  my $s = shift;
  my $l = shift;

  foreach my $act (keys %$s) {
    my @failed = ();
    foreach my $m (@{$s->{$act}}) {
      if (try_load($m)) {
        $l->{$m}++;
      } else {
        push(@failed, $m);
      }
    }
    if ($O{get_support}) {
      if (scalar(@failed) > 0) {
        print_transaction(12, "$act not available: requires " .
            join(', ', @failed));
      } else {
        print_transaction(11, "$act supported");
      }
    }
  }
}

sub time_to_seconds {
  my $t = shift || 30;

  if ($t !~ /^(\d+)([hms])?/i) {
    return(30); # error condition - just use default value
  } else {
    my $r = $1;
    my $u = lc($2);
    if ($u eq 'h') {
      return($r * 3600);
    } elsif ($u eq 'm') {
      return($r * 60);
    } else {
      return($r);
    }
  }
}

# A couple of global options are set in here, they will be in the G:: namespace
sub process_args {
  my $o     = shift; # This is the args we got from command line
  my %n     = ();    # This is the hash we will return w/ the fixed-up args
  my $fconf = {};    # Hold config info from -l file if specified

  # load the $fconf hash if user has specified a -l file
  process_file($o->{option_file}, $fconf) if ($o->{option_file});

  $G::dump_args = 1 if ($o->{dump_args});
  
  # set global option of -q option
  if ($o->{quit_after}) {
    $G::quit_after = lc($o->{quit_after});
    if ($G::quit_after eq 'ehlo')          { $G::quit_after = 'helo';       }
    elsif ($G::quit_after eq 'first-ehlo') { $G::quit_after = 'first-helo'; }
    elsif ($G::quit_after eq 'starttls')   { $G::quit_after = 'tls';        }
    elsif ($G::quit_after eq 'from')       { $G::quit_after = 'mail';       }
    elsif ($G::quit_after eq 'to')         { $G::quit_after = 'rcpt';       }
    elsif ($G::quit_after ne 'connect' && $G::quit_after ne 'first-helo' &&
           $G::quit_after ne 'tls'     && $G::quit_after ne 'helo'       &&
           $G::quit_after ne 'auth'    && $G::quit_after ne 'mail'       &&
           $G::quit_after ne 'rcpt')
    {
      print_transaction(12, "Unknown quit value $G::quit_after, exiting");
      exit(1);
    }
    # only rcpt _requires_ a to address
    $G::server_only = 1 if ($G::quit_after ne 'rcpt');
  } else {
    $G::quit_after = '';
  }

  # set global flag for -stl flag
  $G::show_time_lapse = time() if (defined($o->{show_time_lapse}));
  $G::show_time_hires = 1
      if ($G::modules{'Time::HiRes'} && $o->{show_time_lapse} !~ /^i/i);

  if ($o->{emulate_mail}) { # set up for -m option
    $n{to} = shift if (!defined($o->{mail_to}));
    $o->{mail_data} = ''; # define it here so we get it on stdin later
  }

  # SMTP mail from
  $n{from} = $o->{mail_from} || interact("From: ", '^.*$')
      if (defined($o->{mail_from}));
  $n{from} ||= $fconf->{FROM} || ($hostname ? "$user\@$hostname" :
                                             interact("From: ", '^.*$'));
  $n{from} = '' if ($n{from} eq '<>');

  # SMTP helo/ehlo
  $n{helo} = $o->{mail_helo} || interact("Helo: ", '^.*$')
      if (defined($o->{mail_helo}));
  $n{helo} ||= $fconf->{HELO} || ($hostname ? $hostname :
                                             interact("Helo: ", '^.*$'));

  # SMTP server and rcpt to are interdependant, so they are handled together
  $n{server} = $o->{mail_server} || interact("Server: ", '^.*$')
      if (defined($o->{mail_server}));
  $n{server} ||= $fconf->{SERVER};
  $n{to} = $o->{mail_to} || interact("To: ", '^.*$')
      if (defined($o->{mail_to}));
  $n{to} ||= $fconf->{TO};
  $n{to} = interact("To: ", '^.*$') if (!$n{to} &&
                                        !($G::server_only && $n{server}));
  $n{server} = get_server($n{to}) if (!$n{server});

  # local interface to connect from
  $n{lint} = $o->{lint} || interact("Interface: ", '^.*$')
      if (defined($o->{lint}));
  $n{lint} ||= $fconf->{INTERFACE} || '0.0.0.0';

  # SMTP timeout
  $o->{timeout} = '0s' if ($o->{timeout} eq '0'); # used 'eq' on purpose
  $n{timeout} = $o->{timeout} || interact("Timeout: ", '^\d+[hHmMsS]?$')
      if (defined($o->{timeout}));
  $n{timeout} ||= $fconf->{TIMEOUT} || '30s';
  $n{timeout} = time_to_seconds($n{timeout});

  # SMTP DATA
  # a '-' arg to -d is the same as setting -g
  if ($o->{mail_data} eq '-') {
    undef($o->{mail_data});
    $o->{data_on_stdin} = 1;
  }
  if (defined($o->{mail_data}) && !defined($o->{data_on_stdin})) {
    if (defined($o->{emulate_mail})) {
      $n{data} = "Subject: " . interact("Subject: ", 'SKIP') . "\n\n";
      do {
        $n{data} .= interact('', 'SKIP') . "\n";
      } while ($n{data} !~ /\n\.\n$/ms);
      $n{data} =~ s/\n\.\n$//ms;
    } else {
      $n{data} = $o->{mail_data} || interact("Data: ", '^.*$');
    }
  }
  $n{data} ||= $fconf->{DATA}
           || 'Date: %D\nTo: %T\nFrom: %F\nSubject: test %D\n'
             ."X-Mailer: swaks v$p_version jetmore.org/john/code/#swaks".'\n\n'
             .'This is a test mailing\n';
  # The -g option trumps all other methods of getting the data
  $n{data}   = join('', <STDIN>) if ($o->{data_on_stdin});
  if (!$o->{no_data_fixup}) {
    $n{data} =~ s/\\n/\r\n/g;
    $n{data} =~ s/%F/$n{from}/g;
    $n{data} =~ s/%T/$n{to}/g;
    $n{data} =~ s/%D/get_date_string()/eg;
    $n{data} =~ s/^From [^\n]*\n// if (!$O{no_strip_from});
    $n{data} =~ s/\r?\n\.\r?\n?$//s;  # If there was a trailing dot, remove it
    $n{data} =~ s/\n\./\n../g;        # quote any other leading dots
    # translate line endings - use while to fake out /g
    while ($n{data} =~ s/([^\r])\n/$1\r\n/s) { 1; } 
    $n{data} .= "\r\n.";              # add a trailing dot
  }

  # Handle TLS options
  $G::tls_optional   = 1 if (defined($o->{tls_optional}));
  $G::tls            = 1 if (defined($o->{tls}) || $G::tls_optional);
  $G::tls_on_connect = 1 if (defined($o->{tls_on_connect}));
  $G::tls_active = 0;
  if ($G::tls || $G::tls_on_connect) {
    if (!$G::modules{'Net::SSLeay'}) {
      if ($G::tls_optional) {
        $G::tls = undef; # so we won't try it later
        print_transaction(12,
            'TLS requirement Net::SSLeay not installed, skipping optional TLS');
      } else {
        print_transaction(12,
            'TLS requirement Net::SSLeay not installed, exiting');
        exit(10);
      }
    }
  }

  # SMTP port
  $n{port} = $o->{mail_port} || interact("Port: ", '^\d+$')
      if (defined($o->{mail_port}));
  $n{port} ||= $fconf->{PORT} || ($G::tls_on_connect ? 465 : 25);

  # Handle AUTH options
  $G::auth_optional = 1 if (defined($o->{auth_optional}));
  $o->{auth} = uc($o->{auth}) if ($o->{auth});
  $o->{auth} = uc($o->{auth_optional}) if ($o->{auth_optional} && !$o->{auth});
  $o->{auth} = 'ANY' if (!$o->{auth} && (defined($o->{auth_user}) ||
                         defined($o->{auth_pass}) || $o->{auth_optional}));
  $o->{auth} = 'ANY' if (defined($o->{auth}) && !$o->{auth});
  if ($o->{auth}) {
    foreach (split(/\s+,\s+/, $o->{auth_map}),"PLAIN=PLAIN","LOGIN=LOGIN",
             "CRAM-MD5=CRAM-MD5","DIGEST-MD5=DIGEST-MD5","NTLM=NTLM",
             "SPA=NTLM","MSN=NTLM")
    {
      my($alias,$type) = split(/=/, uc($_), 2);
      $G::auth_map_f{$alias} = $type;
      $G::auth_map_t{$type} ||= [];
      push(@{$G::auth_map_t{$type}}, $alias);
    }
    if (!$G::modules{"MIME::Base64"}) {
      if ($G::auth_optional) {
        $n{a_type} = ''; # So we won't attempt it later
        print_transaction(12,
         'AUTH requirement MIME::Base64 not installed, skipping optional AUTH');
      } else {
        print_transaction(12,
         'AUTH requirement MIME::Base64 not installed, exiting');
        exit(10);
      }
    } elsif (!$G::modules{"Digest::MD5"} &&
              $G::auth_map_f{$o->{auth}} eq 'CRAM-MD5')
    {
      if ($G::auth_optional) {
        $n{a_type} = ''; # So we won't attempt it later
        print_transaction(12,
          'AUTH:CRAM-MD5 requirement Digest::MD5 not installed, ' .
          'skipping optional AUTH:CRAM-MD5');
      } else {
        print_transaction(12,
          'AUTH:CRAM-MD5 requirement Digest::MD5 not installed, exiting');
        exit(10);
      }
    } elsif (!$G::modules{"Authen::NTLM"} &&
              $G::auth_map_f{$o->{auth}} eq 'NTLM') {
      if ($G::auth_optional) {
        $n{a_type} = ''; # So we won't attempt it later
        print_transaction(12,
          'AUTH:NTLM requirement Authen::NTLM not installed, ' .
          'skipping optional AUTH:NTLM');
      } else {
        print_transaction(12,
          'AUTH:NTLM requirement Authen::NTLM not installed, exiting');
        exit(10);
      }
    } elsif (!$G::modules{"Authen::DIGEST-MD5"} &&
              $G::auth_map_f{$o->{auth}} eq 'DIGEST-MD5') {
      if ($G::auth_optional) {
        $n{a_type} = ''; # So we won't attempt it later
        print_transaction(12,
          'AUTH:DIGEST-MD5 requirement Authen::DigestMD5 not installed, ' .
          'skipping optional AUTH:DIGEST-MD5');
      } else {
        print_transaction(12,
          'AUTH:DIGEST-MD5 requirement Authen::DigestMD5 not installed, ' .
          'exiting');
        exit(10);
      }
    } else {
      $n{a_user}   = $o->{auth_user} if (defined($o->{auth_user}));
      $n{a_user} ||= $fconf->{USER};
      $n{a_user} ||= interact("Username: ", 'SKIP');
      $n{a_user}   = '' if ($a_user eq '<>');

      $n{a_pass}   = $o->{auth_pass} if (defined($o->{auth_pass}));
      $n{a_pass} ||= $fconf->{PASS};
      $n{a_pass} ||= interact("Password: ", 'SKIP');
      $n{a_pass}   = '' if ($a_pass eq '<>');
  
      $n{a_type} = $o->{auth};
      $G::auth_showpt = 1 if (defined($o->{auth_showpt}));
      # This option is designed to hide passwords - turn echo off when 
      # supplying at PW prompt, star out the PW strings in AUTH transactions.
      # Not implementing right now - the echo might be a portability issue, 
      # and starring out is hard because the smtp transaction is abstracted 
      # beyond where this is easy to do.  Maybe sometime in the future
      #$G::auth_hidepw = 1 if (defined($o->{auth_hidepw}));
    }
  }

  return(\%n);
}

sub get_date_string {
  return($G::date_string) if (length($G::date_string) > 0);

  my @l = localtime();
  my @g = gmtime();
  $G::date_string = sprintf("%s, %02d %s %d %02d:%02d:%02d %+05d",
                 (qw(Sun Mon Tue Wed Thu Fri Sat))[$l[6]],
                 $l[3],
                 (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$l[4]],
                 $l[5]+1900, $l[2], $l[1], $l[0],
                 (timelocal(@l) - timelocal(@g))/36
                    );
}

sub ext_usage {
  if ($ARGV[0] =~ /^--help$/i) {
    require Config;
    $ENV{PATH} .= ":" unless $ENV{PATH} eq "";
    $ENV{PATH} = "$ENV{PATH}$Config::Config{'installscript'}";
    $< = $> = 1 if ($> == 0 || $< == 0);
    exec("perldoc", $0) || exit(1);
    # make parser happy
    %Config::Config = ();
  } elsif ($ARGV[0] =~ /^--version$/i) {
    print "$p_name version $p_version\n\n$p_cp\n";
  } else {
    return;
  }

  exit(0);
}

__END__

=head1 NAME

swaks - SMTP transaction tester

=head1 USAGE

swaks [--help|--version] | (see description of options below)

=head1 OPTIONS

=over 4

=item -l, --input-file

Argument to -l must be a path to a file containing TOKEN->VALUE pairs.  The TOKEN and VALUE must be separated by whitespace.  These tokens set values which would otherwise be set by command line arguments.  See the description of the corresponding command line argument for details of each token.  Valid tokens are FROM (-f), TO (-t), SERVER (-s), DATA (-d), HELO (-h), PORT (-p), INTERFACE (-li), and TIMEOUT (-to).

=item -t, --to

Use argument as "RCPT TO" address, or prompt user if no argument specified.  Overridden by -l token TO.  Multiple recipients can be specified by supplying as one comma-delimited argument.

There is no default for this option.  If no to addess is specified with -t or TO token, user will be prompted for To: address on STDIN.

=item -f, --from

Use argument as "MAIL FROM" address, or prompt user if no argument specified.  Overridden by -l token FROM.  If no from address is specified, default is user@host, where user is the best guess at user currently running program, and host is best guess at DNS hostname of local host.  The string <> can be supplied to mean the null sender.

=item -s, --server

Use argument as mail server to which to connect, or prompt user if no argument specified.  Overridden by -l token SERVER.  If unspecified, swaks tries to determine primary MX of destination address.  If Net::DNS module is not available, tries to connect to A record for recipient's domain.

=item -p, --port

Use argument as port to connect to on server, or prompt user if no argument is specified.  Overridden by -l token PORT.  If unspecified, swaks will try to connect to port 25.

=item -h, --helo, --ehlo

Use argument as argument to SMTP EHLO/HELO command, or prompt use if no argument is specified.  Overridden by -l token HELO.  If unspecified, swaks uses best guess at DNS hostname of local host.

=item -d, --data

Use argument as DATA portion of SMTP transaction, or prompt user if no argument specified.  Overridden by -l token DATA.

This string should be on one single line, with a literal \n representing where line breaks should be placed.  Leading dots will be quoted.  Closing dot is not required but is allowed.  Very basic token parsing is done.  %F is replaced with the value that will be used for "MAIL FROM", %T is replaced with "RCPT TO" values, and %D is replaced with a timestamp.

Default value for this option is "Date: %D\nTo: %T\nFrom: %F\nSubject: test %D\nX-Mailer: swaks v$p_version jetmore.org/john/code/#swaks\n\nThis is a test mailing\n".

=item --timeout

Use argument as the SMTP transaction timeout, or prompt user if no argument given.  Overridden by the -l token TIMEOUT.  Argument can either be a pure digit, which will be interpretted as seconds, or can have a specifier s or m (5s = 5 seconds, 3m = 180 seconds).  As a special case, 0 means don't timeout the transactions.  Default value is 30s.

=item -li, --local-interface

Use argument as the local interface for the SMTP connection, or prompt user if no argument given.  Overridden by the -l token INTERFACE.  Argument can be an IP or a hostname.  Default action is to let OS choose local interface.

=item -g

If specified, swaks will read the DATA value for the mail from STDIN.  If there is a From_ line in the email, it will be removed (but see -nsf option).  Useful for delivering real message (stored in files) instead of using example messages.

=item -nsf, --no-strip-from

Don't strip the From_ line from the DATA portion, if present.

=item -n, --suppress-data

If this option is specified, swaks summarizes the DATA portion of the SMTP transaction instead of printing every line.

=item -q, --quit-after

The argument to this option is used as an indicator of where to quit the SMTP transaction.  It can be thought of as "quit after", with valid arguments CONNECT, FISRT-HELO, TLS, HELO, AUTH, MAIL, and RCPT.  In a non-STARTTLS session, FIRST-HELO and HELO behave the same way.  In a STARTTLS session, FIRST-HELO quits after the first HELO sent, while HELO quits after the second HELO is sent.

=item -m

Emulate Mail command.  Least used option in swaks.

=item --support

Cause swaks to print its capabilities and exit.  Certain features require non-standard perl modules.  This options evaluates whether these modules are present and lets you know which functionality is present.

=item -S, --silent

Cause swaks to be silent.  "-S" causes swaks to print no output until an error occurs, after which all output is shown.  "-S -S" causes swaks to only show error conditions.  "-S -S -S" shows no output.

=item -tls

Require connection to use STARTTLS.  Exit if TLS not available for any reason (not advertised, negotiations failed, etc).

=item -tlso, --tls-optional

Attempt to use STARTTLS if possible, continue t/ normal transaction if TLS unavailable.

=item -tlsc, --tls-on-connect

Initiate a TLS connection immediately on connection.  Use to test smtps/ssmtp servers.  If this options is specified, the default port changes from 25 to 465, though this can still be overridden with the -p option.

=item -a, --auth

Require authentication.  If Authentication fails or is unavailable, stop transaction.  -a can take an argument specifying which type of authentication to use.  swaks currently supports PLAIN, LOGIN, and CRAM-MD5.  If no argument is given any available authentication type is used.  If neither password (-ap) or username (-au) is supplied on command line, swaks will prompt on STDIN.

SPA (NTLM/MSN) authentication is now supported.  Tested as a client against Exim and Stalker's CommuniGate, but implementation may be incomplete.  Authen::NTLM is currently required.  Note that CPAN hosts two different Authen::NTLM modules.  Current implementation requires Mark Bush's implementation (Authen/NTLM-1.02.tar.gz).  Plan to reimplement directly at some point to avoid confusion.

DIGEST-MD5 is now supported.  Tested as a client only against Stalker's Communigate, so implementation may be incomplete.  Requires Authen::DigestMD5 module.

=item -ao, --auth-optional

Same as -a, but if authentication is unavailable or fails, attempts to continue transaction.

=item -au, --auth-user

Supply the username for authentication.  The string <> can be supplied to mean an empty username.

For SPA authentication, a "domain" can be specified after the regular username with a % seperator.  For instance, if "-ap user@example.com%NTDOM" is passed, "user@example.com" is the username and "NTDOM" is the domain.  NOTE: I don't actually have access to a mail server where the domain isn't ignored, so this may be implemented incorrectly.

=item -ap, --auth-password

Supply the password for authentication.  The string <> can be supplied to mean an empty password.

=item -am --auth-map

Provides a way to map alternate names onto base authentication types.  Useful for any sites that use alternate names for common types.  This functionality is actually used internally to map types SPA and MSN onto the base type NTLM.  The command line argument to simulate this would be "--auth-map SPA=NTLM,MSN=NTLM".  The base types supported are LOGIN, PLAIN, CRAM-MD5, DIGEST-MD5, and NTLM.  SPA and MSN are mapped on to NTLM automatically.

=item -apt, --auth-plaintext

Instead of showing AUTH strings literally (in base64), translate them to plaintext before printing on screen.

=item -nth, --no-hints

Don't show transaction hints.  (Useful in conjunction with -hr to create copy/paste-able transactions

=item -hr, --hide-receive

Don't display reception lines

=item -hs, --hide-send

Don't display sending lines

=item -stl, --show-time-lapse

Display time lapse between send/receive pairs.  If 'i' is provided as argument or the Time::HiRes module is unavailable the time lapse will be integer only, otherwise it will be to the thousandth of a second.

=item --help

This screen.

=item --version

Version info.

=back

=head1 EXAMPLES

=over 4

=item swaks

prompt user for to address and send a default email.

=item cat mailfile | swaks -g -n -t user@example.com -tlso -a -au user -ap password

send the contents of "mailfile" to user@example.com, using TLS if available, requiring authentication, using user/password as authentication information.

=back

=head1 COMMENTS

This program was written because I was testing a new MTA on an alternate port.  I did so much testing that using interactive telnet grew tiresome.  Over the next several years this program was fleshed out and every single option was added as a direct need of some testing I was doing as the mail admin of a medium sized ISP, with the exception of TLS support which was added on a whim.  As such, all options are reasonably well thought out and fairly well tested (though TLS could use more testing).

=head1 REQUIRES

=over 4

=item IO::Socket, Sys::Hostname, Getop::Long, Time::Local

These modules are all required for the program to run at all.  This shouldn't be an issue as I believe these are all core modules.

=item Net::DNS

This module is required to look up MX records for domains.  If unavailable the -s option can be used to statically route the message.

=item Net::SSLeay

This module is required for TLS sessions.  STARTTLS will not be supported if module is unavailable.

=item MIME::Base64

This module is required for all SMTP AUTH transactions.  If it is unavailable no AUTH methods will be supported.

=item Digest::MD5

This module is required for CRAM-MD5 authentication.

=item Authen::NTLM

This module is required for SPA/MSN/NTLM authentication.  Note that there are two modules using the Authen::NTLM namespace on CPAN.  The Mark Bush implementation (Authen/NTLM-1.02.tar.gz) is the version required here.

=item Authen::DigestMD5

This module is required for DIGEST-MD5 authentication.

=item Time::HiRes

This module is required for high resolution timing.  If unavailable only integer timing is available.

=back

=head1 EXIT CODES

=over 4

=item 0

no errors occurred

=item 1

error parsing command line options

=item 2

error connecting to remote server

=item 10

error in prerequisites (needed module not available)

=item 21

error reading initial banner from server

=item 22

error in HELO transaction

=item 23

error in MAIL transaction

=item 24

no RCPTs accepted

=item 25

server returned error to DATA request

=item 26

server did not accept mail following data

=item 27

server returned error after normal-session quit request

=item 28

error in AUTH transaction

=item 29

error in TLS transaction

=item 32

error in EHLO following TLS negotiation

=back

=head1 CONTACT

=over 4

=item proj-swaks@jetmore.net

=back

=cut