Up to 20201014.0.

[packages/swaks.git] / swaks.pl

#!/usr/bin/perl

# use 'swaks --help' to view documentation for this program
# if you want to be notified about future releases of this program,
#	please send an email to updates-swaks@jetmore.net

use strict;

my($p_name)   = $0 =~ m|/?([^/]+)$|;
my $p_version = "20061116.0";
my $p_usage   = "Usage: $p_name [--help|--version] (see --help for details)";
my $p_cp      = <<EOM;
        Copyright (c) 2003-2006 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
EOM
ext_usage(); # before we do anything else, check for --help

my %O        = ();
$|           = 1;

# need to rewrite header-HEADER opts before std option parsing
for (my $i = 0; $i < scalar(@ARGV); $i++) {
  if ($ARGV[$i] =~ /^--h(?:eader)?-(.*)$/) {
    $ARGV[$i] = "--header";  $ARGV[$i+1] = "$1: $ARGV[$i+1]";
  }
}
if (!load("Getopt::Long")) {
    ptrans(12, "Unable to load Getopt::Long for option processing, Exiting");
    exit(1);
}
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|lhlo:s' => \$O{mail_helo},  # (h)elo string
  's|server:s'      => \$O{mail_server},   # (s)erver to use
  'p|port:s'        => \$O{mail_port},     # (p)ort to use
  'protocol:s'      => \$O{mail_protocol}, # protocol to use (smtp, esmtp, lmtp)
  '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{suppress_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
  'pipe:s'          => \$O{pipe_cmd},      # command to communicate with
  'socket:s'        => \$O{socket},        # unix domain socket to talk to
  'body:s'          => \$O{body_822},      # the content of the body of the DATA
  'attach-type|attach:s' => \@{$O{attach_822}}, # A file to attach
  'ah|add-header:s' => \@{$O{add_header}}, # replacement for %H DATA token
  'header:s'        => \@{$O{header}},     # replace header if exist, else add
  'dump'            => \$O{dump_args},     # build options and dump
  'pipeline'        => \$O{pipeline},      # attempt PIPELINING
  'force-getpwuid'  => \$O{force_getpwuid} # use getpwuid building -f
) || exit(1);

# lists of dependencies for features
%G::dependencies = (
  auth            => { name => "Basic AUTH",     opt => ['MIME::Base64'],
                       req  => [] },
  auth_cram_md5   => { name => "AUTH CRAM-MD5",  req => ['Digest::MD5'] },
  auth_cram_sha1  => { name => "AUTH CRAM-SHA1", req => ['Digest::SHA1'] },
  auth_ntlm       => { name => "AUTH NTLM",      req => ['Authen::NTLM'] },
  auth_digest_md5 => { name => "AUTH DIGEST-MD5",
                       req  => ['Authen::DigestMD5'] },
  dns             => { name => "MX Routing",     req => ['Net::DNS'] },
  tls             => { name => "TLS",            req => ['Net::SSLeay'] },
  pipe            => { name => "Pipe Transport", req => ['IPC::Open2'] },
  socket          => { name => "Socket Transport", req => ['IO::Socket'] },
  date_manip      => { name => "Date Manipulation", req => ['Time::Local'] },
  hostname        => { name => "Local Hostname Detection",
                       req  => ['Sys::Hostname'] },
  hires_timing    => { name => "High Resolution Timing",
                       req  => ['Time::HiRes'] },
);

if ($O{get_support}) {
  test_support();
  exit(0);
}

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

if ($G::dump_args) {
  test_support();
  print "dump_args        = ", $G::dump_args ? "TRUE" : "FALSE", "\n";
  print "server_only      = ", $G::server_only ? "TRUE" : "FALSE", "\n";
  print "show_time_lapse  = ", $G::show_time_lapse ? "TRUE" : "FALSE", "\n";
  print "show_time_hires  = ", $G::show_time_hires ? "TRUE" : "FALSE", "\n";
  print "auth_showpt      = ", $G::auth_showpt ? "TRUE" : "FALSE", "\n";
  print "suppress_data    = ", $G::suppress_data ? "TRUE" : "FALSE", "\n";
  print "no_hints         = ", $G::no_hints ? "TRUE" : "FALSE", "\n";
  print "hide_send        = ", $G::hide_send ? "TRUE" : "FALSE", "\n";
  print "hide_receive     = ", $G::hide_receive ? "TRUE" : "FALSE", "\n";
  print "pipeline         = ", $G::pipeline ? "TRUE" : "FALSE", "\n";
  print "silent           = $G::silent\n";
  print "protocol         = $G::protocol\n";
  print "type             = $G::link{type}\n";
  print "server           = $G::link{server}\n";
  print "sockfile         = $G::link{sockfile}\n";
  print "process          = $G::link{process}\n";
  print "from             = $opts->{from}\n";
  print "to               = $opts->{to}\n";
  print "helo             = $opts->{helo}\n";
  print "port             = $G::link{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='",
          join(',', @{$opts->{a_type}}), "' ",
          "user='$opts->{a_user}' pass='$opts->{a_pass}'\n";
  } else { print "no\n"; }
  print "auth map         = ", join("\n".' 'x19,
                              map { "$_ = ".
                                    join(', ', @{$G::auth_map_t{$_}})
                                  } (keys %G::auth_map_t)
                             ), "\n";
  print "quit after       = $G::quit_after\n";
  print "local int        = $G::link{lint}\n";
  print "timeout          = $G::link{timeout}\n";
  print "data             = <<.\n$opts->{data}\n";
  exit(0);
}

# we're going to abstract away the actual connection layer from the mail
# process, so move the act of connecting into its own sub.  The sub will
# set info in global hash %G::link
# XXX instead of passing raw data, have processs_opts create a link_data
# XXX hash that we can pass verbatim here
open_link();

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

teardown_link();

exit(0);

sub teardown_link {
  if ($G::link{type} eq 'socket-inet' || $G::link{type} eq 'socket-unix') {
    # XXX need anything special for tls teardown?
    close($G::link{sock});
    ptrans(11,  "Connection closed with remote host.");
  } elsif ($G::link{type} eq 'pipe') {
    delete($SIG{PIPE});
    $SIG{CHLD} = 'IGNORE';
    close($G::link{sock}{wr});
    close($G::link{sock}{re});
    ptrans(11,  "Connection closed with child process.");
  }
}

