rpms/swaks/devel swaks.20050709.1,NONE,1.1 swaks.spec,NONE,1.1
Jason Tibbitts (tibbs)
fedora-extras-commits at redhat.com
Mon May 15 17:15:01 UTC 2006
Author: tibbs
Update of /cvs/extras/rpms/swaks/devel
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv8584/devel
Added Files:
swaks.20050709.1 swaks.spec
Log Message:
auto-import swaks-20050709.1-5 on branch devel from swaks-20050709.1-5.src.rpm
--- NEW FILE swaks.20050709.1 ---
#!/usr/bin/perl
use strict;
use IO::Socket;
use Sys::Hostname;
use Getopt::Long;
use Time::Local;
my($p_name) = $0 =~ m|/?([^/]+)$|;
my $p_version = "20050709.1";
my $p_usage = "Usage: $p_name [--help|--version] (see --help for details)";
my $p_cp = <<EOM;
Copyright (c) 2003-2005 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 %O = ();
my $user = get_username();
my $hostname = get_hostname();
$| = 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: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
'pipe:s' => \$O{pipe_cmd}, # command to communicate with
'socket:s' => \$O{socket}, # unix doain socket to talk to
'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 "type = $G::link{type}\n";
print "server = $G::link{server}\n";
print "socket = $G::link{socket}\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='$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 = $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});
print_transaction(11, "Connection closed by foreign host.");
} elsif ($G::link{type} eq 'pipe') {
delete($SIG{PIPE});
$SIG{CHLD} = 'IGNORE';
close($G::link{sock}{wr});
close($G::link{sock}{re});
print_transaction(11, "Connection closed with child process.");
}
}
sub open_link {
if ($G::link{type} eq 'socket-inet') {
print_transaction(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 ($@) {
print_transaction(12, "Error connecting $G::link{lint} " .
"to $G::link{server}:$G::link{port}:\n\t$@");
exit(2);
}
print_transaction(11, "Connected to $G::link{server}.");
} elsif ($G::link{type} eq 'socket-unix') {
print_transaction(11, "Trying $G::link{sockfile}...");
$@ = "";
$G::link{sock} = IO::Socket::UNIX->new(Peer => $G::link{sockfile},
Timeout => $G::link{timeout},
Type => SOCK_STREAM);
if ($@) {
print_transaction(12, "Error connecting to $G::link{sockfile}:\n\t$@");
exit(2);
}
print_transaction(11, "Connected to $G::link{sockfile}.");
} elsif ($G::link{type} eq 'pipe') {
$SIG{PIPE} = sub {
print_transaction(12, "Child process went away unexpectedly, exiting");
exit(4);
};
$SIG{CHLD} = sub {
print_transaction(12, "Problem with child process, exiting");
exit(5);
};
print_transaction(11, "Trying pipe to $G::link{process}...");
if (!try_load("IPC::Open3")) {
print_transaction(12, "Couldn't load IPC::Open3 for pipe, exiting");
exit(2);
}
eval{
open3($G::link{sock}{wr},$G::link{sock}{re}, 0, $G::link{process});
};
if ($@) { # =~ /open3/) {
print_transaction(12, "Error connecting to $G::link{process}:\n\t$@");
exit(2);
}
print_transaction(11, "Connected to $G::link{process}.");
} else {
print_transaction(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()) {
print_transaction(11, "TLS started w/ cipher $G::link{tls}{cipher}");
} else {
print_transaction(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) || 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}) {
# According to RFC3207, we need to forget state info and re-EHLO here
$ehlo = {};
do_smtp_helo($helo, $ehlo) || 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);
# QUIT here if the user has asked us to do so
do_smtp_quit(1, 0) if ($G::quit_after eq 'mail');
# send RCPT
my $num_accepted = 0;
foreach my $r (split(/,/, $to)) { $num_accepted++ if (do_smtp_rcpt($r)); }
do_smtp_quit(1, 24) if (!$num_accepted);
# 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, $O{supress_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);
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 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::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 ($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_quit {
my $exit = shift;
my $err = shift;
$SIG{CHLD} = 'IGNORE'; # XXX kludge. there's a chicken and egg problem here
my $r = do_smtp_gen('QUIT', '221');
if ($exit) {
teardown_link();
exit $err;
}
return($r);
}
sub do_smtp_tls {
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("STARTTLS", '220')) {
return $G::tls_optional ? 1 : 0;
} elsif (!start_tls()) {
print_transaction(12, "TLS startup failed ($G::link{tls}{res})");
return $G::tls_optional ? 1 : 0;
}
print_transaction(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
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($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($au, $ap, $type));
}
}
}
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($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($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($au, $ap, $type));
}
}
print_transaction(12, "No authentication type succeeded");
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 = decode_base64(Authen::NTLM::ntlm());
$auth_string = encode_base64("$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 = decode_base64(Authen::NTLM::ntlm($r));
$auth_string = encode_base64("$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 = decode_base64($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 = encode_base64("$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 = decode_base64($r);
$req->input($r);
return(0) if (!$req->auth_ok);
do_smtp_gen("", '235', undef, '',
$G::auth_showpt ? "" : '') || return(0);
return(1);
}
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?
my $d = get_digest($p, $r);
$auth_string = encode_base64("$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 = encode_base64($u, '');
$z = $u if ($G::auth_showpt);
do_smtp_gen($auth_string, '334', undef, '', $z,
$G::auth_showpt ? \&unencode_smtp : '') || return(0);
$auth_string = encode_base64($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 " . encode_base64("\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 $r = ''; # this'll be populated by do_smtp_gen
if (do_smtp_gen("EHLO $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.
# 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("HELO $h", '250')) {
return(1);
}
return(0);
}
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);
foreach my $addr (@a) {
$f++ if (!do_smtp_gen("RCPT TO:<$addr>", '250'));
}
# if at least one addr succeeded, we can proceed, else we stop here
return $f == scalar(@a) ? 0 : 1;
}
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;
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($m, '');
$$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 $send = shift; # This is the string to send
my $buff = shift; # we will store and manipulate the return value here.
my $s = $G::link{sock}; # This is my IO::Socket object
my($wr,$re) = ($s->{wr},$s->{re}) if ($G::link{type} eq 'pipe');
eval {
local $SIG{'ALRM'} = sub {
$buff = "Timeout ($G::link{timeout} secs) waiting for server response";
die;
};
if (defined($send)) {
if ($G::link{tls}{active}) {
my $res = Net::SSLeay::write($G::link{tls}{ssl}, "$send\r\n");
} else {
if ($G::link{type} eq 'pipe') {
print $wr $send, "\r\n";
} else {
print $s $send, "\r\n";
}
}
}
alarm($G::link{timeout});
if ($buff) {
$buff = '';
} else {
# The 'do' allows for multi-line responses
if ($G::link{tls}{active}) {
do {
$buff .= Net::SSLeay::read($G::link{tls}{ssl});
} while ($buff !~ /^\d\d\d /m);
} else {
do {
if ($G::link{type} eq 'pipe') {
$buff .= <$re>;
} else {
$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
}
# 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}); }
# 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
$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}));
if (!$G::link{type}) {
$G::link{server} = get_server($n{to}) if (!$G::link{server});
$G::link{type} = "socket-inet";
}
# 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});
# 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 - 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 (!$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
$G::link{port} = $o->{mail_port} || interact("Port: ", '^\d+$')
if (defined($o->{mail_port}));
$G::link{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}) || $G::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 ($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 '<>');
$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_username {
if ($^O eq 'MSWin32') {
require Win32;
return Win32::LoginName();
}
return getpwuid($<);
}
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 --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"'.
=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 at 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 at example.com%NTDOM" is passed, "user at 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 at example.com -tlso -a -au user -ap password
send the contents of "mailfile" to user at 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 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 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 at jetmore.net
=back
=cut
--- NEW FILE swaks.spec ---
Name: swaks
Version: 20050709.1
Release: 5%{?dist}
Summary: Command-line SMTP transaction tester
Group: Applications/Internet
License: GPL
URL: http://www.jetmore.org/john/code/#swaks
Source0: http://www.jetmore.org/john/code/swaks.%{version}
BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
BuildArch: noarch
Requires: perl(Authen:DigestMD5)
Requires: perl(Net::DNS)
Requires: perl(Net::SSLeay)
Requires: perl(Time::HiRes)
%description
Swiss Army Knife SMTP: A command line SMTP tester. Swaks can test
various aspects of your SMTP server, including TLS and AUTH.
%prep
%build
%install
rm -rf $RPM_BUILD_ROOT
install -D -p -m 0755 %{SOURCE0} $RPM_BUILD_ROOT%{_bindir}/swaks
mkdir -p $RPM_BUILD_ROOT%{_mandir}/man1
/usr/bin/pod2man %{SOURCE0} > $RPM_BUILD_ROOT%{_mandir}/man1/swaks.1
%clean
rm -rf $RPM_BUILD_ROOT
%files
%defattr(-,root,root,-)
%{_bindir}/swaks
%{_mandir}/man1/*
%changelog
* Mon May 15 2006 Jason L Tibbitts III <tibbs at math.uh.edu> - 20050709.1-5
- Add Authen::DigestMD5 requirement now that it's in Extras.
* Wed Mar 29 2006 Jason L Tibbitts III <tibbs at math.uh.edu> - 20050709.1-4
- Cleanups from package review
* Sun Feb 12 2006 Jason L Tibbitts III <tibbs at math.uh.edu> - 20050709.1-3
- Use versioned source file URL
* Sat Jan 28 2006 Jason L Tibbitts III <tibbs at math.uh.edu> - 20050709.1-2
- Change group.
* Sat Jan 28 2006 Jason L Tibbitts III <tibbs at math.uh.edu> - 20050709.1-1
- Initial attempt
More information about the fedora-extras-commits
mailing list