sub open_link {
  if ($G::link{type} eq 'socket-inet') {
    ptrans(11, "Trying $G::link{server}:$G::link{port}...");
    $@ = "";
    $G::link{sock} = IO::Socket::INET->new(PeerAddr => $G::link{server},
                            PeerPort  => $G::link{port}, Proto => 'tcp',
                            Timeout   => $G::link{timeout},
                            LocalAddr => $G::link{lint});

    if ($@) {
      ptrans(12, "Error connecting $G::link{lint} " .
                            "to $G::link{server}:$G::link{port}:\n\t$@");
      exit(2);
    }
    ptrans(11, "Connected to $G::link{server}.");
  } elsif ($G::link{type} eq 'socket-unix') {
    ptrans(11, "Trying $G::link{sockfile}...");
    $SIG{PIPE} = 'IGNORE';
    $@ = "";
    $G::link{sock} = IO::Socket::UNIX->new(Peer => $G::link{sockfile},
                            Timeout   => $G::link{timeout});

    if ($@) {
      ptrans(12, "Error connecting to $G::link{sockfile}:\n\t$@");
      exit(2);
    }
    ptrans(11, "Connected to $G::link{sockfile}.");
  } elsif ($G::link{type} eq 'pipe') {
    $SIG{PIPE} = 'IGNORE';
    $SIG{CHLD} = 'IGNORE';
    ptrans(11, "Trying pipe to $G::link{process}...");
    eval{
      open2($G::link{sock}{re}, $G::link{sock}{wr}, $G::link{process});
    };
    if ($@) {
      ptrans(12, "Error connecting to $G::link{process}:\n\t$@");
      exit(2);
    }
    select((select($G::link{sock}{wr}), $| = 1)[0]);
    select((select($G::link{sock}{re}), $| = 1)[0]);
    ptrans(11, "Connected to $G::link{process}.");
  } else {
    ptrans(12, "Unknown or unimplemented connection type " .
                          "$G::link{type}");
    exit(3);
  }
}

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 $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 $ehlo    = {};	# If server is esmtp, save advertised features here

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

  # read the server's 220 banner
  do_smtp_gen(undef, '220') || do_smtp_quit(1, 21);

  # QUIT here if the user has asked us to do so
  do_smtp_quit(1, 0) if ($G::quit_after eq 'connect');

  # Send a HELO string
  do_smtp_helo($helo, $ehlo, $G::protocol) || do_smtp_quit(1, 22);

  # QUIT here if the user has asked us to do so
  do_smtp_quit(1, 0) if ($G::quit_after eq 'first-helo');

  # handle TLS here if user has requested it
  if ($G::tls) {
    do_smtp_quit(1, 29) if (!do_smtp_tls($ehlo) && !$G::tls_optional);
  }

  # QUIT here if the user has asked us to do so
  do_smtp_quit(1, 0) if ($G::quit_after eq 'tls');

  #if ($G::link{tls}{active} && $ehlo->{STARTTLS}) {
  if ($G::link{tls}{active} && !$G::tls_on_connect) {
    # According to RFC3207, we need to forget state info and re-EHLO here
    $ehlo = {};
    do_smtp_helo($helo, $ehlo, $G::protocol) || do_smtp_quit(1, 32);
  }

  # QUIT here if the user has asked us to do so
  do_smtp_quit(1, 0) if ($G::quit_after eq 'helo');

  # handle auth here if user has requested it
  if ($a_type) {
    do_smtp_quit(1, 28) if (!do_smtp_auth($ehlo, $a_type, $a_user, $a_pass)
                            && !$G::auth_optional);
  }

  # QUIT here if the user has asked us to do so
  do_smtp_quit(1, 0) if ($G::quit_after eq 'auth');

  # send MAIL
  #do_smtp_gen("MAIL FROM:<$from>", '250') || do_smtp_quit(1, 23);
  do_smtp_mail($from); # failures in this handled by smtp_mail_callback

  # QUIT here if the user has asked us to do so
  do_smtp_quit(1, 0) if ($G::quit_after eq 'mail');

  # send RCPT (sub handles multiple, comma-delimited recips
  #do_smtp_rcpt($to) || do_smtp_quit(1, 24);
  do_smtp_rcpt($to); # failures in this handled by smtp_rcpt_callback
                     # note that smtp_rcpt_callback increments
                     # $G::smtp_rcpt_failures at every failure.  This and
                     # $G::smtp_rcpt_total are used after DATA for LMTP

  # QUIT here if the user has asked us to do so
  do_smtp_quit(1, 0) if ($G::quit_after eq 'rcpt');

  # send DATA
  do_smtp_gen('DATA', '354') || do_smtp_quit(1, 25);

  # send the actual data
  #do_smtp_gen($data, '250', undef, $G::suppress_data) || do_smtp_quit(1, 26);
  # this was moved to a custom sub because the server will have a custom
  # behaviour when using LMTP
  do_smtp_data($data, $G::suppress_data) || do_smtp_quit(1, 26);

  # send QUIT
  do_smtp_quit(0) || do_smtp_quit(1, 27);
}

sub start_tls {
  my %t         = (); # This is a convenience var to access $G::link{tls}{...}
  $G::link{tls} = \%t;

  Net::SSLeay::load_error_strings();
  Net::SSLeay::SSLeay_add_ssl_algorithms();
  Net::SSLeay::randomize();
  $t{con}    = Net::SSLeay::CTX_new() || return(0);
  Net::SSLeay::CTX_set_options($t{con}, &Net::SSLeay::OP_ALL); # error check
  $t{ssl}    = Net::SSLeay::new($t{con}) || return(0);
  if ($G::link{type} eq 'pipe') {
    Net::SSLeay::set_wfd($t{ssl}, fileno($G::link{sock}{wr})); # error check?
    Net::SSLeay::set_rfd($t{ssl}, fileno($G::link{sock}{re})); # error check?
  } else {
    Net::SSLeay::set_fd($t{ssl}, fileno($G::link{sock})); # error check?
  }
  $t{active} = Net::SSLeay::connect($t{ssl}) == 1 ? 1 : 0;
  $t{res}    = Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error())
                       if (!$t{active});
  $t{cipher} = Net::SSLeay::get_cipher($t{ssl});

  return($t{active});
}

sub ptrans {
  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 (($G::hide_send    && int($c/10) == 2) ||
             ($G::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 ($G::silent > 0) {
    return if ($G::silent >= 3);
    return if ($G::silent == 2 && $c%2 != 0);
    if ($G::silent == 1) {
      if ($c%2 != 0) {
        return();
      } else {
        $G::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::link{tls}{active} ? ' ~>' : ' ->'; }
  # smtp send error
  elsif ($c == 22) { $f = $G::link{tls}{active} ? '*~>' : '**>'; }
  # smtp recv info
  elsif ($c == 31) { $f = $G::link{tls}{active} ? '<~ ' : '<- '; }
  # smtp recv error
  elsif ($c == 32) { $f = $G::link{tls}{active} ? '<~*' : '<**'; }
  # something went unexpectedly
  else { $c = '???'; }

  $f .= ' ';
  $f = '' if ($G::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_quit {
  my $exit = shift;
  my $err  = shift;

  $G::link{allow_lost_cxn} = 1;
  my $r = do_smtp_gen('QUIT', '221');
  $G::link{allow_lost_cxn} = 0;

  handle_disconnect($err) if ($G::link{lost_cxn});

  if ($exit) {
    teardown_link();
    exit $err;
  }

  return($r);
}

sub do_smtp_tls {
  my $e  = shift; # ehlo config hash

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

  ptrans(11, "TLS started w/ cipher $G::link{tls}{cipher}");
  return(1);
}

sub do_smtp_auth {
  my $e  = shift; # ehlo config hash
  my $at = shift; # auth type
  my $au = shift; # auth user
  my $ap = shift; # auth password

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

  # note that we don't have to check whether the modules are loaded here,
  # that's done in the option processing - trust that an auth type
  # wouldn't be in $at if we didn't have the correct tools.

  my $auth_attempted = 0; # set to true if we ever attempt auth

  foreach my $btype (@$at) {
    # if server doesn't support, skip type (may change in future)
    next if (!$e->{AUTH}{$btype});

    foreach my $type (@{$G::auth_map_t{'CRAM-MD5'}}) {
      if ($btype eq $type) {
        return(1) if (do_smtp_auth_cram($au, $ap, $type));
        $auth_attempted = 1;
      }
    }
    foreach my $type (@{$G::auth_map_t{'CRAM-SHA1'}}) {
      if ($btype eq $type) {
        return(1) if (do_smtp_auth_cram($au, $ap, $type));
        $auth_attempted = 1;
      }
    }
    foreach my $type (@{$G::auth_map_t{'DIGEST-MD5'}}) {
      if ($btype eq $type) {
        return(1) if (do_smtp_auth_digest($au, $ap, $type));
        $auth_attempted = 1;
      }
    }
    foreach my $type (@{$G::auth_map_t{'NTLM'}}) {
      if ($btype eq $type) {
        return(1) if (do_smtp_auth_ntlm($au, $ap, $type));
        $auth_attempted = 1;
      }
    }
    foreach my $type (@{$G::auth_map_t{'PLAIN'}}) {
      if ($btype eq $type) {
        return(1) if (do_smtp_auth_plain($au, $ap, $type));
        $auth_attempted = 1;
      }
    }
    foreach my $type (@{$G::auth_map_t{'LOGIN'}}) {
      if ($btype eq $type) {
        return(1) if (do_smtp_auth_login($au, $ap, $type));
        $auth_attempted = 1;
      }
    }
  }

  if ($auth_attempted) {
    ptrans(12, "No authentication type succeeded");
  } else {
    ptrans(12, "No acceptable authentication types available");
  }
  return(0);
}

sub do_smtp_auth_ntlm {
  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($auth_string, '334') || return(0);

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

  $auth_string = eb64($d);
  do_smtp_gen($auth_string, '334', \$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 = db64(Authen::NTLM::ntlm($r));

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

  return(1);
}

sub do_smtp_auth_digest {
  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($auth_string, '334', \$r, '', '',
              $G::auth_showpt ? \&unencode_smtp : '')
      || return(0);

  $r =~ s/^....//; # maybe something a little better here?
  $r = db64($r);
  my $req = Authen::DigestMD5::Request->new($r);
  my $res = Authen::DigestMD5::Response->new();
  $res->got_request($req);
  # XXX using link{server} here is probably a bug, but I don;t know what else
  # XXX to use yet on a non-inet-socket connection
  $res->set('username' => $u, 'realm' => '',
            'digest-uri' => "smtp/$G::link{server}");
  $res->add_digest(password => $p);
  my $d = $res->output();
  $auth_string = eb64($d);

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

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

# This can handle both CRAM-MD5 and CRAM-SHA1
sub do_smtp_auth_cram {
  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($auth_string, '334', \$r, '', '',
              $G::auth_showpt ? \&unencode_smtp : '')
      || return(0);

  $r =~ s/^....//; # maybe something a little better here?
  # specify which type of digest we need based on $as
  my $d = get_digest($p, $r, ($as =~ /-SHA1$/ ? 'sha1' : 'md5'));
  $auth_string = eb64("$u $d");

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

sub do_smtp_auth_login {
  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($auth_string, '334', undef, '', '',
              $G::auth_showpt ? \&unencode_smtp : '') || return(0);
  $auth_string = eb64($u);
  $z = $u if ($G::auth_showpt);
  do_smtp_gen($auth_string, '334', undef, '', $z,
              $G::auth_showpt ? \&unencode_smtp : '') || return(0);
  $auth_string = eb64($p);
  $z = $p if ($G::auth_showpt);
  do_smtp_gen($auth_string, '235', undef, '', $z) || return(0);
  return(1);
}

sub do_smtp_auth_plain {
  my $u = shift; # auth user
  my $p = shift; # auth password
  my $as = shift; # auth string

  my $auth_string = "AUTH $as " . eb64("\0$u\0$p");
  my $z = '';
  if ($G::auth_showpt) {
    $z = "AUTH $as \\0$u\\0$p";
  }
  return(do_smtp_gen($auth_string, '235', undef, '', $z));
}

sub do_smtp_helo {
  my $h = shift;  # helo string to use
  my $e = shift;  # this is a hashref that will be populated w/ server options
  my $p = shift;  # protocol for the transaction
  my $r = '';     # this'll be populated by do_smtp_gen

  if ($p eq 'esmtp' || $p eq 'lmtp') {
    my $l = $p eq 'lmtp' ? "LHLO" : "EHLO";
    if (do_smtp_gen("$l $h", '250', \$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.
      foreach my $l (split(/\n/, $r)) {
        $l =~ s/^....//;
        if ($l =~ /^AUTH=?(.*)$/) {
          map { $e->{AUTH}{uc($_)} = 1 } (split(' ', $1));
        } elsif ($l =~ /^STARTTLS$/) {
          $e->{STARTTLS} = 1;
        } elsif ($l =~ /^PIPELINING$/) {
          $e->{PIPELINING} = 1;
          $G::pipeline_adv = 1;
        }
      }
      return(1);
    }
  }
  if ($p eq 'esmtp' || $p eq 'smtp') {
    return(do_smtp_gen("HELO $h", '250'));
  }

  return(0);
}

sub do_smtp_mail {
  my $m = shift;  # from address

  transact(cxn_string => "MAIL FROM:<$m>", expect => '250', defer => 1,
           fail_callback => \&smtp_mail_callback);

  return(1); # the callback handles failures, so just return here
}

# this only really needs to exist until I figure out a clever way of making
# do_smtp_quit the callback while still preserving the exit codes
sub smtp_mail_callback {
  do_smtp_quit(1, 23);
}

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

  my @a = split(/,/, $m);
  $G::smtp_rcpt_total = scalar(@a);
  foreach my $addr (@a) {
    #$f++ if (!do_smtp_gen("RCPT TO:<$addr>", '250'));
    transact(cxn_string => "RCPT TO:<$addr>", expect => '250', defer => 1,
             fail_callback => \&smtp_rcpt_callback);
  }

  return(1); # the callback handles failures, so just return here

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

sub smtp_rcpt_callback {
  # record that a failure occurred
  $G::smtp_rcpt_failures++;

  # if the number of failures is the same as the total rcpts (if every rcpt
  # rejected), quit.
  if ($G::smtp_rcpt_failures == $G::smtp_rcpt_total) {
    do_smtp_quit(1, 24);
  }
}

sub do_smtp_data {
  my $m = shift; # string to send
  my $b = shift; # be brief in the data we send
  my $calls = $G::smtp_rcpt_total - $G::smtp_rcpt_failures;

  my $ok = transact(cxn_string => $m, expect => '250', summarize_output => $b);

  # now be a little messy - lmtp is not a lockstep after data - we need to
  # listen for as many calls as we had accepted recipients
  if ($G::protocol eq 'lmtp') {
    foreach my $c (1..($calls-1)) { # -1 because we already got 1 above
      $ok += transact(cxn_string => undef, expect => '250');
    }
  }
  return($ok)
}

sub do_smtp_gen {
  my $m = shift; # string to send
  my $e = shift; # String we're expecting to get back
  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;

  return transact(cxn_string => $m, expect => $e, return_text => $p,
                  summarize_output => $b, show_string => $x,
                  print_callback => $c);
}

# If we detect that the other side has gone away when we were expecting
# to still be reading, come in here to error and die.  Abstracted because
# the error message will vary depending on the type of connection
sub handle_disconnect {
  my $e = shift || 6; # this is the code we will exit with
  if ($G::link{type} eq 'socket-inet') {
    ptrans(12, "Remote host closed connection unexpectedly.");
  } elsif ($G::link{type} eq 'socket-unix') {
    ptrans(12, "Socket closed connection unexpectedly.");
  } elsif ($G::link{type} eq 'pipe') {
    ptrans(12, "Child process closed connection unexpectedly.");
  }
  exit($e);
}

sub flush_send_buffer {
  my $s = $G::link{type} eq 'pipe' ? $G::link{sock}->{wr} : $G::link{sock};
  return if (!$G::send_buffer);
  if ($G::link{tls}{active}) {
    my $res = Net::SSLeay::write($G::link{tls}{ssl}, $G::send_buffer);
  } else {
    print $s $G::send_buffer;
  }
  $G::send_buffer = '';
}

sub send_data {
  my $d = shift; # data to write
  $G::send_buffer .= "$d\r\n";
}

sub recv_line {
  # Either an IO::Socket obj or a FH to my child - the thing to read from
  my $s = $G::link{type} eq 'pipe' ? $G::link{sock}->{re} : $G::link{sock};
  my $r = undef;

  if ($G::link{tls}{active}) {
    $r = Net::SSLeay::read($G::link{tls}{ssl});
  } else {
    $r = <$s>;
  }
  $r =~ s|\r||msg;
#print "in recv_line, returning \$r = $r\n";
  return($r);
}

# any request which has immediate set will be checking the return code.
# any non-immediate request will handle results through fail_callback().
# therefore, only return the state of the last transaction attempted,
# which will always be immediate
# We still need to reimplement timing
sub transact {
  my %h        = @_; # this is an smtp transaction element
  my $ret      = 1;  # this is our return value
  my @handlers = (); # will hold and fail_handlers we need to run
  my $time     = ''; # used in time lapse calculations

  push(@G::pending_send, \%h); # push onto send queue
  if (!($G::pipeline && $G::pipeline_adv) || !$h{defer}) {

    if ($G::show_time_lapse) {
      if ($G::show_time_hires) { $time = [Time::HiRes::gettimeofday()];   }
      else                     { $time = time(); }
    }

    while (my $i = shift(@G::pending_send)) {
      if ($i->{cxn_string}) {
        ptrans(21,$i->{show_string}||$i->{cxn_string},$i->{summarize_output});
        send_data($i->{cxn_string});
      }
      push(@G::pending_recv, $i);
    }
    flush_send_buffer();
    while (my $i = shift(@G::pending_recv)) {
      my $buff = '';
      eval {
        local $SIG{'ALRM'} = sub {
          $buff ="Timeout ($G::link{timeout} secs) waiting for server response";
          die;
        };
        alarm($G::link{timeout});
        while ($buff !~ /^\d\d\d /m) {
          my $l = recv_line();
          $buff .= $l;
          if (!defined($l)) {
            $G::link{lost_cxn} = 1;
            last;
          }
        }
        chomp($buff);
        alarm(0);
      };

      if ($G::show_time_lapse) {
        if ($G::show_time_hires) {
          $time = sprintf("%0.03f", Time::HiRes::tv_interval($time,
                                   [Time::HiRes::gettimeofday()]));
          ptrans(11, "response in ${time}s");
          $time = [Time::HiRes::gettimeofday()];
        } else {
          $time = time() - $time;
          ptrans(11, "response in ${time}s");
          $time = time();
        }
      }

      ${$i->{return_text}} = $buff;
      $buff = &{$i->{print_callback}}($buff)
          if (ref($i->{print_callback}) eq 'CODE');
      my $ptc;
      ($ret,$ptc) = $buff !~ /^$i->{expect} /m ? (0,32) : (1,31);
      ptrans($ptc, $buff) if ($buff);
      if ($G::link{lost_cxn}) {
        if ($G::link{allow_lost_cxn}) {
          # this means the calling code wants to handle a lost cxn itself
          return($ret);
        } else {
          # if caller didn't want to handle, we'll handle a lost cxn ourselves
          handle_disconnect();
        }
      }
      if (!$ret && ref($i->{fail_callback}) eq 'CODE') {
        push(@handlers, $i->{fail_callback});
      }
    }
  }
  foreach my $h (@handlers) { &{$h}(); }
  return($ret);
}

sub unencode_smtp {
  my $t = shift;

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

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

  if (! -e "$f") {
    ptrans(12, "File $f does not exist, skipping");
    return;
  } elsif (! -f "$f") {
    ptrans(12, "File $f is not a file, skipping");
    return;
  } elsif (!open(I, "<$f")) {
    ptrans(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.
  return("") if (!avail("hostname"));
  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 (!avail("dns")) {
    ptrans(12, avail_str("dns").".  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 load {
  my $m = shift;

  return $G::modules{$m} if (exists($G::modules{$m}));
  eval("use $m");
  return $G::modules{$m} = $@ ? 0 : 1;
}

# Currently this is just an informational string - it's set on both
# success and failure.  It currently has four output formats (supported,
# supported but not optimal, unsupported, unsupported and missing optimal)
sub avail_str { return $G::dependencies{$_[0]}{errstr}; }

sub avail {
  my $f = shift; # this is the feature we want to check support for (auth, tls)
  my $s = \%G::dependencies;

  # return immediately if we've already tested this.
  return($s->{$f}{avail}) if (exists($s->{$f}{avail}));

  $s->{$f}{req_failed} = [];
  $s->{$f}{opt_failed} = [];
  foreach my $m (@{$s->{$f}{req}}) {
    push(@{$s->{$f}{req_failed}}, $m) if (!load($m));
  }
  foreach my $m (@{$s->{$f}{opt}}) {
    push(@{$s->{$f}{opt_failed}}, $m) if (!load($m));
  }

  if (scalar(@{$s->{$f}{req_failed}})) {
    $s->{$f}{errstr} = "$s->{$f}{name} not available: requires "
                     . join(', ', @{$s->{$f}{req_failed}});
    if (scalar(@{$s->{$f}{opt_failed}})) {
      $s->{$f}{errstr} .= ".  Also missing optimizing "
                        . join(', ', @{$s->{$f}{opt_failed}});
    }
    return $s->{$f}{avail} = 0;
  } else {
    if (scalar(@{$s->{$f}{opt_failed}})) {
      $s->{$f}{errstr} = "$s->{$f}{name} supported, but missing optimizing "
                       . join(', ', @{$s->{$f}{opt_failed}});
    } else {
      $s->{$f}{errstr} = "$s->{$f}{name} supported";
    }
    return $s->{$f}{avail} = 1;
  }
}

sub get_digest {
  my $secr = shift;
  my $chal = shift;
  my $type = shift || 'md5';
  my $ipad = chr(0x36) x 64;
  my $opad = chr(0x5c) x 64;

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

  if (length($secr) > 64) {
    if ($type eq 'md5') {
      $secr = Digest::MD5::md5($secr);
    } elsif ($type eq 'sha1') {
      $secr = Digest::SHA1::sha1($secr);
    }
  } else {
    $secr .= chr(0) x (64 - length($secr));
  }

  my $digest = $type eq 'md5'
               ? Digest::MD5::md5_hex(($secr ^ $opad),
                 Digest::MD5::md5(($secr ^ $ipad), $chal))
               : Digest::SHA1::sha1_hex(($secr ^ $opad),
                 Digest::SHA1::sha1(($secr ^ $ipad), $chal));
  return($digest);
}

sub test_support {
  my $s = \%G::dependencies;

  foreach my $act (sort { $s->{$a}{name} cmp $s->{$b}{name} } keys %$s) {
    ptrans(avail($act) ? 11 : 12, avail_str($act));
    #if (avail($act)) {
    #  #ptrans(11, "$s->{$act}{name} supported");
    #  ptrans(11, avail_err($act));
    #} else {
    #  ptrans(12, avail_err($act));
    #}
  }
}

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});
  $G::suppress_data = 1 if ($o->{suppress_data});
  $G::no_hints      = 1 if ($o->{no_hints});
  $G::hide_send     = 1 if ($o->{hide_send});
  $G::hide_receive  = 1 if ($o->{hide_receive});
  $G::pipeline      = 1 if ($o->{pipeline});
  $G::silent        = $o->{silent} ? $o->{silent} : 0;

  my %protos = ( 
    smtp    => { proto => 'smtp',  auth => 0, tls => '0' },
    ssmtp   => { proto => 'esmtp', auth => 0, tls => 'c' },
    ssmtpa  => { proto => 'esmtp', auth => 1, tls => 'c' },
    smtps   => { proto => 'smtp',  auth => 0, tls => 'c' },
    esmtp   => { proto => 'esmtp', auth => 0, tls => '0' },
    esmtpa  => { proto => 'esmtp', auth => 1, tls => '0' },
    esmtps  => { proto => 'esmtp', auth => 0, tls => 's' },
    esmtpsa => { proto => 'esmtp', auth => 1, tls => 's' },
    lmtp    => { proto => 'lmtp',  auth => 0, tls => '0' },
    lmtpa   => { proto => 'lmtp',  auth => 1, tls => '0' },
    lmtps   => { proto => 'lmtp',  auth => 0, tls => 's' },
    lmtpsa  => { proto => 'lmtp',  auth => 1, tls => 's' },
  );
  $G::protocol = lc($o->{mail_protocol}) || 'esmtp';
  if (!$protos{$G::protocol}) {
    ptrans(12, "Unknown protocol $G::protocol specified, exiting");
    exit(1);
  }
  if ($protos{$G::protocol}{auth} && !$o->{auth_user} && !$o->{auth_pass} &&
      !$o->{auth_optional} && !$o->{auth})
  {
    $o->{auth} = ''; # cause auth to be processed below
  }
  if ($protos{$G::protocol}{tls} && !$o->{tls} && !$o->{tls_optional} &&
      !$o->{tls_on_connect})
  {
    if ($protos{$G::protocol}{tls} eq 's') {
      $o->{tls} = '';
    } elsif ($protos{$G::protocol}{tls} eq 'c') {
      $o->{tls_on_connect} = '';
    }
  }
  $G::protocol = $protos{$G::protocol}{proto};

  # set global option of -q option
  if ($o->{quit_after}) {
    $G::quit_after = lc($o->{quit_after});
    if ($G::quit_after =~ /^[el]hlo$/)     { $G::quit_after = 'helo';       }
    elsif ($G::quit_after =~ /first-[el]hlo/) { $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')
    {
      ptrans(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::show_time_lapse &&
                              avail("hires_timing") &&
                              $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
  }

  # pipe command, if one is specified
  $G::link{process}   = $o->{pipe_cmd} || interact("Pipe: ", '^.+$')
      if (defined($o->{pipe_cmd}));
  $G::link{process} ||= $fconf->{PIPE} || "";
  if ($G::link{process}) { $G::link{type} = 'pipe';   }
  else                   { delete($G::link{process}); }

  # socket file, if one is specified
  $G::link{sockfile}   = $o->{socket} || interact("Socket File: ", '^.+$')
      if (defined($o->{socket}));
  $G::link{sockfile} ||= $fconf->{SOCKET} || "";
  if ($G::link{sockfile}) { $G::link{type} = 'socket-unix'; }
  else                    { delete($G::link{sockfile});     }

  my $user     = get_username($o->{force_getpwuid});
  my $hostname = get_hostname();

  # SMTP mail from
  $n{from} = $o->{mail_from} || interact("From: ", '^.*$')
      if (defined($o->{mail_from}));
  $n{from} ||= $fconf->{FROM} || ($hostname || ($G::server_only &&
                                                $G::quit_after ne 'mail')
                                    ? "$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 || ($G::quit_after eq 'connect')
                                    ? $hostname
                                    : interact("Helo: ", '^.*$'));

  # SMTP server and rcpt to are interdependant, so they are handled together
  $G::link{server}   = $o->{mail_server} || interact("Server: ", '^.*$')
      if (defined($o->{mail_server}));
  $G::link{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 && ($G::link{server} ||
                                           $G::link{type} eq 'socket-unix' ||
                                           $G::link{type} eq 'pipe')));
  if (!$G::link{type}) {
    $G::link{server} = get_server($n{to}) if (!$G::link{server});
    $G::link{type}   = "socket-inet";
  }

  # Verify we are able to handle the requested transport
  if ($G::link{type} eq 'pipe') {
    if (!avail("pipe")) {
      ptrans(12, avail_str("pipe").".  Exiting");
      exit(2);
    }
  } else {
    if (!avail("socket")) {
      ptrans(12, avail_str("socket").".  Exiting");
      exit(2);
    }
  }

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

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

  my $body  = 'This is a test mailing'; # default message body
  my $bound = "";
  my $stdin = undef;
  if (defined($o->{body_822})) {
    # the --body option is the entire 822 body and trumps and other options
    # that mess with the body
    if (!$o->{body_822}) {
      $body = interact("Body: ", '.+');
    } elsif ($o->{body_822} eq '-') {
      $stdin = join('', <STDIN>);
      $body  = $stdin;
    } else {
      $body = $o->{body_822};
    }
    if (open(I, "<$body")) {
      $body = join('', <I>);
      close(I);
    }
  }
  if (scalar(@{$o->{attach_822}})) {
    # this option is a list of files (or STDIN) to attach.  In this case,
    # the message become a mime message and the "body" goes in the
    # first text/plain part
    my $mime_type = 'application/octet-stream';
    my @parts = ( { body => $body, type => 'text/plain' } );
    $bound = "----=_MIME_BOUNDARY_000_$$";
    while (defined(my $t = shift(@{$o->{attach_822}}))) {
      if ($t =~ m|^[^/]+/[^/]+$| && !stat($t)) {
        $mime_type = $t;
      } else {
        push(@parts, { body => "$t", type => $mime_type });
      }
    }
    $body = '';
    foreach my $p (@parts) {
      if ($p->{body} eq '-') {
        if ($stdin) {
          $p->{body} = $stdin;
        } else {
          $p->{body} = join('', <STDIN>);
          $stdin     = $p->{body};
        }
      } elsif (open(I, "<$p->{body}")) {
        $p->{body} = join('', <I>);
        close(I);
      }
      $body .= "--$bound\n"
            .  "Content-Type: $p->{type}\n";
      if ($p->{type} =~ m|^text/plain$|i) {
        $body .= "\n" . $p->{body} . "\n";
      } else {
        $body .= "Content-Transfer-Encoding: BASE64\n"
              .  "Content-Disposition: attachment\n"
              .  "\n"
              .  eb64($p->{body}, "\n") . "\n";
      }
    }
    $body .= "--$bound--\n";
  }

  # add-header option.  In a strict technical sense all this is is a text
  # string that will replace %H in the DATA.  Because of where %H is placed
  # in the default DATA, in practice this is used to add headers to the stock
  # DATA w/o having to craft a custom DATA portion
  #if (scalar(@{$o->{add_header}})) {
  #  $n{add_header} = join("\n", @{$o->{add_header}}) . "\n";
  #}
  @{$o->{add_header}} = map { split(/\\n/) } @{$o->{add_header}};

  # 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'
             . ($bound ?  'MIME-Version: 1.0\n'
                         .'Content-Type: multipart/mixed; '
                         .'boundary="'.$bound.'"\n'
                       : '')
             .'%H' # newline will be added in replacement if it exists
             .'\n'
             .'%B\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/%B/$body/g;
    if (scalar(@{$o->{header}})) {
      my %matched = ();
      foreach my $l (map { split(/\\n/) } @{$o->{header}}) {
        if (my($h) = $l =~ /^([^:]+):/) {
          if (!$matched{$h} && $n{data} =~ s/(^|\\n)$h:.*?($|\\n)/$1$l$2/) {
            $matched{$h} = 1;
          } else { push(@{$o->{add_header}}, $l); }
        } else { push(@{$o->{add_header}}, $l); }
      }
    }
    $n{add_header} = join('\n', @{$o->{add_header}}) . "\n"
        if (@{$o->{add_header}});
    $n{data} =~ s/%H/$n{add_header}/g;
    $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 - run twice to get consecutive \n correctly
    $n{data} =~ s/([^\r])\n/$1\r\n/gs;
    $n{data} =~ s/([^\r])\n/$1\r\n/gs; # this identical call not a bug
    $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::link{tls}{active} = 0;
  if ($G::tls || $G::tls_on_connect) {
    if (!avail("tls")) {
      if ($G::tls_optional) {
        $G::tls = undef; # so we won't try it later
        ptrans(12,avail_str("tls").".  Skipping optional TLS");
      } else {
        ptrans(12,avail_str("tls").".  Exiting");
        exit(10);
      }
    }
  }

  # SMTP port
  $G::link{port}   = $o->{mail_port} || interact("Port: ", '^\w+$')
      if (defined($o->{mail_port}));
  $G::link{port} ||= $fconf->{PORT};
  if ($G::link{port}) {
    # in here, the user has either specified a port, or that they _want_
    # to, so if it isn't a resolvable port, ,keep prompting for another one
    my $o_port = $G::link{port};
    if ($G::link{port} !~ /^\d+$/) {
      $G::link{port} = getservbyname($G::link{port}, 'tcp');
      while (!$G::link{port}) {
        $G::link{port} = $o_port =
            interact("Unable to resolve port $o_port\nPort: ", '^\w+$');
        $G::link{port} = getservbyname($G::link{port}, 'tcp')
            if ($G::link{port} !~ /^\d+$/);
      }
    }
  } else {
    # in here, user wants us to use default ports, so try look up services,
    # use default numbers is service names don't resolve.  Never prompt user
    if ($G::protocol eq 'lmtp') {
      $G::link{port} = getservbyname('lmtp',  'tcp') || '24';
    } elsif ($G::tls_on_connect) {
      $G::link{port} = getservbyname('smtps', 'tcp') || '465';
    } else {
      $G::link{port} = getservbyname('smtp',  'tcp') || '25';
    }
  }
  

  # Handle AUTH options
  $G::auth_optional = 1 if (defined($o->{auth_optional}));
  $o->{auth_types} = [];
  if ($o->{auth}) {
    @{$o->{auth_types}} = map { uc($_) } (split(/,/, $o->{auth}));
  } elsif ($o->{auth_optional}) {
    @{$o->{auth_types}} = map { uc($_) } (split(/,/, $o->{auth_optional}));
  } elsif (defined($o->{auth_user}) || defined($o->{auth_pass}) ||
           $G::auth_optional || (defined($o->{auth}) && !$o->{auth}))
  {
    $o->{auth_types}[0] = 'ANY';
    $o->{auth} = 'ANY'; # this is checked below
  }
  # if after that processing we've defined some auth type, do some more
  # specific processing
  if (scalar(@{$o->{auth_types}})) {
    # there's a lot of option processing below.  If any type looks like it
    # will succeed later, set this to true
    my $valid_auth_found = 0;

    # handle the --auth-map options plus our default mappings
    foreach (split(/\s+,\s+/, $o->{auth_map}),"PLAIN=PLAIN","LOGIN=LOGIN",
             "CRAM-MD5=CRAM-MD5","DIGEST-MD5=DIGEST-MD5","CRAM-SHA1=CRAM-SHA1",
             "NTLM=NTLM","SPA=NTLM","MSN=NTLM")
    {
      my($alias,$type) = split(/=/, uc($_), 2);
      # this gives us a list of all aliases and what the alias
      $G::auth_map_f{$alias} = $type;
      # this gives a list of all base types and any aliases for it.
      $G::auth_map_t{$type} ||= [];
      push(@{$G::auth_map_t{$type}}, $alias);
    }
    if (!avail("auth")) { # check for general auth requirements
      if ($G::auth_optional) {
        ptrans(12, avail_str("auth"). ".  Skipping optional AUTH");
      } else {
        ptrans(12, avail_str("auth"). ".  Exiting");
        exit(10);
      }
    } else {
      # if the user doesn't specify an auth type, create a list from our
      # auth-map data.  Simplifies processing later
      if ($o->{auth_types}[0] eq 'ANY') {
        $o->{auth_types} = [sort keys %G::auth_map_f];
      }

      foreach my $type (@{$o->{auth_types}}) {
        # we need to evaluate whether we will be able to run the auth types
        # specified by the user

        if (!$G::auth_map_f{$type}) {
          ptrans(12, "$type is not a recognized auth type, skipping");
        }

        elsif ($G::auth_map_f{$type} eq 'CRAM-MD5' && !avail("auth_cram_md5"))
        {
          ptrans(12, avail_str("auth_cram_md5")) if ($o->{auth} ne 'ANY');
        }

        elsif ($G::auth_map_f{$type} eq 'CRAM-SHA1' && !avail("auth_cram_sha1"))
        {
          ptrans(12, avail_str("auth_cram_sha1")) if ($o->{auth} ne 'ANY');
        }

        elsif ($G::auth_map_f{$type} eq 'NTLM' && !avail("auth_ntlm"))
        {
          ptrans(12, avail_str("auth_ntlm")) if ($o->{auth} ne 'ANY');
        }

        elsif ($G::auth_map_f{$type} eq 'DIGEST-MD5' &&
               !avail("auth_digest_md5"))
        {
          ptrans(12, avail_str("auth_digest_md5")) if ($o->{auth} ne 'ANY');
        }

        else {
          $valid_auth_found = 1;
          push(@{$n{a_type}}, $type);
        }

      } # foreach

      if (!$valid_auth_found) {
        ptrans(12, "No auth types supported");
        if (!$G::auth_optional) {
          exit(10);
        }
        $n{a_user} = $n{a_pass} = $n{a_type} = undef;
      } 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 ($n{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 ($n{a_pass} eq '<>');

        $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}));
      }
    } # end avail("auth")
  } # end auth parsing

  return(\%n);
}

sub get_username {
  my $force_getpwuid = shift;
  if ($^O eq 'MSWin32') {
    require Win32;
    return Win32::LoginName();
  }
  if ($force_getpwuid) {
    return (getpwuid($<))[0];
  }
  return getlogin() || (getpwuid($<))[0];
}

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

  my @l = localtime();
  my $o = 0;

  if (!avail("date_manip")) {
    ptrans(12, avail_str("date_manip").".  Date strings will be in GMT");
    @l = gmtime();
  } else {
    my @g = gmtime();
    $o = (timelocal(@l) - timelocal(@g))/36;
  }
  $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],
                 $o
  );
}

# partially Cribbed from "Programming Perl" and MIME::Base64 v2.12
sub db64 {
  my $s =  shift;
  if (load("MIME::Base64")) {
    return(decode_base64($s));
  } else {
    $s    =~ tr#A-Za-z0-9+/##cd;
    $s    =~ s|=+$||;
    $s    =~ tr#A-Za-z0-9+/# -_#;
    my $r = '';
    while ($s =~ s/(.{1,60})//s) {
      $r .= unpack("u", chr(32 + int(length($1)*3/4)) . $1);
    }
    return($r);
  }
}

# partially Cribbed from MIME::Base64 v2.12
sub eb64 {
  my $s    =  shift;
  my $e    =  shift || ''; # line ending to use "empty by default"
  if (load("MIME::Base64")) {
    return(encode_base64($s, $e));
  } else {
    my $l    =  length($s);
    chomp($s =  pack("u", $s));
    $s       =~ s|\n.||gms;
    $s       =~ s|\A.||gms;
    $s       =~ tr#` -_#AA-Za-z0-9+/#;
    my $p    =  (3 - $l%3) % 3;
    $s       =~ s/.{$p}$/'=' x $p/e if ($p);
    $s       =~ s/(.{1,76})/$1$e/g if (length($e));
    return($s);
  }
}

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 --pipe

This option takes as its argument a program and the program's arguments.  If this option is present, swaks opens a pipe to the program and enters an SMTP transaction over that pipe rather than connecting to a remote server.  Some MTAs have testing modes using stdin/stdout.  This option allows you to tie into those options.  For example, if you implemented DNSBL checking with exim and you wanted to make sure it was working, you could run 'swaks --pipe "exim -bh 127.0.0.2"'.

In an ideal world the process you are talking to should behave exactly like an SMTP server on stdin and stdout.  Any debugging should be sent to stderr, which will be directed to your terminal.  In the real world swaks can generally handle some debug on the child's stdout, but there are no guarantees on how much it can handle.

=item --socket

This option takes as its argument a unix domain socket file.  If this option is present, swaks enters an SMTP transaction over over the unix domains socket rather than over an internet domain socket.  I think this option has uses when combined with a (yet unwritten) LMTP mode, but to be honest at this point I just implemented it because I could.

=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.  This can be either a port number or a service name.  Overridden by -l token PORT.  If unspecified, swaks will use service lmtp if --protocol is LMTP, service smtps if --tls-on-connect is used, and smtp otherwise.

=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, %D is replaced with a timestamp, %H is replaced with the contents of --add-header, and %B is replaced with the message body.  See the --body option for the default body text.

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%H\n\n%B\n".

=item --body

Specify the body of the email.  The default is "This is a test mailing".  If no argument to --body, you will be prompted to supply one.  If '-' is supplied, body will be read from standard input.  If any other text is provided and the text represents an openable file, the content of that file is used as the body.  If it does not respresent an openable file, the text itself is used as the body.

=item --attach

When one or more --attach option is supplied, the message is changed into a multipart/mixed MIME message.  The arguments to --attach are processed the same as --body with regard to stdin, file contents, etc.  --attach can be supplie multiple times to create multiple attachments.  By default each attachment is attached as a application/octet-stream file.  See --attach-type for changing this behaviour.

When the message changes to MIME format, the previous body (%B) is attached as a text/plain type as the first attachment.  --body can still be used to specify the contents of this body attachment.

It is legal for '-' (STDIN) to be specified as an argument multiple times (once for --body and multiple times for --attach).  In this case, the same content will be attached each time it is specified.  This is useful for attaching the same content with multiple MIME types.

=item --attach-type

By default, content that gets MIME attached to a message with the --attach option is encoded as application/octet-stream.  --attach-type changes the mime type for every --attach option which follows it.  It can be specified multiple times.

=item -ah, --add-header

In the strictest sense, all this does is provide a value that replaces the %H token in the data.  Because of where %H is located in the default DATA, practically it is used to add custom headers without having to recraft the entire body.

The option can either be specified multiple times or a single time with multiple headers seperated by a literal '\n' string.  So, "--add-header 'Foo: bar' --add-header 'Baz: foo'" and "--add-header 'Foo: bar\nBaz: foo'" end up adding the same two headers.

=item --header, --h-Header

These options allow a way to change headers that already exist in the DATA.  These two calls do the same thing:

--header "Subject: foo"
--h-Subject foo

Subject is the example used.  If the header does not exist in the body already, these calls behave identically to --add-header.  The purpose of this option it to provide a fast way to change the nature of the default DATA for specific tests.  For instance if you wanted to test a subject filer in a mail system, you could use --h-Subject "SPAM STRING" to test rather than having to craft and entire new DATA string to pass to --data.

=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 --protocol

Specify which protocol to use in the transaction.  Valid options are shown in the table below.  Currently the 'core' protocols are SMTP, ESMTP, and LMTP.  By using variations of these protocol types one can specify default ports, whether authentication should be attempted, and the type of TLS connection that should be attempted.  The default protocol is ESMTP.  This table demonstrates the available arguments to --protocol and the options each sets as a side effect:

           HELO            AUTH    TLS     PORT
   --------------------------------------------------
   SMTP    HELO                            smtp  / 25
   SSMTP   EHLO->HELO              -tlsc   smtps / 465
   SSMTPA  EHLO->HELO      -a      -tlsc   smtps / 465
   SMTPS   HELO                    -tlsc   smtps / 465
   ESMTP   EHLO->HELO                      smtp  / 25
   ESMTPA  EHLO->HELO      -a              smtp  / 25
   ESMTPS  EHLO->HELO              -tls    smtp  / 25
   ESMTPSA EHLO->HELO      -a      -tls    smtp  / 25
   LMTP    LHLO                            lmtp  / 24
   LMTPA   LHLO            -a              lmtp  / 24
   LMTPS   LHLO                    -tls    lmtp  / 24
   LMTPSA  LHLO            -a      -tls    lmtp  / 24

=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.

For convenience, LHLO and EHLO are synonyms for HELO, FIRST-EHLO and FIRST-LHLO for FIRST-HELO, FROM for MAIL, and TO for RCPT.

=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 --pipeline

If the remote server supports it, attempt SMTP PIPELINING (RFC 2920).  This is a younger option, if you experience problems with it please notify the author.  Potential problem areas include servers accepting DATA even though there were no valid recipients (swaks should send empty body in that case, not QUIT) and deadlocks caused by sending packets outside the tcp window size.

=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(s) of authentication to try.  If multiple, comma-delimited arguments are given, each specified auth type is tried in order until one succeeds or they all fail.  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.

CRAM-SHA1 is now supported.  Only tested against a hacked server implementation in Exim, so may be incomplete or incorrect.  Requires Digest::SHA1 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 --force-getpwuid

In releases 20050709.1 and earlier of swaks the local_part of an automatically generated sender email address would be found using the getpwuid system call on the euid of the current process.  Depending on the users' desires, this may be confusing.  Following the 20050709.1 release the local_part is not looked up via the getlogin() funtion which attempts to look up the actual username of the logged in user, regardless of the euid of the process they are currently running.

An example of where this might be an issue is running swaks under sudo for testing reasons when interacting with --pipe or --socket.  It makes sense that you need to run the process as a specific username but you would prefer your email to be from your real username.  You could always do this manually using the -s option, but this is an attempt to make it easier.

--force-getpwuid forces the old behaviour for anyone who prefered that behaviour.  Also, if there is no "real" user for getlogin() to look up, the old getpwuid method will be used.  This would happen if the process was run from cron or some other headless daemon.

=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

swaks does not have any single requirement except the standard module Getopt::Long.  However, there may be modules that are required for a given invocation of swaks.  The following list details the features reported by the --support option, what is actually being tested, and the consequences of the feature being reported as "not available"

=over 4

=item AUTH CRAM-MD5

CRAM-MD5 authentication requires the Digest::MD5 perl module.  If this is unavailable and authentication is required, swaks will error if CRAM-MD5 was the specific authentication type requested, or if no specific auth type was requested but CRAM-MD5 was the only type advertised by the server.

=item AUTH CRAM-SHA1

CRAM-SHA1 authentication requires the Digest::SHA1 perl module.  If this is unavailable and authentication is required, swaks will error if CRAM-SHA1 was the specific authentication type requested, or if no specific auth type was requested but CRAM-SHA1 was the only type advertised by the server.

=item AUTH DIGEST-MD5

DIGEST-MD5 authentication requires the Authen::DigestMD5 perl module.  If this is unavailable and authentication is required, swaks will error if DIGEST-MD5 was the specific authentication type requested, or if no specific auth type was requested but DIGEST-MD5 was the only type advertised by the server.

=item AUTH NTLM

NTLM/SPA/MSN authentication requires the Authen::NTLM perl module.  If this is unavailable and authentication is required, swaks will error if NTLM was the specific authentication type requested, or if no specific auth type was requested but NTLM was the only type advertised by the server.  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 Basic AUTH

All authentication types require base64 encoding and decoding.  If possible, swaks uses the MIME::Base64 perl module to perform these actions.  However, if MIME::Base64 is not available swaks will use its own onboard base64 routines.  These are slower than the MIME::Base64 routines and less reviewed, though they have been tested thoroughly.  When possible it is recommended that you install MIME::Base64.

=item Date Manipulation

swaks generates an RFC compliant date string when it interpolates the %D token in message bodies.  In order to build the GMT offset in this string, it needs the Time::Local module.  It would be very odd for this module not to be available because it has been included in the perl distribution for some time.  However, if it is not loadable for some reason and swaks interpolates a %D token (as it would when using the default body), the date string is in GMT instead of your local timezone.

=item High Resolution Timing

When diagnosing SMTP delays using --show-time-lapse, by default high resolution timing is attempted using the Time::HiRes module.  If this module is not available, swaks uses a much poorer timing source with one second granularity.

=item Local Hostname Detection

swaks uses your local machine's hostname to build the HELO string and sending email address when they are not specified on the command line.  If the Sys::Hostname module (which is a part of the base distribution) is not available for some reason, the user is prompted interactively for the HELO and sender strings.  Note that Sys::Hostname can sometimes fail to find the local hostname even when the module is available, which has the same behaviour.

=item MX Routing

If the destination mail server is not specified using the --server option, swaks attempts to use DNS to route the message based on the recipient email address.  If the Net::DNS perl module is not available, swaks uses 'localhost' as the outbound mail server.

=item Pipe Transport

The IPC::Open2 module is required to deliver a message to a spawned subprocess using the --pipe option.  If this module, which is included in the base perl distribution, in not available, attempting to call swaks with the --pipe option will result in an error.

=item Socket Transport

The IO::Socket module is required to deliver a message to an internet domain socket (the default behaviour of swaks) and to a unix domain socket (specified with the --socket option).  If this module, which is included in the base perl distribution, is not available, attempting to call swaks with the --server or --socket options (or none of the --socket, --server, and --pipe options) will result in an error.

=item TLS

TLS functionality requires the Net::SSLeay perl module.  If this module is not available and TLS was required (using the --tls-on-connect or --tls options), the session will error out.  If TLS was requested but not required (using the --tls-optional option), swaks will continue but not attempt a TLS session.

=back

=head1 PORTABILITY

=over 4

=item Operating Systems

This program was primarily intended for use on unix-like operating systems, and it should work on any reasonable version thereof.  It has been developed and tested on Solaris, Linux, and Mac OS X and is feature complete on all of these.

This program is known to demonstrate basic functionality on Windows using ActiveState's Perl.  It has not been fully tested.  Known to work are basic SMTP functionality and the LOGIN, PLAIN, and CRAM-MD5 auth types.  Unknown is any TLS functionality and the NTLM/SPA and Digest-MD5 auth types.

Because this program should work anywhere Perl works, I would appreciate knowing about any new operating systems you've thoroughly used swaks on as well as any problems encountered on a new OS.

=item Mail Servers

This program was almost exclusively developed against Exim mail servers.  It was been used casually by the author, though not thoroughly tested, with sendmail, smail, and Communigate.  Because all functionality in swaks is based off of known standards it should work with any fairly modern mail server.  If a problem is found, please alert the author at the address below.

=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 3

unknown connection type

=item 4

while running with connection type of "pipe", fatal problem writing to or reading from the child process

=item 5

while running with connection type of "pipe", child process died unexpectedly.  This can mean that the program specified with --pipe doesn't exist.

=item 6

Connection closed unexpectedly.  If the close is detected in response to the 'QUIT' swaks sends following an unexpected response, the error code for that unexpected response is used instead.

For instance, if a mail server returns a 550 response to a MAIL FROM: and then immediately closes the connection, swaks detects that the connection is closed, but uses the more specific exit code 23 to detail the nature of the failure.

If instead the server return a 250 code and then immediately closes the connection, swaks will use the exit code 6 because there is not a more specific exit code.

=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

Please use this address for general contact, questions, patches, requests, etc.

=item updates-swaks@jetmore.net

If you would like to be put on a list to receive notifications when a new version of swaks is released, please send an email to this address.

=item jetmore.org/john/code/#swaks

Change logs, this help, and the latest version is found at this link.

=back

=cut