1#!/usr/local/bin/perl 2 3# use 'swaks --help' to view documentation for this program 4# 5# Homepage: http://jetmore.org/john/code/swaks/ 6# Online Docs: http://jetmore.org/john/code/swaks/latest/doc/ref.txt 7# http://jetmore.org/john/code/swaks/faq.html 8# Announce List: send mail to updates-swaks@jetmore.net 9# Project RSS: http://jetmore.org/john/blog/c/swaks/feed/ 10# Twitter: http://www.twitter.com/SwaksSMTP 11 12use strict; 13 14$| = 1; 15my($p_name) = $0 =~ m|/?([^/]+)$|; 16my $p_version = build_version("20201014.0", '$Id$'); 17my $p_usage = "Usage: $p_name [--help|--version] (see --help for details)"; 18my $p_cp = <<'EOM'; 19 Copyright (c) 2003-2008,2010-2020 John Jetmore <jj33@pobox.com> 20 21 This program is free software; you can redistribute it and/or modify 22 it under the terms of the GNU General Public License as published by 23 the Free Software Foundation; either version 2 of the License, or 24 (at your option) any later version. 25 26 This program is distributed in the hope that it will be useful, 27 but WITHOUT ANY WARRANTY; without even the implied warranty of 28 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 29 GNU General Public License for more details. 30 31 You should have received a copy of the GNU General Public License 32 along with this program; if not, write to the Free Software 33 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. 34EOM 35 36# Get all input provided to our program, via file, env, command line, etc 37my %O = %{ load_args() }; 38 39# before we do anything else, check for --help and --version 40if (get_arg('help', \%O)) { 41 ext_usage(); 42 exit; 43} 44if (get_arg('version', \%O)) { 45 print "$p_name version $p_version\n\n$p_cp\n"; 46 exit; 47} 48 49# Get our functional dependencies and then print and exit early if requested 50load_dependencies(); 51if (get_arg('get_support', \%O)) { 52 test_support(); 53 exit(0); 54} 55 56# This 'synthetic' command line used for debug and reference 57$G::cmdline = reconstruct_options(\%O); 58 59# We need to fix things up a bit and set a couple of global options 60my $opts = process_args(\%O); 61 62if (scalar(keys(%G::dump_args))) { 63 if (my $running_state = get_running_state($opts, \%G::dump_args)) { 64 # --dump is intended as a debug tool for swaks internally. Always, 65 # unconditionally, show the user's auth password if one is given 66 $running_state =~ s/'%RAW_PASSWORD_STRING%'/shquote($opts->{a_pass})/ge; 67 print $G::trans_fh_oh $running_state; 68 } 69 exit(0); 70} 71elsif ($G::dump_mail) { 72 # if the user just wanted to generate an email body, dump it now and exit 73 $opts->{data} =~ s/\n\.\Z//; 74 print $G::trans_fh_oh $opts->{data}; 75 exit(0); 76} 77 78# we're going to abstract away the actual connection layer from the mail 79# process, so move the act of connecting into its own sub. The sub will 80# set info in global hash %G::link 81# XXX instead of passing raw data, have processs_opts create a link_data 82# XXX hash that we can pass verbatim here 83open_link(); 84 85sendmail($opts->{from}, $opts->{to}, $opts->{helo}, $opts->{data}, 86 $opts->{a_user}, $opts->{a_pass}, $opts->{a_type}); 87 88teardown_link(); 89 90exit(0); 91 92sub teardown_link { 93 if ($G::link{type} eq 'socket-inet' || $G::link{type} eq 'socket-unix') { 94 # XXX need anything special for tls teardown? 95 close($G::link{sock}); 96 ptrans(11, "Connection closed with remote host."); 97 } elsif ($G::link{type} eq 'pipe') { 98 delete($SIG{PIPE}); 99 $SIG{CHLD} = 'IGNORE'; 100 close($G::link{sock}{wr}); 101 close($G::link{sock}{re}); 102 ptrans(11, "Connection closed with child process."); 103 } 104} 105 106sub open_link { 107 if ($G::link{type} eq 'socket-inet') { 108 ptrans(11, 'Trying ' . $G::link{server} . ':' . $G::link{port} . '...'); 109 $@ = ""; 110 111 my @extra_options = (); 112 push(@extra_options, "LocalAddr", $G::link{lint}) if ($G::link{lint}); 113 push(@extra_options, "LocalPort", $G::link{lport}) if ($G::link{lport}); 114 115 # INET6 also supports v4, so use it for everything if it's available. That 116 # allows the module to handle A vs AAAA records on domain lookups where the 117 # user hasn't set a specific ip version to be used. If INET6 isn't available 118 # and it's a domain that only has AAAA records, INET will just handle it like 119 # a bogus record and we just won't be able to connect 120 if (avail("ipv6")) { 121 if ($G::link{force_ipv6}) { 122 push(@extra_options, "Domain", Socket::AF_INET6() ); 123 } elsif ($G::link{force_ipv4}) { 124 push(@extra_options, "Domain", Socket::AF_INET() ); 125 } 126 127 $G::link{sock} = IO::Socket::INET6->new( 128 PeerAddr => $G::link{server}, 129 PeerPort => $G::link{port}, 130 Proto => 'tcp', 131 Timeout => $G::link{timeout}, 132 @extra_options 133 ); 134 } else { 135 $G::link{sock} = IO::Socket::INET->new( 136 PeerAddr => $G::link{server}, 137 PeerPort => $G::link{port}, 138 Proto => 'tcp', 139 Timeout => $G::link{timeout}, 140 @extra_options 141 ); 142 } 143 144 if ($@) { 145 ptrans(12, "Error connecting" . ($G::link{lint} ? " $G::link{lint}" : '') . 146 " to $G::link{server}:$G::link{port}:\n\t$@"); 147 exit(2); 148 } 149 ptrans(11, "Connected to $G::link{server}."); 150 } elsif ($G::link{type} eq 'socket-unix') { 151 ptrans(11, 'Trying ' . $G::link{sockfile} . '...'); 152 $SIG{PIPE} = 'IGNORE'; 153 $@ = ""; 154 $G::link{sock} = IO::Socket::UNIX->new(Peer => $G::link{sockfile}, Timeout => $G::link{timeout}); 155 156 if ($@) { 157 ptrans(12, 'Error connecting to ' . $G::link{sockfile} . ":\n\t$@"); 158 exit(2); 159 } 160 ptrans(11, 'Connected to ' . $G::link{sockfile} . '.'); 161 } elsif ($G::link{type} eq 'pipe') { 162 $SIG{PIPE} = 'IGNORE'; 163 $SIG{CHLD} = 'IGNORE'; 164 ptrans(11, "Trying pipe to $G::link{process}..."); 165 eval{ open2($G::link{sock}{re}, $G::link{sock}{wr}, $G::link{process}); }; 166 167 if ($@) { 168 ptrans(12, 'Error connecting to ' . $G::link{process} . ":\n\t$@"); 169 exit(2); 170 } 171 select((select($G::link{sock}{wr}), $| = 1)[0]); 172 select((select($G::link{sock}{re}), $| = 1)[0]); 173 ptrans(11, 'Connected to ' . $G::link{process} . '.'); 174 } else { 175 ptrans(12, 'Unknown or unimplemented connection type ' . $G::link{type}); 176 exit(3); 177 } 178} 179 180sub sendmail { 181 my $from = shift; # envelope-from 182 my $to = shift; # envelope-to 183 my $helo = shift; # who am I? 184 my $data = shift; # body of message (content after DATA command) 185 my $a_user = shift; # what user to auth with? 186 my $a_pass = shift; # what pass to auth with 187 my $a_type = shift; # what kind of auth (this must be set to to attempt) 188 my $ehlo = {}; # If server is esmtp, save advertised features here 189 190 do_smtp_proxy() if ($G::proxy{try}); 191 192 # start up tls if -tlsc specified 193 if ($G::tls_on_connect) { 194 if (start_tls()) { 195 tls_post_start(); 196 do_smtp_drop() if ($G::drop_after eq 'tls'); 197 do_smtp_quit(1, 0) if ($G::quit_after eq 'tls'); 198 } else { 199 ptrans(12, "TLS startup failed ($G::link{tls}{res})"); 200 exit(29); 201 } 202 } 203 204 # read the server's 220 banner. 205 do_smtp_gen(undef, '220') || do_smtp_quit(1, 21); 206 do_smtp_drop() if ($G::drop_after eq 'connect'); 207 do_smtp_quit(1, 0) if ($G::quit_after eq 'connect'); 208 209 # Send a HELO string 210 $G::drop_before_read = 1 if ($G::drop_after_send eq 'first-helo'); 211 do_smtp_helo($helo, $ehlo, $G::protocol) || do_smtp_quit(1, 22); 212 do_smtp_drop() if ($G::drop_after eq 'first-helo'); 213 do_smtp_quit(1, 0) if ($G::quit_after eq 'first-helo'); 214 215 if ($G::xclient{before_tls}) { 216 xclient_try($helo, $ehlo); 217 } 218 219 # handle TLS here if user has requested it 220 if ($G::tls) { 221 # 0 = tls succeeded 222 # 1 = tls not advertised 223 # 2 = tls advertised and attempted negotiations failed 224 # note there's some duplicate logic here (with process_args) but I think 225 # it's best to do as thorough a job covering the options in both places 226 # so as to minimize chance of options falling through the cracks 227 $G::drop_before_read = 1 if ($G::drop_after_send eq 'tls'); 228 my $result = do_smtp_tls($ehlo); 229 if ($result == 1) { 230 ptrans(12, "Host did not advertise STARTTLS"); 231 do_smtp_quit(1, 29) if (!$G::tls_optional); 232 } elsif ($result == 2) { 233 ptrans(12, "STARTTLS attempted but failed"); 234 exit(29) if ($G::tls_optional != 1); 235 } 236 } elsif ($G::tls_optional == 2 && $ehlo->{STARTTLS}) { 237 ptrans(12, "TLS requested, advertised, and locally unavailable. Exiting"); 238 do_smtp_quit(1, 29); 239 } 240 do_smtp_drop() if ($G::drop_after eq 'tls'); 241 do_smtp_quit(1, 0) if ($G::quit_after eq 'tls'); 242 243 #if ($G::link{tls}{active} && $ehlo->{STARTTLS}) { 244 if ($G::link{tls}{active} && !$G::tls_on_connect) { 245 # According to RFC3207, we need to forget state info and re-EHLO here 246 $ehlo = {}; 247 $G::drop_before_read = 1 if ($G::drop_after_send eq 'helo'); 248 do_smtp_helo($helo, $ehlo, $G::protocol) || do_smtp_quit(1, 32); 249 } 250 do_smtp_drop() if ($G::drop_after_send eq 'helo'); # haaaack. Need to use first-helo for this. Just quit here to prevent the mail from being delivered 251 do_smtp_drop() if ($G::drop_after eq 'helo'); 252 do_smtp_quit(1, 0) if ($G::quit_after eq 'helo'); 253 254 if (!$G::xclient{before_tls}) { 255 xclient_try($helo, $ehlo); 256 } 257 258 # handle auth here if user has requested it 259 if ($a_type) { 260 # 0 = auth succeeded 261 # 1 = auth not advertised 262 # 2 = auth advertised but not attempted, no matching auth types 263 # 3 = auth advertised but not attempted, auth not supported 264 # 4 = auth advertised and attempted but no type succeeded 265 # note there's some duplicate logic here (with process_args) but I think 266 # it's best to do as thorough a job covering the options in both places 267 # so as to minimize chance of options falling through the cracks 268 $G::drop_before_read = 1 if ($G::drop_after_send eq 'auth'); 269 my $result = do_smtp_auth($ehlo, $a_type, $a_user, $a_pass); 270 if ($result == 1) { 271 ptrans(12, "Host did not advertise authentication"); 272 do_smtp_quit(1, 28) if (!$G::auth_optional); 273 } elsif ($result == 2) { 274 if ($G::auth_type eq 'ANY') { 275 ptrans(12, "Auth not attempted, no advertised types available"); 276 do_smtp_quit(1, 28) if ($G::auth_optional != 1); 277 } else { 278 ptrans(12, "Auth not attempted, requested type not available"); 279 do_smtp_quit(1, 28) if (!$G::auth_optional); 280 } 281 } elsif ($result == 3) { 282 ptrans(12, "Auth advertised but not supported locally"); 283 do_smtp_quit(1, 28) if ($G::auth_optional != 1); 284 } elsif ($result == 4) { 285 ptrans(12, "No authentication type succeeded"); 286 do_smtp_quit(1, 28) if ($G::auth_optional != 1); 287 } 288 } elsif ($G::auth_optional == 2 && $ehlo->{AUTH}) { 289 ptrans(12, "Auth requested, advertised, and locally unavailable. Exiting"); 290 do_smtp_quit(1, 28); 291 } 292 do_smtp_drop() if ($G::drop_after eq 'auth'); 293 do_smtp_quit(1, 0) if ($G::quit_after eq 'auth'); 294 295 # send MAIL 296 # 0 = mail succeeded 297 # 1 = prdr required but not advertised 298 $G::drop_before_read = 1 if ($G::drop_after_send eq 'mail'); 299 my $result = do_smtp_mail($ehlo, $from); # failures in this handled by smtp_mail_callback 300 if ($result == 1) { 301 ptrans(12, "Host did not advertise PRDR support"); 302 do_smtp_quit(1, 30); 303 } 304 do_smtp_drop() if ($G::drop_after eq 'mail'); 305 do_smtp_quit(1, 0) if ($G::quit_after eq 'mail'); 306 307 # send RCPT (sub handles multiple, comma-delimited recips) 308 $G::drop_before_read = 1 if ($G::drop_after_send eq 'rcpt'); 309 do_smtp_rcpt($to); # failures in this handled by smtp_rcpt_callback 310 # note that smtp_rcpt_callback increments 311 # $G::smtp_rcpt_failures at every failure. This and 312 # $G::smtp_rcpt_total are used after DATA for LMTP 313 do_smtp_drop() if ($G::drop_after eq 'rcpt'); 314 do_smtp_quit(1, 0) if ($G::quit_after eq 'rcpt'); 315 316 # send DATA 317 $G::drop_before_read = 1 if ($G::drop_after_send eq 'data'); 318 do_smtp_gen('DATA', '354') || do_smtp_quit(1, 25); 319 do_smtp_drop() if ($G::drop_after eq 'data'); 320 321 # send the actual data 322 $G::drop_before_read = 1 if ($G::drop_after_send eq 'dot'); 323 do_smtp_data($data, $G::suppress_data) || do_smtp_quit(1, 26); 324 do_smtp_drop() if ($G::drop_after eq 'dot'); 325 326 # send QUIT 327 do_smtp_quit(0) || do_smtp_quit(1, 27); 328} 329 330sub xclient_try { 331 my $helo = shift; 332 my $ehlo = shift; 333 334 if ($G::xclient{try}) { 335 # 0 - xclient succeeded normally 336 # 1 - xclient not advertised 337 # 2 - xclient advertised but not attempted, mismatch in requested attrs 338 # 3 - xclient attempted but did not succeed 339 $G::drop_before_read = 1 if ($G::drop_after_send eq 'xclient'); 340 my $result = do_smtp_xclient($ehlo); 341 if ($result == 1) { 342 ptrans(12, "Host did not advertise XCLIENT"); 343 do_smtp_quit(1, 33) if (!$G::xclient{optional}); 344 } elsif ($result == 2) { 345 ptrans(12, "Host did not advertise requested XCLIENT attributes"); 346 do_smtp_quit(1, 33) if (!$G::xclient{optional}); 347 } elsif ($result == 3) { 348 ptrans(12, "XCLIENT attempted but failed. Exiting"); 349 do_smtp_quit(1, 33) if ($G::xclient{optional} != 1); 350 } else { 351 do_smtp_drop() if ($G::drop_after eq 'xclient'); 352 do_smtp_quit(1, 0) if ($G::quit_after eq 'xclient'); 353 354 # re-helo if the XCLIENT command succeeded 355 $G::drop_before_read = 1 if ($G::drop_after_send eq 'helo'); 356 do_smtp_helo($helo, $ehlo, $G::protocol) || do_smtp_quit(1, 34); 357 do_smtp_drop() if ($G::drop_after eq 'helo'); 358 do_smtp_quit(1, 0) if ($G::quit_after eq 'helo'); 359 } 360 } 361} 362 363sub tls_post_start { 364 ptrans(11, "TLS started with cipher $G::link{tls}{cipher_string}"); 365 if ($G::link{tls}{local_cert_subject}) { 366 ptrans(11, "TLS local DN=\"$G::link{tls}{local_cert_subject}\""); 367 } else { 368 ptrans(11, "TLS no local certificate set"); 369 } 370 ptrans(11, "TLS peer DN=\"$G::link{tls}{cert_subject}\""); 371 372 if ($G::tls_get_peer_cert eq 'STDOUT') { 373 ptrans(11, $G::link{tls}{cert_x509}); 374 } elsif ($G::tls_get_peer_cert) { 375 open(CERT, ">$G::tls_get_peer_cert") || 376 ptrans(12, "Couldn't open $G::tls_get_peer_cert for writing: $!"); 377 print CERT $G::link{tls}{cert_x509}, "\n"; 378 close(CERT); 379 } 380} 381 382sub start_tls { 383 my %t = (); # This is a convenience var to access $G::link{tls}{...} 384 $G::link{tls} = \%t; 385 386 Net::SSLeay::load_error_strings(); 387 Net::SSLeay::SSLeay_add_ssl_algorithms(); 388 Net::SSLeay::randomize(); 389 if (!($t{con} = Net::SSLeay::CTX_new())) { 390 $t{res} = "CTX_new(): " . Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); 391 return(0); 392 } 393 394 my $ctx_options = &Net::SSLeay::OP_ALL; 395 if (scalar(@G::tls_protocols)) { 396 if ($G::tls_protocols[0] =~ /^no_/i) { 397 foreach my $p (@G::tls_supported_protocols) { 398 if (grep /^no_$p$/i, @G::tls_protocols) { 399 no strict "refs"; 400 $ctx_options |= &{"Net::SSLeay::OP_NO_$p"}(); 401 } 402 } 403 } else { 404 foreach my $p (@G::tls_supported_protocols) { 405 if (!grep /^$p$/i, @G::tls_protocols) { 406 no strict "refs"; 407 $ctx_options |= &{"Net::SSLeay::OP_NO_$p"}(); 408 } 409 } 410 } 411 } 412 Net::SSLeay::CTX_set_options($t{con}, $ctx_options); 413 Net::SSLeay::CTX_set_verify($t{con}, 0x01, 0) if ($G::tls_verify); 414 415 if ($G::tls_ca_path) { 416 my @args = ('', $G::tls_ca_path); 417 @args = ($G::tls_ca_path, '') if (-f $G::tls_ca_path); 418 if (!Net::SSLeay::CTX_load_verify_locations($t{con}, @args)) { 419 $t{res} = "Unable to set set CA path to (" . join(',', @args) . "): " 420 . Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); 421 return(0); 422 } 423 } else { 424 Net::SSLeay::CTX_set_default_verify_paths($t{con}); 425 } 426 427 if ($G::tls_cipher) { 428 if (!Net::SSLeay::CTX_set_cipher_list($t{con}, $G::tls_cipher)) { 429 $t{res} = "Unable to set cipher list to $G::tls_cipher: " 430 . Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); 431 return(0); 432 } 433 } 434 if ($G::tls_cert && $G::tls_key) { 435 if (!Net::SSLeay::CTX_use_certificate_file($t{con}, $G::tls_cert, &Net::SSLeay::FILETYPE_PEM)) { 436 $t{res} = "Unable to add cert file $G::tls_cert to SSL CTX: " 437 . Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); 438 return(0); 439 } 440 if (!Net::SSLeay::CTX_use_PrivateKey_file($t{con}, $G::tls_key, &Net::SSLeay::FILETYPE_PEM)) { 441 $t{res} = "Unable to add key file $G::tls_key to SSL CTX: " 442 . Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); 443 return(0); 444 } 445 } 446 447 if (!($t{ssl} = Net::SSLeay::new($t{con}))) { 448 $t{res} = "new(): " . Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); 449 return(0); 450 } 451 452 if ($G::tls_sni_hostname) { 453 if (!Net::SSLeay::set_tlsext_host_name($t{ssl}, $G::tls_sni_hostname)) { 454 $t{res} = "Unable to set SNI hostname to $G::tls_sni_hostname: " 455 . Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); 456 return(0); 457 } 458 } 459 460 if ($G::link{type} eq 'pipe') { 461 Net::SSLeay::set_wfd($t{ssl}, fileno($G::link{sock}{wr})); # error check? 462 Net::SSLeay::set_rfd($t{ssl}, fileno($G::link{sock}{re})); # error check? 463 } else { 464 Net::SSLeay::set_fd($t{ssl}, fileno($G::link{sock})); # error check? 465 } 466 467 $t{active} = Net::SSLeay::connect($t{ssl}) == 1 ? 1 : 0; 468 if (!$t{active}) { 469 $t{res} = "connect(): " . Net::SSLeay::ERR_error_string(Net::SSLeay::ERR_get_error()); 470 return(0); 471 } 472 473 # egrep 'define.*VERSION\b' *.h 474 # when adding new types here, see also the code that pushes supported values onto tls_supported_protocols 475 $t{version} = Net::SSLeay::version($t{ssl}); 476 if ($t{version} == 0x0002) { 477 $t{version} = "SSLv2"; # openssl/ssl2.h 478 } elsif ($t{version} == 0x0300) { 479 $t{version} = "SSLv3"; # openssl/ssl3.h 480 } elsif ($t{version} == 0x0301) { 481 $t{version} = "TLSv1"; # openssl/tls1.h 482 } elsif ($t{version} == 0x0302) { 483 $t{version} = "TLSv1.1"; # openssl/tls1.h 484 } elsif ($t{version} == 0x0303) { 485 $t{version} = "TLSv1.2"; # openssl/tls1.h 486 } elsif ($t{version} == 0x0304) { 487 $t{version} = "TLSv1.3"; # openssl/tls1.h 488 } elsif ($t{version} == 0xFEFF) { 489 $t{version} = "DTLSv1"; # openssl/dtls1.h 490 } elsif ($t{version} == 0xFEFD) { 491 $t{version} = "DTLSv1.2"; # openssl/dtls1.h 492 } else { 493 $t{version} = sprintf("UNKNOWN(0x%04X)", $t{version}); 494 } 495 $t{cipher} = Net::SSLeay::get_cipher($t{ssl}); 496 if (!$t{cipher}) { 497 $t{res} = "empty response from get_cipher()"; 498 return(0); 499 } 500 $t{cipher_bits} = Net::SSLeay::get_cipher_bits($t{ssl}, undef); 501 if (!$t{cipher_bits}) { 502 $t{res} = "empty response from get_cipher_bits()"; 503 return(0); 504 } 505 $t{cipher_string} = sprintf("%s:%s:%s", $t{version}, $t{cipher}, $t{cipher_bits}); 506 $t{cert} = Net::SSLeay::get_peer_certificate($t{ssl}); 507 if (!$t{cert}) { 508 $t{res} = "error response from get_peer_certificate()"; 509 return(0); 510 } 511 chomp($t{cert_x509} = Net::SSLeay::PEM_get_string_X509($t{cert})); 512 $t{cert_subject} = Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($t{cert})); 513 514 if ($G::tls_cert && $G::tls_key) { 515 $t{local_cert} = Net::SSLeay::get_certificate($t{ssl}); 516 chomp($t{local_cert_x509} = Net::SSLeay::PEM_get_string_X509($t{local_cert})); 517 $t{local_cert_subject} = Net::SSLeay::X509_NAME_oneline(Net::SSLeay::X509_get_subject_name($t{local_cert})); 518 } 519 520 return($t{active}); 521} 522 523sub deprecate { 524 my $message = shift; 525 526 ptrans(12, "DEPRECATION WARNING: $message"); 527} 528 529sub ptrans { 530 my $c = shift; # transaction flag 531 my $m = shift; # message to print 532 my $b = shift; # be brief in what we print 533 my $a = shift; # return the message in an array ref instead of printing 534 my $o = $G::trans_fh_oh || \*STDOUT; 535 my $f = ''; 536 537 return if (($G::hide_send && int($c/10) == 2) || 538 ($G::hide_receive && int($c/10) == 3) || 539 ($G::hide_informational && $c == 11) || 540 ($G::hide_all)); 541 542 # global option silent controls what we echo to the terminal 543 # 0 - print everything 544 # 1 - don't show anything until you hit an error, then show everything 545 # received after that (done by setting option to 0 on first error) 546 # 2 - don't show anything but errors 547 # >=3 - don't print anything 548 if ($G::silent > 0) { 549 return if ($G::silent >= 3); 550 return if ($G::silent == 2 && $c%2 != 0); 551 if ($G::silent == 1 && !$G::ptrans_seen_error) { 552 if ($c%2 != 0) { 553 return(); 554 } else { 555 $G::ptrans_seen_error = 1; 556 } 557 } 558 } 559 560 # 1x is program messages 561 # 2x is smtp send 562 # 3x is smtp recv 563 # x = 1 is info/normal 564 # x = 2 is error 565 # x = 3 dump output 566 # program info 567 if ($c == 11) { $f = $G::no_hints_info ? '' : '==='; } 568 # program error 569 elsif ($c == 12) { $f = $G::no_hints_info ? '' : '***'; $o = $G::trans_fh_eh || \*STDERR; } 570 # smtp send info 571 elsif ($c == 21) { $f = $G::no_hints_send ? '' : ($G::link{tls}{active} ? ' ~>' : ' ->'); } 572 # smtp send error 573 elsif ($c == 22) { $f = $G::no_hints_send ? '' : ($G::link{tls}{active} ? '*~>' : '**>'); } 574 # smtp send dump output 575 elsif ($c == 23) { $f = $G::no_hints_send ? '' : ' >'; } 576 # smtp recv info 577 elsif ($c == 31) { $f = $G::no_hints_recv ? '' : ($G::link{tls}{active} ? '<~ ' : '<- '); } 578 # smtp recv error 579 elsif ($c == 32) { $f = $G::no_hints_recv ? '' : ($G::link{tls}{active} ? '<~*' : '<**'); } 580 # smtp recv dump output 581 elsif ($c == 33) { $f = $G::no_hints_recv ? '' : '< '; } 582 # something went unexpectedly 583 else { $f = '???'; } 584 585 $f .= ' ' if ($f); 586 587 if ($b) { 588 # split to tmp list to prevent -w gripe 589 my @t = split(/\n/ms, $m); $m = scalar(@t) . " lines sent"; 590 } 591 $m =~ s/\n/\n$f/msg; 592 593 if ($a) { 594 $m = "$f$m"; 595 return([ split(/\n/, $m) ]); 596 } 597 else { 598 print $o "$f$m\n"; 599 } 600} 601 602sub do_smtp_quit { 603 my $exit = shift; 604 my $err = shift; 605 606 # Ugh. Because PIPELINING allows mail's and rcpt's send to be disconnected, 607 # and possibly with a QUIT between them, we need to set a global "we have 608 # told the server we quit already" flag to prevent double-quits 609 return(1) if ($G::link{quit_sent}); 610 $G::link{quit_sent} = 1; 611 612 $G::link{allow_lost_cxn} = 1; 613 my $r = do_smtp_gen('QUIT', '221'); 614 $G::link{allow_lost_cxn} = 0; 615 616 handle_disconnect($err) if ($G::link{lost_cxn}); 617 618 if ($exit) { 619 teardown_link(); 620 exit $err; 621 } 622 623 return($r); 624} 625 626sub do_smtp_drop { 627 ptrans(11, "Dropping connection"); 628 exit(0); 629} 630 631sub do_smtp_tls { 632 my $e = shift; # ehlo config hash 633 634 # 0 = tls succeeded 635 # 1 = tls not advertised 636 # 2 = tls advertised and attempted negotiations failed 637 if (!$e->{STARTTLS}) { 638 return(1); 639 } elsif (!do_smtp_gen("STARTTLS", '220')) { 640 return(2); 641 } elsif (!start_tls()) { 642 ptrans(12, "TLS startup failed ($G::link{tls}{res})"); 643 return(2); 644 } 645 tls_post_start(); 646 647 return(0); 648} 649 650sub do_smtp_xclient { 651 my $e = shift; 652 653 # 0 - xclient succeeded normally 654 # 1 - xclient not advertised 655 # 2 - xclient advertised but not attempted, mismatch in requested attrs 656 # 3 - xclient attempted but did not succeed 657 if (!$e->{XCLIENT}) { 658 return(1); 659 } 660 my @parts = (); 661 foreach my $attr (keys %{$G::xclient{attr}}) { 662 if (!$e->{XCLIENT}{$attr}) { 663 return(2) if (!$G::xclient{no_verify}); 664 } 665 } 666 667 foreach my $string (@{$G::xclient{strings}}) { 668 my $str = "XCLIENT " . $string; 669 do_smtp_gen($str, '220') || return(3); 670 } 671 return(0); 672} 673 674# see xtext encoding in http://tools.ietf.org/html/rfc1891 675sub to_xtext { 676 my $string = shift; 677 678 return join('', map { ($_ == 0x2b || $_ == 0x3d || $_ <= 0x20 || $_ >= 0xff) 679 ? sprintf("+%02X", $_) 680 : chr($_) 681 } (unpack("C*", $string))); 682} 683 684sub do_smtp_auth { 685 my $e = shift; # ehlo config hash 686 my $at = shift; # auth type 687 my $au = shift; # auth user 688 my $ap = shift; # auth password 689 690 return(1) if (!$e->{AUTH}); 691 return(3) if ($G::auth_unavailable); 692 693 my $auth_attempted = 0; # set to true if we ever attempt auth 694 695 foreach my $btype (@$at) { 696 # if server doesn't support, skip type (may change in future) 697 next if (!$e->{AUTH}{$btype}); 698 699 foreach my $type (@{$G::auth_map_t{'CRAM-MD5'}}) { 700 if ($btype eq $type) { 701 return(0) if (do_smtp_auth_cram($au, $ap, $type)); 702 $auth_attempted = 1; 703 } 704 } 705 foreach my $type (@{$G::auth_map_t{'CRAM-SHA1'}}) { 706 if ($btype eq $type) { 707 return(0) if (do_smtp_auth_cram($au, $ap, $type)); 708 $auth_attempted = 1; 709 } 710 } 711 foreach my $type (@{$G::auth_map_t{'DIGEST-MD5'}}) { 712 if ($btype eq $type) { 713 return(0) if (do_smtp_auth_digest($au, $ap, $type)); 714 $auth_attempted = 1; 715 } 716 } 717 foreach my $type (@{$G::auth_map_t{'NTLM'}}) { 718 if ($btype eq $type) { 719 return(0) if (do_smtp_auth_ntlm($au, $ap, $type)); 720 $auth_attempted = 1; 721 } 722 } 723 foreach my $type (@{$G::auth_map_t{'PLAIN'}}) { 724 if ($btype eq $type) { 725 return(0) if (do_smtp_auth_plain($au, $ap, $type)); 726 $auth_attempted = 1; 727 } 728 } 729 foreach my $type (@{$G::auth_map_t{'LOGIN'}}) { 730 if ($btype eq $type) { 731 return(0) if (do_smtp_auth_login($au, $ap, $type)); 732 $auth_attempted = 1; 733 } 734 } 735 } 736 737 return $auth_attempted ? 4 : 2; 738} 739 740sub do_smtp_auth_ntlm { 741 my $u = shift; # auth user 742 my $p = shift; # auth password 743 my $as = shift; # auth type (since NTLM might be SPA or MSN) 744 my $r = ''; # will store smtp response 745 746 my $auth_string = "AUTH $as"; 747 do_smtp_gen($auth_string, '334') || return(0); 748 749 my $d = db64(Authen::NTLM::ntlm()); 750 751 $auth_string = eb64($d); 752 do_smtp_gen($auth_string, '334', \$r, '', 753 $G::auth_showpt ? "$d" : '', 754 $G::auth_showpt ? \&unencode_smtp : '') || return(0); 755 756 $r =~ s/^....//; # maybe something a little better here? 757 Authen::NTLM::ntlm_domain($G::auth_extras{DOMAIN}); 758 Authen::NTLM::ntlm_user($u); 759 Authen::NTLM::ntlm_password($p); 760 $d = db64(Authen::NTLM::ntlm($r)); 761 762 $auth_string = eb64($d); 763 do_smtp_gen($auth_string, '235', \$r, '', $G::auth_showpt ? "$d" : '') || return(0); 764 765 return(1); 766} 767 768sub do_smtp_auth_digest { 769 my $u = shift; # auth user 770 my $p = shift; # auth password 771 my $as = shift; # auth string 772 my $r = ''; # will store smtp response 773 my $e = ''; # will store Authen::SASL errors 774 my @digest_uri = (); 775 776 if (exists($G::auth_extras{"DMD5-SERV-TYPE"})) { 777 $digest_uri[0] = $G::auth_extras{"DMD5-SERV-TYPE"}; 778 } else { 779 $digest_uri[0] = 'smtp'; 780 } 781 if (exists($G::auth_extras{"DMD5-HOST"})) { 782 $digest_uri[1] = $G::auth_extras{"DMD5-HOST"}; 783 } else { 784 if ($G::link{type} eq 'socket-unix') { 785 $digest_uri[1] = $G::link{sockfile}; 786 $digest_uri[1] =~ s|[^a-zA-Z0-9\.\-]|-|g; 787 } elsif ($G::link{type} eq 'pipe') { 788 $digest_uri[1] = $G::link{process}; 789 $digest_uri[1] =~ s|[^a-zA-Z0-9\.\-]|-|g; 790 } else { 791 $digest_uri[1] = $G::link{server}; 792 } 793 } 794 if (exists($G::auth_extras{"DMD5-SERV-NAME"})) { 795 # There seems to be a hole in the Authen::SASL interface where there's 796 # no option to directory provide the digest-uri serv-name. But we can 797 # trick it into using the value we want by tacking it onto the end of host 798 $digest_uri[1] .= '/' . $G::auth_extras{"DMD5-SERV-NAME"}; 799 } 800 801 my $auth_string = "AUTH $as"; 802 do_smtp_gen($auth_string, '334', \$r, '', '', $G::auth_showpt ? \&unencode_smtp : '') 803 || return(0); 804 805 $r =~ s/^....//; # maybe something a little better here? 806 $r = db64($r); 807 808 my $callbacks = { user => $u, pass => $p }; 809 if (exists($G::auth_extras{REALM})) { 810 $callbacks->{realm} = $G::auth_extras{REALM}; 811 } 812 813 my $sasl = Authen::SASL->new( 814 debug => 1, 815 mechanism => 'DIGEST-MD5', 816 callback => $callbacks, 817 ); 818 my $sasl_client = $sasl->client_new(@digest_uri); 819 820 # Force the DIGEST-MD5 session to use qop=auth. I'm open to exposing this setting 821 # via some swaks options, but I don't know enough about the protocol to just guess 822 # here. I do know that letting it auto-negotiate didn't work in my reference 823 # environment. sendmail advertised auth,auth-int,auth-conf, but when Authen::SASL 824 # chose auth-int the session would fail (server would say auth succeeded, but then 825 # immediately terminate my session when I sent MAIL). My reference client 826 # (Mulberry) always sent auth, and indeed forcing swaks to auth also seems to work. 827 # If anyone out there knows more about this please let me know. 828 $sasl_client->property('maxssf' => 0); 829 830 $auth_string = $sasl_client->client_step($r); 831 if ($e = $sasl_client->error()) { 832 ptrans('12', "Error received from Authen::SASL sub-system: $e"); 833 return(0); 834 } 835 836 do_smtp_gen(eb64($auth_string), '334', \$r, '', 837 $G::auth_showpt ? "$auth_string" : '', 838 $G::auth_showpt ? \&unencode_smtp : '') 839 || return(0); 840 $r =~ s/^....//; # maybe something a little better here? 841 $r = db64($r); 842 843 $auth_string = $sasl_client->client_step($r); 844 if ($e = $sasl_client->error()) { 845 ptrans('12', "Canceling SASL exchange, error received from Authen::SASL sub-system: $e"); 846 $auth_string = '*'; 847 } 848 #do_smtp_gen(eb64($auth_string), '235', \$r, '', $G::auth_showpt ? "$auth_string" : '') 849 do_smtp_gen($auth_string, '235', \$r, '', $auth_string) 850 || return(0); 851 if ($e = $sasl_client->error()) { 852 ptrans('12', "Error received from Authen::SASL sub-system: $e"); 853 return(0); 854 } 855 return(0) if (!$sasl_client->is_success()); 856 857 return(1); 858} 859 860# This can handle both CRAM-MD5 and CRAM-SHA1 861sub do_smtp_auth_cram { 862 my $u = shift; # auth user 863 my $p = shift; # auth password 864 my $as = shift; # auth string 865 my $r = ''; # will store smtp response 866 867 my $auth_string = "AUTH $as"; 868 do_smtp_gen($auth_string, '334', \$r, '', '', $G::auth_showpt ? \&unencode_smtp : '') 869 || return(0); 870 871 $r =~ s/^....//; # maybe something a little better here? 872 # specify which type of digest we need based on $as 873 my $d = get_digest($p, $r, ($as =~ /-SHA1$/ ? 'sha1' : 'md5')); 874 $auth_string = eb64("$u $d"); 875 876 do_smtp_gen($auth_string, '235', undef, '', $G::auth_showpt ? "$u $d" : '') || return(0); 877 return(1); 878} 879 880sub do_smtp_auth_login { 881 my $u = shift; # auth user 882 my $p = shift; # auth password 883 my $as = shift; # auth string 884 885 do_smtp_gen("AUTH $as", '334', undef, '', '', $G::auth_showpt ? \&unencode_smtp : '') 886 || return(0); 887 do_smtp_gen(eb64($u), '334', undef, '', $G::auth_showpt ? $u : '', $G::auth_showpt ? \&unencode_smtp : '') 888 || return(0); 889 do_smtp_gen(eb64($p), '235', undef, '', 890 $G::auth_showpt ? ($G::auth_hidepw || $p) : eb64($G::auth_hidepw || $p)) 891 || return(0); 892 return(1); 893} 894 895sub do_smtp_auth_plain { 896 my $u = shift; # auth user 897 my $p = shift; # auth password 898 my $as = shift; # auth string 899 900 return(do_smtp_gen("AUTH $as " . eb64("\0$u\0$p"), '235', undef, '', 901 $G::auth_showpt ? "AUTH $as \\0$u\\0" . ($G::auth_hidepw || $p) 902 : "AUTH $as " . eb64("\0$u\0" . ($G::auth_hidepw || $p)))); 903} 904 905sub do_smtp_helo { 906 my $h = shift; # helo string to use 907 my $e = shift; # this is a hashref that will be populated w/ server options 908 my $p = shift; # protocol for the transaction 909 my $r = ''; # this'll be populated by do_smtp_gen 910 911 if ($p eq 'esmtp' || $p eq 'lmtp') { 912 my $l = $p eq 'lmtp' ? "LHLO" : "EHLO"; 913 if (do_smtp_gen("$l $h", '250', \$r)) { 914 # There's not a standard structure for the $e hashref, each 915 # key is stored in the manner that makes the most sense 916 foreach my $l (split(/\n/, $r)) { 917 $l =~ s/^....//; 918 if ($l =~ /^AUTH=?(.*)$/) { 919 map { $e->{AUTH}{uc($_)} = 1 } (split(' ', $1)); 920 } elsif ($l =~ /^XCLIENT\s*(.*?)$/) { 921 $e->{XCLIENT} = {}; # prime the pump in case no attributes were advertised 922 map { $e->{XCLIENT}{uc($_)} = 1 } (split(' ', $1)); 923 } elsif ($l =~ /^STARTTLS$/) { 924 $e->{STARTTLS} = 1; 925 } elsif ($l =~ /^PIPELINING$/) { 926 $e->{PIPELINING} = 1; 927 $G::pipeline_adv = 1; 928 } elsif ($l =~ /^PRDR$/) { 929 $e->{PRDR} = 1; 930 } 931 } 932 return(1); 933 } 934 } 935 if ($p eq 'esmtp' || $p eq 'smtp') { 936 return(do_smtp_gen("HELO $h", '250')); 937 } 938 939 return(0); 940} 941 942sub do_smtp_mail { 943 my $e = shift; # ehlo response 944 my $a = shift; # from address 945 my $m = "MAIL FROM:<$a>"; 946 947 if ($G::prdr) { 948 if (!$e->{PRDR}) { 949 return(1); # PRDR was required but was not advertised. Return error and let caller handle it 950 } else { 951 $m .= " PRDR"; 952 } 953 } 954 955 transact(cxn_string => $m, expect => '250', defer => 1, fail_callback => \&smtp_mail_callback); 956 957 return(0); # the callback handles failures, so just return here 958} 959 960# this only really needs to exist until I figure out a clever way of making 961# do_smtp_quit the callback while still preserving the exit codes 962sub smtp_mail_callback { 963 do_smtp_quit(1, 23); 964} 965 966sub do_smtp_rcpt { 967 my $m = shift; # string of comma separated recipients 968 my $f = 0; # The number of failures we've experienced 969 my @a = split(/,/, $m); 970 $G::smtp_rcpt_total = scalar(@a); 971 972 foreach my $addr (@a) { 973 transact(cxn_string => 'RCPT TO:<' . $addr . '>', expect => '250', defer => 1, 974 fail_callback => \&smtp_rcpt_callback); 975 } 976 977 return(1); # the callback handles failures, so just return here 978} 979 980sub smtp_rcpt_callback { 981 # record that a failure occurred 982 $G::smtp_rcpt_failures++; 983 984 # if the number of failures is the same as the total rcpts (if every rcpt rejected), quit. 985 if ($G::smtp_rcpt_failures == $G::smtp_rcpt_total) { 986 do_smtp_quit(1, 24); 987 } 988} 989 990sub do_smtp_data { 991 my $m = shift; # string to send 992 my $b = shift; # be brief in the data we send 993 my $r = ''; # will store smtp response 994 my $e = $G::prdr ? '(250|353)' : '250'; 995 996 my $calls = $G::smtp_rcpt_total - $G::smtp_rcpt_failures; 997 my $ok = transact(cxn_string => $m, expect => $e, summarize_output => $b, return_text => \$r); 998 999 # now be a little messy - lmtp is not a lockstep after data - we need to 1000 # listen for as many calls as we had accepted recipients 1001 if ($G::protocol eq 'lmtp') { 1002 foreach my $c (1..($calls-1)) { # -1 because we already got 1 above 1003 $ok += transact(cxn_string => undef, expect => '250'); 1004 } 1005 } elsif ($G::protocol eq 'esmtp' && $G::prdr && $r =~ /^353 /) { 1006 foreach my $c (1..$calls) { 1007 transact(cxn_string => undef, expect => '250'); # read the status of each recipient off the wire 1008 } 1009 $ok = transact(cxn_string => undef, expect => '250'); # PRDR has an overall acceptance string, read it here and use it as th success indicator 1010 } 1011 return($ok) 1012} 1013 1014sub do_smtp_gen { 1015 my $m = shift; # string to send (if empty, we won't send anything, only read) 1016 my $e = shift; # String we're expecting to get back 1017 my $p = shift; # if this is a scalar ref, assign the server return string to it 1018 my $b = shift; # be brief in the data we print 1019 my $x = shift; # if this is populated, print this instead of $m 1020 my $c = shift; # if this is a code ref, call it on the return value before printing it 1021 my $n = shift; # if true, when the data is sent over the wire, it will not have \r\n appended to it 1022 my $r = shift; # if true, we won't try to ready a response from the server 1023 1024 return transact(cxn_string => $m, expect => $e, return_text => $p, 1025 summarize_output => $b, show_string => $x, print_callback => $c, 1026 no_newline => $n, no_read_response => $r, 1027 ); 1028} 1029 1030sub do_smtp_proxy { 1031 my $send = undef; 1032 my $print = undef; 1033 my $no_newline = 0; 1034 1035 if ($G::proxy{version} == 2) { 1036 $send = pack("W[12]", 0x0D, 0x0A,0x0D, 0x0A, 0x00, 0x0D, 0x0A, 0x51, 0x55, 0x49, 0x54, 0x0A); 1037 if ($G::proxy{raw}) { 1038 $send .= $G::proxy{raw}; 1039 } else { 1040 # byte 13 1041 # 4 bits = version (required to be 0x2) 1042 # 4 bits = command (0x2 = LOCAL, 0x1 = PROXY) 1043 $send .= pack("W", 0x20 + ($G::proxy{attr}{command} eq 'LOCAL' ? 0x02 : 0x01)); 1044 if ($G::proxy{attr}{command} eq 'LOCAL') { 1045 # the protocol byte (14, including family and protocol) are ignored with local. Set to zeros 1046 $send .= pack("W", 0x00); 1047 # and, additionally, if we're local, there isn't going to be any address size (bytes 15 and 16) 1048 $send .= pack("W", 0x00); 1049 } else { 1050 # byte 14 1051 # 4 bits = address family (0x0 = AF_UNSPEC, 0x1 = AF_INET, 0x2 = AF_INET6, 0x3 = AF_UNIX) 1052 # 4 bits = transport protocol (0x0 = UNSPEC, 0x1 = STREAM, 0x2 = DGRAM) 1053 my $byte = 0; 1054 if ($G::proxy{attr}{family} eq 'AF_UNSPEC') { 1055 $byte = 0x00; 1056 } elsif ($G::proxy{attr}{family} eq 'AF_INET') { 1057 $byte = 0x10; 1058 } elsif ($G::proxy{attr}{family} eq 'AF_INET6') { 1059 $byte = 0x20; 1060 } elsif ($G::proxy{attr}{family} eq 'AF_UNIX') { 1061 $byte = 0x30; 1062 } 1063 if ($G::proxy{attr}{protocol} eq 'UNSPEC') { 1064 $byte += 0x0; 1065 } elsif ($G::proxy{attr}{protocol} eq 'STREAM') { 1066 $byte += 0x1; 1067 } elsif ($G::proxy{attr}{protocol} eq 'DGRAM') { 1068 $byte += 0x2; 1069 } 1070 $send .= pack("W", $byte); 1071 1072 # network portion (bytes 17+) 1073 my $net = pack_ip($G::proxy{attr}{source}) 1074 . pack_ip($G::proxy{attr}{dest}) 1075 . pack("n", $G::proxy{attr}{source_port}) 1076 . pack("n", $G::proxy{attr}{dest_port}); 1077 $send .= pack("n", length($net)) . $net; # add bytes 15+16 (length of network portion) plus the network portion 1078 } 1079 } 1080 1081 # version 2 is binary, so uuencode it before printing. Also, version 2 REQUIREs that you not send \r\n after it down the wire 1082 $print = eb64($send); 1083 $no_newline = 1; 1084 } else { 1085 if ($G::proxy{raw}) { 1086 $send = "PROXY $G::proxy{raw}"; 1087 } else { 1088 $send = join(' ', 'PROXY', $G::proxy{attr}{family}, $G::proxy{attr}{source}, $G::proxy{attr}{dest}, $G::proxy{attr}{source_port}, $G::proxy{attr}{dest_port}); 1089 } 1090 } 1091 1092 do_smtp_gen($send, # to be send over the wire 1093 '220', # response code indicating success 1094 undef, # the return string from the server (don't need it) 1095 0, # do not be brief when printing 1096 $print, # if populated, print this instead of $send 1097 undef, # don't want a post-processing callback 1098 $no_newline, # if true, don't add \r\n to the end of $send when sent over the wire 1099 1, # don't read a response - we only want to send the value 1100 ); 1101} 1102 1103# no special attempt made at verifying, on purpose 1104sub pack_ip { 1105 my $ip = shift; 1106 1107 if ($ip =~ /:/) { 1108 # this is the stupidest piece of code ever. Please tell me all the fun ways it breaks 1109 my @pieces = split(/:/, $ip); 1110 my $p; 1111 shift(@pieces) if ($pieces[0] eq '' && $pieces[1] eq ''); # 1112 foreach my $word (@pieces) { 1113 if ($word eq '') { 1114 foreach my $i (0..(8-scalar(@pieces))) { 1115 $p .= pack("n", 0); 1116 } 1117 } else { 1118 $p .= pack("n", hex($word)); 1119 } 1120 } 1121 return($p); 1122 } else { 1123 return(pack("W*", split(/\./, $ip))); 1124 } 1125} 1126 1127# If we detect that the other side has gone away when we were expecting 1128# to still be reading, come in here to error and die. Abstracted because 1129# the error message will vary depending on the type of connection 1130sub handle_disconnect { 1131 my $e = shift || 6; # this is the code we will exit with 1132 if ($G::link{type} eq 'socket-inet') { 1133 ptrans(12, "Remote host closed connection unexpectedly."); 1134 } elsif ($G::link{type} eq 'socket-unix') { 1135 ptrans(12, "Socket closed connection unexpectedly."); 1136 } elsif ($G::link{type} eq 'pipe') { 1137 ptrans(12, "Child process closed connection unexpectedly."); 1138 } 1139 exit($e); 1140} 1141 1142sub flush_send_buffer { 1143 my $s = $G::link{type} eq 'pipe' ? $G::link{sock}->{wr} : $G::link{sock}; 1144 return if (!$G::send_buffer); 1145 if ($G::link{tls}{active}) { 1146 my $res = Net::SSLeay::write($G::link{tls}{ssl}, $G::send_buffer); 1147 } else { 1148 print $s $G::send_buffer; 1149 } 1150 ptrans(23, hdump($G::send_buffer)) if ($G::show_raw_text); 1151 $G::send_buffer = ''; 1152} 1153 1154sub send_data { 1155 my $d = shift; # data to write 1156 my $nnl = shift || 0; # if true, don't add a newline (needed for PROXY v2 support) 1157 $G::send_buffer .= $d . ($nnl ? '' : "\r\n"); 1158} 1159 1160sub recv_line { 1161 # Either an IO::Socket obj or a FH to my child - the thing to read from 1162 my $s = $G::link{type} eq 'pipe' ? $G::link{sock}->{re} : $G::link{sock}; 1163 my $r = undef; 1164 my $t = undef; 1165 my $c = 0; 1166 1167 while ($G::recv_buffer !~ m|\n|si) { 1168 last if (++$c > 1000); # Maybe I'll remove this once I trust this code more 1169 if ($G::link{tls}{active}) { 1170 $t = Net::SSLeay::read($G::link{tls}{ssl}); 1171 return($t) if (!defined($t)); 1172 1173 # THIS CODE COPIED FROM THE ELSE BELOW. Found I could trip this condition 1174 # by having the server sever the connection but not have swaks realize the 1175 # connection was gone. For instance, send a PIPELINE mail that includes a 1176 # "-q rcpt". There was a bug in swaks that made it try to send another quit 1177 # later, thus tripping this "1000 reads" error (but only in TLS). 1178 # Short term: add line below to prevent these reads 1179 # Short Term: fix the "double-quit" bug 1180 # Longer term: test to see if remote side closed connection 1181 1182 # the above line should be good enough but it isn't returning 1183 # undef for some reason. I think heuristically it will be sufficient 1184 # to just look for an empty packet (I hope. gulp). Comment out the 1185 # following line if your swaks seems to be saying that it lost connection 1186 # for no good reason. Then email me about it. 1187 return(undef()) if (!length($t)); 1188 } elsif ($G::link{type} eq 'pipe') { 1189 # XXX in a future release see if I can get read() or equiv to work on a pipe 1190 $t = <$s>; 1191 return($t) if (!defined($t)); 1192 1193 # THIS CODE COPIED FROM THE ELSE BELOW. 1194 # the above line should be good enough but it isn't returning 1195 # undef for some reason. I think heuristically it will be sufficient 1196 # to just look for an empty packet (I hope. gulp). Comment out the 1197 # following line if your swaks seems to be saying that it lost connection 1198 # for no good reason. Then email me about it. 1199 return(undef()) if (!length($t)); 1200 } else { 1201 # if you're having problems with reads, swap the comments on the 1202 # the following two lines 1203 my $recv_r = recv($s, $t, 8192, 0); 1204 #$t = <$s>; 1205 return($t) if (!defined($t)); 1206 1207 # the above line should be good enough but it isn't returning 1208 # undef for some reason. I think heuristically it will be sufficient 1209 # to just look for an empty packet (I hope. gulp). Comment out the 1210 # following line if your swaks seems to be saying that it lost connection 1211 # for no good reason. Then email me about it. 1212 return(undef()) if (!length($t)); 1213 1214 #print "\$t = $t (defined = ", defined($t) ? "yes" : "no", 1215 # "), \$recv_r = $recv_r (", defined($recv_r) ? "yes" : "no", ")\n"; 1216 } 1217 $G::recv_buffer .= $t; 1218 ptrans(33, hdump($t)) if ($G::show_raw_text); 1219 } 1220 1221 if ($c >= 1000) { 1222 # If you saw this in the wild, I'd love to hear more about it 1223 # at proj-swaks@jetmore.net 1224 ptrans(12, "In recv_line, hit loop counter. Continuing in unknown state"); 1225 } 1226 1227 # using only bare newlines is bound to cause me problems in the future 1228 # but it matches the expectation we've already been using. All we can 1229 # do is hone in on the proper behavior iteratively. 1230 if ($G::recv_buffer =~ s|^(.*?\n)||si) { 1231 $r = $1; 1232 } else { 1233 ptrans(12, "I'm in an impossible state"); 1234 } 1235 1236 $r =~ s|\r||msg; 1237 return($r); 1238} 1239 1240# any request which has immediate set will be checking the return code. 1241# any non-immediate request will handle results through fail_callback(). 1242# therefore, only return the state of the last transaction attempted, 1243# which will always be immediate 1244# defer - if true, does not require immediate flush when pipelining 1245# cxn_string - What we will be sending the server. If undefined, we won't send, only read 1246# no_read_response - if true, we won't read a response from the server, we'll just send 1247# summarize_output - if true, don't print to terminal everything we send to server 1248# no_newline - if true, do not append \r\n to the data we send to server 1249# return_text - should be scalar ref. will be assigned reference to what was returned from server 1250# print_callback - if present and a code reference, will be called with server return data for printing to terminal 1251# fail_callback - if present and a code reference, will be called on failure 1252sub transact { 1253 my %h = @_; # this is an smtp transaction element 1254 my $ret = 1; # this is our return value 1255 my @handlers = (); # will hold any fail_handlers we need to run 1256 my $time = ''; # used in time lapse calculations 1257 1258 push(@G::pending_send, \%h); # push onto send queue 1259 if (!($G::pipeline && $G::pipeline_adv) || !$h{defer}) { 1260 1261 if ($G::show_time_lapse eq 'hires') { 1262 $time = [Time::HiRes::gettimeofday()]; 1263 } 1264 elsif ($G::show_time_lapse eq 'integer') { 1265 $time = time(); 1266 } 1267 1268 while (my $i = shift(@G::pending_send)) { 1269 if (defined($i->{cxn_string})) { 1270 ptrans(21, $i->{show_string} || $i->{cxn_string}, $i->{summarize_output}); 1271 send_data($i->{cxn_string}, $i->{no_newline}); 1272 } 1273 push(@G::pending_recv, $i) if (!$i->{no_read_response}); 1274 } 1275 flush_send_buffer(); 1276 1277 do_smtp_drop() if ($G::drop_before_read); 1278 1279 while (my $i = shift(@G::pending_recv)) { 1280 my $buff = ''; 1281 eval { 1282 local $SIG{'ALRM'} = sub { 1283 $buff = "Timeout ($G::link{timeout} secs) waiting for server response"; 1284 die; 1285 }; 1286 alarm($G::link{timeout}); 1287 while ($buff !~ /^\d\d\d /m) { 1288 my $l = recv_line(); 1289 $buff .= $l; 1290 if (!defined($l)) { 1291 $G::link{lost_cxn} = 1; 1292 last; 1293 } 1294 } 1295 chomp($buff); 1296 alarm(0); 1297 }; 1298 1299 if ($G::show_time_lapse eq 'hires') { 1300 $time = sprintf("%0.03f", Time::HiRes::tv_interval($time, [Time::HiRes::gettimeofday()])); 1301 ptrans(11, "response in ${time}s"); 1302 $time = [Time::HiRes::gettimeofday()]; 1303 } elsif ($G::show_time_lapse eq 'integer') { 1304 $time = time() - $time; 1305 ptrans(11, "response in ${time}s"); 1306 $time = time(); 1307 } 1308 1309 ${$i->{return_text}} = $buff; 1310 $buff = &{$i->{print_callback}}($buff) if (ref($i->{print_callback}) eq 'CODE'); 1311 my $ptc; 1312 ($ret,$ptc) = $buff !~ /^$i->{expect} /m ? (0,32) : (1,31); 1313 ptrans($ptc, $buff) if ($buff); 1314 if ($G::link{lost_cxn}) { 1315 if ($G::link{allow_lost_cxn}) { 1316 # this means the calling code wants to handle a lost cxn itself 1317 return($ret); 1318 } else { 1319 # if caller didn't want to handle, we'll handle a lost cxn ourselves 1320 handle_disconnect(); 1321 } 1322 } 1323 if (!$ret && ref($i->{fail_callback}) eq 'CODE') { 1324 push(@handlers, $i->{fail_callback}); 1325 } 1326 } 1327 } 1328 foreach my $h (@handlers) { &{$h}(); } 1329 return($ret); 1330} 1331 1332# a quick-and-dirty hex dumper. Currently used by --show-raw-text 1333sub hdump { 1334 my $r = shift; 1335 my $c = 0; # counter 1336 my $i = 16; # increment value 1337 my $b; # buffer 1338 1339 while (length($r) && ($r =~ s|^(.{1,$i})||smi)) { 1340 my $s = $1; # $s will be the ascii string we manipulate for display 1341 my @c = map { ord($_); } (split('', $s)); 1342 $s =~ s|[^\x21-\x7E]|.|g; 1343 1344 my $hfs = ''; # This is the hex format string for printf 1345 for (my $hc = 0; $hc < $i; $hc++) { 1346 $hfs .= ' ' if (!($hc%4)); 1347 if ($hc < scalar(@c)) { $hfs .= '%02X '; } else { $hfs .= ' '; } 1348 } 1349 1350 $b .= sprintf("%04d:$hfs %-16s\n", $c, @c, $s); 1351 $c += $i; 1352 } 1353 chomp($b); # inelegant remnant of hdump's previous life 1354 return($b) 1355} 1356 1357sub unencode_smtp { 1358 my $t = shift; 1359 1360 my @t = split(' ', $t, 2); 1361 if ($t[1] =~ /\s/) { 1362 # very occasionally we can have a situation where a successful response will 1363 # be b64 encoded, while an error will not be. Try to tell the difference. 1364 return($t); 1365 } else { 1366 return("$t[0] " . db64($t[1])); 1367 } 1368} 1369 1370sub obtain_from_netrc { 1371 my $field = shift; 1372 my $login = shift; 1373 1374 return if !avail('netrc'); 1375 1376 if (my $netrc = Net::Netrc->lookup($G::link{server}, defined($login) ? $login : ())) { 1377 return($netrc->$field); 1378 } 1379 1380 return; 1381} 1382 1383sub interact { 1384 my $prompt = shift; 1385 my $regexp = shift; 1386 my $hide_input = shift; 1387 my $response = ''; 1388 1389 do { 1390 print $prompt; 1391 if (!$hide_input || !$G::protect_prompt || $G::interact_method eq 'default') { 1392 chomp($response = <STDIN>); 1393 } else { 1394 if ($^O eq 'MSWin32') { 1395 #if ($G::interact_method eq "win32-console" || 1396 # (!$G::interact_method && load("Win32::Console"))) 1397 #{ 1398 # Couldn't get this working in the time I wanted to devote to it 1399 #} 1400 if ($G::interact_method eq "win32-readkey" || 1401 (!$G::interact_method && load("Term::ReadKey"))) 1402 { 1403 $G::interact_method ||= "win32-readkey"; 1404 # the trick to replace input w/ '*' doesn't work on Win32 1405 # Term::ReadKey, so just use it as an stty replacement 1406 ReadMode('noecho'); 1407 # need to think about this on windows some more 1408 #local $SIG{INT} = sub { ReadMode('restore'); }; 1409 chomp($response = <STDIN>); 1410 ReadMode('restore'); 1411 print "\n"; 1412 } else { 1413 $G::interact_method ||= "default"; 1414 chomp($response = <STDIN>); 1415 } 1416 } else { 1417 if ($G::interact_method eq "unix-readkey" || (!$G::interact_method && load("Term::ReadKey"))) { 1418 $G::interact_method ||= "unix-readkey"; 1419 my @resp = (); 1420 ReadMode('raw'); 1421 #local $SIG{INT} = 1422 # reevaluate this code - what happens if del is first char we press? 1423 while ((my $kp = ReadKey(0)) ne "\n") { 1424 my $kp_num = ord($kp); 1425 if($kp_num == 127 || $kp_num == 8) { 1426 next if (!scalar(@resp)); 1427 pop(@resp); 1428 print "\b \b"; 1429 } elsif($kp_num >= 32) { 1430 push(@resp, $kp); 1431 print "*"; 1432 } 1433 } 1434 ReadMode('restore'); 1435 print "\n"; 1436 $response = join('', @resp); 1437 } elsif ($G::interact_method eq "unix-stty" || (!$G::interact_method && open(STTY, "stty -a |"))) { 1438 $G::interact_method ||= "unix-stty"; 1439 { my $foo = join('', <STTY>); } 1440 system('stty', '-echo'); 1441 chomp($response = <STDIN>); 1442 system('stty', 'echo'); 1443 print "\n"; 1444 } else { 1445 $G::interact_method ||= "default"; 1446 chomp($response = <STDIN>); 1447 } 1448 } 1449 } 1450 } while ($regexp ne 'SKIP' && $response !~ /$regexp/); 1451 1452 return($response); 1453} 1454 1455sub get_messageid { 1456 if (!$G::message_id) { 1457 my @time = localtime(); 1458 $G::message_id = sprintf("%04d%02d%02d%02d%02d%02d.%06d\@%s", 1459 $time[5]+1900, $time[4]+1, $time[3], $time[2], $time[1], $time[0], 1460 $$, get_hostname()); 1461 } 1462 1463 return($G::message_id); 1464} 1465 1466sub get_hostname { 1467 # in some cases hostname returns value but gethostbyname doesn't. 1468 return("") if (!avail("hostname")); 1469 1470 my $h = hostname(); 1471 return("") if (!$h); 1472 1473 my $l = (gethostbyname($h))[0]; 1474 return($l || $h); 1475} 1476 1477sub get_server { 1478 my $addr = shift; 1479 my $pref = -1; 1480 my $server = "localhost"; 1481 1482 if ($addr =~ /\@?\[(\d+\.\d+\.\d+\.\d+)\]$/) { 1483 # handle automatic routing of domain literals (user@[1.2.3.4]) 1484 return($1); 1485 } elsif ($addr =~ /\@?\#(\d+)$/) { 1486 # handle automatic routing of decimal domain literals (user@#16909060) 1487 $addr = $1; 1488 return(($addr/(2**24))%(2**8) . '.' . ($addr/(2**16))%(2**8) . '.' . 1489 ($addr/(2**8))%(2**8) . '.' . ($addr/(2**0))%(2**8)); 1490 } 1491 1492 if (!avail("dns")) { 1493 ptrans(12, avail_str("dns"). ". Using $server as mail server"); 1494 return($server); 1495 } 1496 my $res = Net::DNS::Resolver->new(); 1497 1498 $addr =~ s/^.*\@([^\@]*)$/$1/; 1499 return($server) if (!$addr); 1500 $server = $addr; 1501 1502 my @mx = mx($res, $addr); 1503 foreach my $rr (sort { $a->preference <=> $b->preference } @mx) { 1504 if ($G::link{force_ipv4}) { 1505 if ($res->query($rr->exchange, 'A')) { 1506 $server = $rr->exchange; 1507 last; 1508 } 1509 } elsif ($G::link{force_ipv6}) { 1510 if ($res->query($rr->exchange, 'AAAA') || $res->query($rr->exchange, 'A6')) { 1511 $server = $rr->exchange; 1512 last; 1513 } 1514 } else { 1515 # this is the old default behavior. Take the best priority MX, no matter what. 1516 $server = $rr->exchange; 1517 last; 1518 } 1519 } 1520 return($server); 1521} 1522 1523sub load { 1524 my $m = shift; 1525 1526 return $G::modules{$m} if (exists($G::modules{$m})); 1527 eval("use $m"); 1528 return $G::modules{$m} = $@ ? 0 : 1; 1529} 1530 1531# Currently this is just an informational string - it's set on both 1532# success and failure. It currently has four output formats (supported, 1533# supported but not optimal, unsupported, unsupported and missing optimal) 1534sub avail_str { return $G::dependencies{$_[0]}{errstr}; } 1535 1536sub avail { 1537 my $f = shift; # this is the feature we want to check support for (auth, tls) 1538 my $s = \%G::dependencies; 1539 1540 # return immediately if we've already tested this. 1541 return($s->{$f}{avail}) if (exists($s->{$f}{avail})); 1542 1543 $s->{$f}{req_failed} = []; 1544 $s->{$f}{opt_failed} = []; 1545 foreach my $m (@{$s->{$f}{req}}) { 1546 push(@{$s->{$f}{req_failed}}, $m) if (!load($m)); 1547 } 1548 foreach my $m (@{$s->{$f}{opt}}) { 1549 push(@{$s->{$f}{opt_failed}}, $m) if (!load($m)); 1550 } 1551 1552 if (scalar(@{$s->{$f}{req_failed}})) { 1553 $s->{$f}{errstr} = "$s->{$f}{name} not available: requires " . join(', ', @{$s->{$f}{req_failed}}); 1554 if (scalar(@{$s->{$f}{opt_failed}})) { 1555 $s->{$f}{errstr} .= ". Also missing optimizing " . join(', ', @{$s->{$f}{opt_failed}}); 1556 } 1557 return $s->{$f}{avail} = 0; 1558 } else { 1559 if (scalar(@{$s->{$f}{opt_failed}})) { 1560 $s->{$f}{errstr} = "$s->{$f}{name} supported, but missing optimizing " . 1561 join(', ', @{$s->{$f}{opt_failed}}); 1562 } else { 1563 $s->{$f}{errstr} = "$s->{$f}{name} supported"; 1564 } 1565 return $s->{$f}{avail} = 1; 1566 } 1567} 1568 1569sub get_digest { 1570 my $secr = shift; 1571 my $chal = shift; 1572 my $type = shift || 'md5'; 1573 my $ipad = chr(0x36) x 64; 1574 my $opad = chr(0x5c) x 64; 1575 1576 if ($chal !~ /^</) { 1577 chomp($chal = db64($chal)); 1578 } 1579 1580 if (length($secr) > 64) { 1581 if ($type eq 'md5') { 1582 $secr = Digest::MD5::md5($secr); 1583 } elsif ($type eq 'sha1') { 1584 $secr = Digest::SHA::sha1($secr); 1585 } 1586 } else { 1587 $secr .= chr(0) x (64 - length($secr)); 1588 } 1589 1590 my $digest = $type eq 'md5' ? Digest::MD5::md5_hex(($secr ^ $opad), Digest::MD5::md5(($secr ^ $ipad), $chal)) 1591 : Digest::SHA::sha1_hex(($secr ^ $opad), Digest::SHA::sha1(($secr ^ $ipad), $chal)); 1592 return($digest); 1593} 1594 1595sub test_support { 1596 my $return = shift; 1597 my $lines = []; 1598 my $s = \%G::dependencies; 1599 1600 foreach my $act (sort { $s->{$a}{name} cmp $s->{$b}{name} } keys %$s) { 1601 if ($return) { 1602 push(@$lines, @{ptrans(avail($act) ? 11 : 12, avail_str($act), undef, 1)}); 1603 } 1604 else { 1605 ptrans(avail($act) ? 11 : 12, avail_str($act)); 1606 } 1607 } 1608 1609 if ($return) { 1610 return($lines); 1611 } 1612} 1613 1614sub time_to_seconds { 1615 my $t = shift; 1616 1617 if ($t !~ /^(\d+)([hms])?$/i) { 1618 ptrans(12, 'Unknown timeout format \'' . $t . '\''); 1619 exit(1); 1620 } else { 1621 my $r = $1; 1622 my $u = lc($2); 1623 if ($u eq 'h') { 1624 return($r * 3600); 1625 } elsif ($u eq 'm') { 1626 return($r * 60); 1627 } else { 1628 return($r); 1629 } 1630 } 1631} 1632 1633sub load_dependencies { 1634 %G::dependencies = ( 1635 auth => { name => "Basic AUTH", opt => ['MIME::Base64'], 1636 req => [] }, 1637 auth_cram_md5 => { name => "AUTH CRAM-MD5", req => ['Digest::MD5'] }, 1638 auth_cram_sha1 => { name => "AUTH CRAM-SHA1", req => ['Digest::SHA'] }, 1639 auth_ntlm => { name => "AUTH NTLM", req => ['Authen::NTLM'] }, 1640 auth_digest_md5 => { name => "AUTH DIGEST-MD5", req => ['Authen::SASL'] }, 1641 dns => { name => "MX Routing", req => ['Net::DNS'] }, 1642 netrc => { name => 'Netrc Credentials', req => ['Net::Netrc'] }, 1643 tls => { name => "TLS", req => ['Net::SSLeay'] }, 1644 pipe => { name => "Pipe Transport", req => ['IPC::Open2'] }, 1645 socket => { name => "Socket Transport", req => ['IO::Socket'] }, 1646 ipv6 => { name => "IPv6", req => ['IO::Socket::INET6'] }, 1647 date_manip => { name => "Date Manipulation", req => ['POSIX'] }, 1648 hostname => { name => "Local Hostname Detection", req => ['Sys::Hostname'] }, 1649 hires_timing => { name => "High Resolution Timing", req => ['Time::HiRes'] }, 1650 ); 1651} 1652 1653sub process_opt_silent { 1654 my $opt = shift; 1655 my $arg = shift; 1656 1657 if ($arg =~ /^[123]$/) { 1658 return($arg); 1659 } 1660 else { 1661 return(1); 1662 } 1663} 1664 1665sub get_option_struct { 1666 use constant { 1667 OP_ARG_OPT => 0x01, # option takes an optional argument 1668 OP_ARG_REQ => 0x02, # option takes a required argument 1669 OP_ARG_NONE => 0x04, # option does not take any argument (will return boolean) 1670 OP_FROM_PROMPT => 0x08, # option prompts for an argument if none provided 1671 OP_FROM_FILE => 0x10, # option treats arg of '-' to mean 'read from stdin' (no prompt) 1672 OP_DEPRECATED => 0x20, # This option is deprecated 1673 OP_SENSITIVE => 0x40, # indicates that if prompted for, the argument should be masked (see --protect-prompt) 1674 }; 1675 1676 @G::raw_option_data = ( 1677 # location of config file. Note that the "config" option is processed differently 1678 # than any other option because it needs to be processed before standard option processing 1679 # can happen. We still define it here to make Getopt::Long and fetch_args() happy. 1680 { opts => ['config'], suffix => ':s', 1681 cfgs => OP_ARG_OPT, 1682 okey => 'config_file', type => 'scalar', }, 1683 # envelope-(f)rom address 1684 { opts => ['from', 'f'], suffix => ':s', 1685 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1686 prompt => 'From: ', match => '^.*$', 1687 okey => 'mail_from', type => 'scalar', }, 1688 # envelope-(t)o address 1689 { opts => ['to', 't'], suffix => ':s', 1690 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1691 prompt => 'To: ', match => '^.+$', 1692 okey => 'mail_to', type => 'scalar', }, 1693 # (h)elo string 1694 { opts => ['helo', 'ehlo', 'lhlo', 'h'], suffix => ':s', 1695 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1696 prompt => 'Helo: ', match => '^.*$', 1697 okey => 'mail_helo', type => 'scalar', }, 1698 # (s)erver to use 1699 { opts => ['server', 's'], suffix => ':s', 1700 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1701 prompt => 'Server: ', match => '^.*$', 1702 okey => 'mail_server', type => 'scalar', }, 1703 # force ipv4 only 1704 { opts => ['4'], suffix => '', 1705 cfgs => OP_ARG_NONE, 1706 okey => 'force_ipv4', type => 'scalar', }, 1707 # force ipv6 only 1708 { opts => ['6'], suffix => '', 1709 cfgs => OP_ARG_NONE, 1710 okey => 'force_ipv6', type => 'scalar', }, 1711 # copy MX/routing from another domain 1712 { opts => ['copy-routing'], suffix => ':s', 1713 cfgs => OP_ARG_REQ, 1714 okey => 'copy_routing', type => 'scalar', }, 1715 # (p)ort to use 1716 { opts => ['port', 'p'], suffix => ':s', 1717 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1718 prompt => 'Port: ', match => '^\w+$', 1719 okey => 'mail_port', type => 'scalar', }, 1720 # protocol to use (smtp, esmtp, lmtp) 1721 { opts => ['protocol'], suffix => '=s', 1722 cfgs => OP_ARG_REQ, 1723 okey => 'mail_protocol', type => 'scalar', }, 1724 # (d)ata portion ('\n' for newlines) 1725 { opts => ['data', 'd'], suffix => ':s', 1726 cfgs => OP_ARG_REQ|OP_FROM_PROMPT|OP_FROM_FILE, 1727 prompt => 'Data: ', match => '^.*$', 1728 okey => 'mail_data', type => 'scalar', }, 1729 # use the --dump text as default body 1730 { opts => ['dump-as-body', 'dab'], suffix => ':s', 1731 cfgs => OP_ARG_OPT, 1732 okey => 'dump_as_body', type => 'scalar', }, 1733 # implies --dump-as-body; forces raw passwords to be used 1734 { opts => ['dump-as-body-shows-password', 'dabsp'], suffix => '', 1735 cfgs => OP_ARG_NONE, 1736 okey => 'dab_sp', type => 'scalar', }, 1737 # timeout for each trans (def 30s) 1738 { opts => ['timeout'], suffix => ':s', 1739 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1740 prompt => 'Timeout: ', match => '^\d+[hHmMsS]?$', 1741 okey => 'timeout', type => 'scalar', }, 1742 # (q)uit after 1743 { opts => ['quit-after', 'quit', 'q'], suffix => '=s', 1744 cfgs => OP_ARG_REQ, 1745 okey => 'quit_after', type => 'scalar', }, 1746 # drop after (don't quit, just drop) 1747 { opts => ['drop-after', 'drop', 'da'], suffix => '=s', 1748 cfgs => OP_ARG_REQ, 1749 okey => 'drop_after', type => 'scalar', }, 1750 # drop after send (between send and read) 1751 { opts => ['drop-after-send', 'das'], suffix => '=s', 1752 cfgs => OP_ARG_REQ, 1753 okey => 'drop_after_send', type => 'scalar', }, 1754 # do (n)ot print data portion 1755 { opts => ['suppress-data', 'n'], suffix => '', 1756 cfgs => OP_ARG_NONE, 1757 okey => 'suppress_data', type => 'scalar', }, 1758 # force auth, exit if not supported 1759 { opts => ['auth', 'a'], suffix => ':s', 1760 cfgs => OP_ARG_OPT, 1761 okey => 'auth', type => 'scalar', }, 1762 # user for auth 1763 { opts => ['auth-user', 'au'], suffix => ':s', 1764 cfgs => OP_ARG_OPT, # we dynamically change this later 1765 okey => 'auth_user', type => 'scalar', }, 1766 # pass for auth 1767 { opts => ['auth-password', 'ap'], suffix => ':s', 1768 cfgs => OP_ARG_OPT|OP_SENSITIVE, # we dynamically change this later 1769 okey => 'auth_pass', type => 'scalar', }, 1770 # auth type map 1771 { opts => ['auth-map', 'am'], suffix => '=s', 1772 cfgs => OP_ARG_REQ, 1773 okey => 'auth_map', type => 'scalar', }, 1774 # extra, authenticator-specific options 1775 { opts => ['auth-extra', 'ae'], suffix => '=s', 1776 cfgs => OP_ARG_REQ, 1777 okey => 'auth_extra', type => 'scalar', }, 1778 # hide passwords when possible 1779 { opts => ['auth-hide-password', 'ahp'], suffix => ':s', 1780 cfgs => OP_ARG_OPT, 1781 okey => 'auth_hidepw', type => 'scalar', }, 1782 # translate base64 strings 1783 { opts => ['auth-plaintext', 'apt'], suffix => '', 1784 cfgs => OP_ARG_NONE, 1785 okey => 'auth_showpt', type => 'scalar', }, 1786 # auth optional (ignore failure) 1787 { opts => ['auth-optional', 'ao'], suffix => ':s', 1788 cfgs => OP_ARG_OPT, 1789 okey => 'auth_optional', type => 'scalar', }, 1790 # req auth if avail 1791 { opts => ['auth-optional-strict', 'aos'], suffix => ':s', 1792 cfgs => OP_ARG_OPT, 1793 okey => 'auth_optional_strict', type => 'scalar', }, 1794 # report capabilties 1795 { opts => ['support'], suffix => '', 1796 cfgs => OP_ARG_NONE, 1797 okey => 'get_support', type => 'scalar', }, 1798 # local interface to use 1799 { opts => ['local-interface', 'li'], suffix => ':s', 1800 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1801 prompt => 'Interface: ', match => '^.*$', 1802 okey => 'lint', type => 'scalar', }, 1803 # local port 1804 { opts => ['local-port', 'lport', 'lp'], suffix => ':s', 1805 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1806 prompt => 'Local Port: ', match => '^\w+$', 1807 okey => 'lport', type => 'scalar', }, 1808 # use TLS 1809 { opts => ['tls'], suffix => '', 1810 cfgs => OP_ARG_NONE, 1811 okey => 'tls', type => 'scalar', }, 1812 # use tls if available 1813 { opts => ['tls-optional', 'tlso'], suffix => '', 1814 cfgs => OP_ARG_NONE, 1815 okey => 'tls_optional', type => 'scalar', }, 1816 # req tls if avail 1817 { opts => ['tls-optional-strict', 'tlsos'], suffix => '', 1818 cfgs => OP_ARG_NONE, 1819 okey => 'tls_optional_strict', type => 'scalar', }, 1820 # use tls if available 1821 { opts => ['tls-on-connect', 'tlsc'], suffix => '', 1822 cfgs => OP_ARG_NONE, 1823 okey => 'tls_on_connect', type => 'scalar', }, 1824 # local cert to present to server 1825 { opts => ['tls-cert'], suffix => '=s', 1826 cfgs => OP_ARG_REQ, 1827 okey => 'tls_cert', type => 'scalar', }, 1828 # local key to present to server 1829 { opts => ['tls-key'], suffix => '=s', 1830 cfgs => OP_ARG_REQ, 1831 okey => 'tls_key', type => 'scalar', }, 1832 # tls protocol to use 1833 { opts => ['tls-protocol', 'tlsp'], suffix => '=s', 1834 cfgs => OP_ARG_REQ, 1835 okey => 'tls_protocol', type => 'scalar', }, 1836 # tls cipher to use 1837 { opts => ['tls-cipher'], suffix => '=s', 1838 cfgs => OP_ARG_REQ, 1839 okey => 'tls_cipher', type => 'scalar', }, 1840 # save tls peer certificate 1841 { opts => ['tls-get-peer-cert'], suffix => ':s', 1842 cfgs => OP_ARG_OPT, 1843 okey => 'tls_get_peer_cert', type => 'scalar', }, 1844 # hostname to request in TLS SNI header 1845 { opts => ['tls-sni'], suffix => '=s', 1846 cfgs => OP_ARG_REQ, 1847 okey => 'tls_sni_hostname', type => 'scalar', }, 1848 # require verification of server certificate 1849 { opts => ['tls-verify'], suffix => '', 1850 cfgs => OP_ARG_NONE, 1851 okey => 'tls_verify', type => 'scalar', }, 1852 # local key to present to server 1853 { opts => ['tls-ca-path'], suffix => '=s', 1854 cfgs => OP_ARG_REQ, 1855 okey => 'tls_ca_path', type => 'scalar', }, 1856 # suppress output to varying degrees 1857 { opts => ['silent', 'S'], suffix => ':i', 1858 cfgs => OP_ARG_OPT, 1859 callout => \&process_opt_silent, 1860 okey => 'silent', type => 'scalar', }, 1861 # Don't strip From_ line from DATA 1862 { opts => ['no-strip-from', 'nsf'], suffix => '', 1863 cfgs => OP_ARG_NONE, 1864 okey => 'no_strip_from', type => 'scalar', }, 1865 # Don't show send/receive hints (legacy) 1866 { opts => ['no-hints', 'nth'], suffix => '', 1867 cfgs => OP_ARG_NONE, 1868 okey => 'no_hints', type => 'scalar', }, 1869 # Don't show transaction hints 1870 { opts => ['no-send-hints', 'nsh'], suffix => '', 1871 cfgs => OP_ARG_NONE, 1872 okey => 'no_hints_send', type => 'scalar', }, 1873 # Don't show transaction hints 1874 { opts => ['no-receive-hints', 'nrh'], suffix => '', 1875 cfgs => OP_ARG_NONE, 1876 okey => 'no_hints_recv', type => 'scalar', }, 1877 # Don't show transaction hints 1878 { opts => ['no-info-hints', 'nih'], suffix => '', 1879 cfgs => OP_ARG_NONE, 1880 okey => 'no_hints_info', type => 'scalar', }, 1881 # Don't show reception lines 1882 { opts => ['hide-receive', 'hr'], suffix => '', 1883 cfgs => OP_ARG_NONE, 1884 okey => 'hide_receive', type => 'scalar', }, 1885 # Don't show sending lines 1886 { opts => ['hide-send', 'hs'], suffix => '', 1887 cfgs => OP_ARG_NONE, 1888 okey => 'hide_send', type => 'scalar', }, 1889 # Don't echo input on potentially sensitive prompts 1890 { opts => ['protect-prompt', 'pp'], suffix => '', 1891 cfgs => OP_ARG_NONE, 1892 okey => 'protect_prompt', type => 'scalar', }, 1893 # Don't show any swaks-generated, non-error informational lines 1894 { opts => ['hide-informational', 'hi'], suffix => '', 1895 cfgs => OP_ARG_NONE, 1896 okey => 'hide_informational', type => 'scalar', }, 1897 # Don't send any output to the terminal 1898 { opts => ['hide-all', 'ha'], suffix => '', 1899 cfgs => OP_ARG_NONE, 1900 okey => 'hide_all', type => 'scalar', }, 1901 # print lapse for send/recv 1902 { opts => ['show-time-lapse', 'stl'], suffix => ':s', 1903 cfgs => OP_ARG_OPT, 1904 okey => 'show_time_lapse', type => 'scalar', }, 1905 # print version and exit 1906 { opts => ['version'], suffix => '', 1907 cfgs => OP_ARG_NONE, 1908 okey => 'version', type => 'scalar', }, 1909 # print help and exit 1910 { opts => ['help'], suffix => '', 1911 cfgs => OP_ARG_NONE, 1912 okey => 'help', type => 'scalar', }, 1913 # don't touch the data 1914 { opts => ['no-data-fixup', 'ndf'], suffix => '', 1915 cfgs => OP_ARG_NONE, 1916 okey => 'no_data_fixup', type => 'scalar', }, 1917 # show dumps of the raw read/written text 1918 { opts => ['show-raw-text', 'raw'], suffix => '', 1919 cfgs => OP_ARG_NONE, 1920 okey => 'show_raw_text', type => 'scalar', }, 1921 # specify file to write to 1922 { opts => ['output', 'output-file'], suffix => '=s', 1923 cfgs => OP_ARG_REQ, 1924 okey => 'output_file', type => 'scalar', }, 1925 # specify file to write to 1926 { opts => ['output-file-stdout'], suffix => '=s', 1927 cfgs => OP_ARG_REQ, 1928 okey => 'output_file_stdout', type => 'scalar', }, 1929 # specify file to write to 1930 { opts => ['output-file-stderr'], suffix => '=s', 1931 cfgs => OP_ARG_REQ, 1932 okey => 'output_file_stderr', type => 'scalar', }, 1933 # command to communicate with 1934 { opts => ['pipe'], suffix => ':s', 1935 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1936 prompt => 'Pipe: ', match => '^.+$', 1937 okey => 'pipe_cmd', type => 'scalar', }, 1938 # unix domain socket to talk to 1939 { opts => ['socket'], suffix => ':s', 1940 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1941 prompt => 'Socket File: ', match => '^.+$', 1942 okey => 'socket', type => 'scalar', }, 1943 # the content of the body of the DATA 1944 { opts => ['body'], suffix => ':s', 1945 cfgs => OP_ARG_REQ|OP_FROM_PROMPT|OP_FROM_FILE, 1946 prompt => 'Body: ', match => '.+', 1947 okey => 'body_822', type => 'scalar', }, 1948 # A file to attach 1949 { opts => ['attach-name'], suffix => ':s', 1950 cfgs => OP_ARG_OPT, 1951 okey => 'attach_name', akey => 'attach_accum', type => 'list', }, 1952 # A file to attach 1953 { opts => ['attach-type'], suffix => ':s', 1954 cfgs => OP_ARG_REQ, 1955 okey => 'attach_type', akey => 'attach_accum', type => 'list', }, 1956 # A file to attach 1957 { opts => ['attach'], suffix => ':s', 1958 cfgs => OP_ARG_REQ|OP_FROM_FILE, 1959 okey => 'attach_attach', akey => 'attach_accum', type => 'list', }, 1960 # A file to attach 1961 { opts => ['attach-body'], suffix => ':s', 1962 cfgs => OP_ARG_REQ|OP_FROM_FILE, 1963 okey => 'attach_body', akey => 'attach_accum', type => 'list', }, 1964 # replacement for %NEW_HEADERS% DATA token 1965 { opts => ['add-header', 'ah'], suffix => ':s', 1966 cfgs => OP_ARG_REQ, 1967 okey => 'add_header', type => 'list', }, 1968 # replace header if exist, else add 1969 { opts => ['header'], suffix => ':s', 1970 cfgs => OP_ARG_REQ, 1971 okey => 'header', type => 'list', }, 1972 # build options and dump 1973 { opts => ['dump'], suffix => ':s', 1974 cfgs => OP_ARG_OPT, 1975 okey => 'dump_args', type => 'scalar', }, 1976 # build options and dump the generate message body (EML) 1977 { opts => ['dump-mail'], suffix => '', 1978 cfgs => OP_ARG_NONE, 1979 okey => 'dump_mail', type => 'scalar', }, 1980 # attempt PIPELINING 1981 { opts => ['pipeline'], suffix => '', 1982 cfgs => OP_ARG_NONE, 1983 okey => 'pipeline', type => 'scalar', }, 1984 # attempt PRDR 1985 { opts => ['prdr'], suffix => '', 1986 cfgs => OP_ARG_NONE, 1987 okey => 'prdr', type => 'scalar', }, 1988 # use getpwuid building -f 1989 { opts => ['force-getpwuid'], suffix => '', 1990 cfgs => OP_ARG_NONE, 1991 okey => 'force_getpwuid', type => 'scalar', }, 1992 1993 # XCLIENT 1994 # These xclient_attrs options all get pushed onto an array so that we can determine their order later 1995 # argument is a raw XCLIENT string 1996 { opts => ['xclient'], suffix => ':s', 1997 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 1998 prompt => 'XCLIENT string: ', match => '^.+$', 1999 okey => 'xclient_raw', akey => 'xclient_accum', type => 'list', }, 2000 # XCLIENT NAME 2001 { opts => ['xclient-name'], suffix => ':s', 2002 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2003 prompt => 'XCLIENT name: ', match => '^.+$', 2004 okey => 'xclient_name', akey => 'xclient_accum', type => 'scalar', }, 2005 # XCLIENT ADDR 2006 { opts => ['xclient-addr'], suffix => ':s', 2007 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2008 prompt => 'XCLIENT addr: ', match => '^.+$', 2009 okey => 'xclient_addr', akey => 'xclient_accum', type => 'scalar', }, 2010 # XCLIENT PORT 2011 { opts => ['xclient-port'], suffix => ':s', 2012 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2013 prompt => 'XCLIENT port: ', match => '^.+$', 2014 okey => 'xclient_port', akey => 'xclient_accum', type => 'scalar', }, 2015 # XCLIENT PROTO 2016 { opts => ['xclient-proto'], suffix => ':s', 2017 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2018 prompt => 'XCLIENT proto: ', match => '^.+$', 2019 okey => 'xclient_proto', akey => 'xclient_accum', type => 'scalar', }, 2020 # XCLIENT DESTADDR 2021 { opts => ['xclient-destaddr'], suffix => ':s', 2022 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2023 prompt => 'XCLIENT destaddr: ', match => '^.+$', 2024 okey => 'xclient_destaddr', akey => 'xclient_accum', type => 'scalar', }, 2025 # XCLIENT DESTPORT 2026 { opts => ['xclient-destport'], suffix => ':s', 2027 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2028 prompt => 'XCLIENT destport: ', match => '^.+$', 2029 okey => 'xclient_destport', akey => 'xclient_accum', type => 'scalar', }, 2030 # XCLIENT HELO 2031 { opts => ['xclient-helo'], suffix => ':s', 2032 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2033 prompt => 'XCLIENT helo: ', match => '^.+$', 2034 okey => 'xclient_helo', akey => 'xclient_accum', type => 'scalar', }, 2035 # XCLIENT LOGIN 2036 { opts => ['xclient-login'], suffix => ':s', 2037 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2038 prompt => 'XCLIENT login: ', match => '^.+$', 2039 okey => 'xclient_login', akey => 'xclient_accum', type => 'scalar', }, 2040 # XCLIENT REVERSE_NAME 2041 { opts => ['xclient-reverse-name'], suffix => ':s', 2042 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2043 prompt => 'XCLIENT reverse_name: ', match => '^.+$', 2044 okey => 'xclient_reverse_name', akey => 'xclient_accum', type => 'scalar', }, 2045 # XCLIENT delimiter. Used to indicate that user wants to start a new xclient attr grouping 2046 { opts => ['xclient-delim'], suffix => '', 2047 cfgs => OP_ARG_NONE, 2048 okey => 'xclient_delim', akey => 'xclient_accum', type => 'list', }, 2049 # if set, XCLIENT will proceed even if XCLIENT not advertised 2050 { opts => ['xclient-optional'], suffix => '', 2051 cfgs => OP_ARG_NONE, 2052 okey => 'xclient_optional', type => 'scalar', }, 2053 # proceed if xclient not offered, but fail if offered and not accepted 2054 { opts => ['xclient-optional-strict'], suffix => '', 2055 cfgs => OP_ARG_NONE, 2056 okey => 'xclient_optional_strict', type => 'scalar', }, 2057 # we send xclient after starttls by default. if --xclient-before-starttls will send before tls 2058 { opts => ['xclient-before-starttls'], suffix => '', 2059 cfgs => OP_ARG_NONE, 2060 okey => 'xclient_before_starttls', type => 'scalar', }, 2061 # Don't require that the --xclient-ATTR attributes be advertised by server 2062 { opts => ['xclient-no-verify'], suffix => '', 2063 cfgs => OP_ARG_NONE, 2064 okey => 'xclient_no_verify', type => 'scalar', }, 2065 ## xclient send by default after first helo, but can be sent almost anywhere (cf quit-after) 2066 # { opts => ['xclient-after'], suffix => ':s', 2067 # okey => 'xclient_after', type => 'scalar', }, 2068 2069 # PROXY 2070 # argument is the raw PROXY string 2071 { opts => ['proxy'], suffix => ':s', 2072 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2073 prompt => 'PROXY string: ', match => '^.+$', 2074 okey => 'proxy_raw', type => 'scalar', }, 2075 # PROXY version (1 or 2) 2076 { opts => ['proxy-version'], suffix => ':s', 2077 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2078 prompt => 'PROXY version: ', match => '^[12]$', 2079 okey => 'proxy_version', type => 'scalar', }, 2080 # PROXY protocol family (TCP4 or TCP6) 2081 { opts => ['proxy-family'], suffix => ':s', 2082 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2083 prompt => 'PROXY family: ', match => '^.+$', 2084 okey => 'proxy_family', type => 'scalar', }, 2085 # PROXY protocol command (LOCAL or PROXY) 2086 { opts => ['proxy-command'], suffix => ':s', 2087 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2088 prompt => 'PROXY command: ', match => '^.+$', 2089 okey => 'proxy_command', type => 'scalar', }, 2090 # PROXY transport protocol 2091 { opts => ['proxy-protocol'], suffix => ':s', 2092 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2093 prompt => 'PROXY protocol: ', match => '^.+$', 2094 okey => 'proxy_protocol', type => 'scalar', }, 2095 # PROXY source address (IPv4 or IPv6) 2096 { opts => ['proxy-source'], suffix => ':s', 2097 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2098 prompt => 'PROXY source: ', match => '^.+$', 2099 okey => 'proxy_source', type => 'scalar', }, 2100 # PROXY source port 2101 { opts => ['proxy-source-port'], suffix => ':s', 2102 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2103 prompt => 'PROXY source_port: ', match => '^.+$', 2104 okey => 'proxy_source_port', type => 'scalar', }, 2105 # PROXY destination address (IPv4 or IPv6) 2106 { opts => ['proxy-dest'], suffix => ':s', 2107 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2108 prompt => 'PROXY dest: ', match => '^.+$', 2109 okey => 'proxy_dest', type => 'scalar', }, 2110 # PROXY destination port 2111 { opts => ['proxy-dest-port'], suffix => ':s', 2112 cfgs => OP_ARG_REQ|OP_FROM_PROMPT, 2113 prompt => 'PROXY dest_port: ', match => '^.+$', 2114 okey => 'proxy_dest_port', type => 'scalar', }, 2115 2116 # this option serve no purpose other than testing the deprecation system 2117 { opts => ['trigger-deprecation'], suffix => ':s', 2118 cfgs => OP_ARG_REQ|OP_DEPRECATED, 2119 okey => 'trigger_deprecation', type => 'scalar', }, 2120 ); 2121 2122 return(\@G::raw_option_data); 2123} 2124 2125# returns %O, the large raw option hash 2126# This sub is a jumping point. We will construct an argv based on the different ways that options can be specified 2127# and call GetOptions multiple times. We are essentially "layering" options. First we load from a config file (if 2128# exists/specified), then from any environment variables, then the actual command line. 2129sub load_args { 2130 my %ARGS = (); # this is the structure that gets returned 2131 my @fakeARGV = (); 2132 2133 # we load our options processing hash here. We abstract it back from the 2134 # native getopt-format because we need to be able to intercept "no-" options 2135 my $option_list = get_option_struct(); 2136 2137 # do a loop through the options and make sure they are structured the way we expect 2138 foreach my $e (@$option_list) { 2139 if (!exists($e->{okey}) || !$e->{okey}) { 2140 ptrans(12, 'Option configuration missing an okey (this is a swaks bug)'); 2141 exit(1); 2142 } 2143 elsif (!exists($e->{opts}) || ref($e->{opts}) ne 'ARRAY') { 2144 ptrans(12, 'Option ' . $e->{okey} . ' missing or corrupt opts key (this is a swaks bug)'); 2145 exit(1); 2146 } 2147 elsif (!exists($e->{suffix})) { 2148 ptrans(12, 'Option ' . $e->{okey} . ' missing suffix key (this is a swaks bug)'); 2149 exit(1); 2150 } 2151 elsif (!exists($e->{type}) || $e->{type} !~ /^(scalar|list)$/) { 2152 ptrans(12, 'Option ' . $e->{okey} . ' missing or invalid type key (this is a swaks bug)'); 2153 exit(1); 2154 } 2155 elsif (!exists($e->{cfgs})) { 2156 ptrans(12, 'Option ' . $e->{okey} . ' missing cfgs key (this is a swaks bug)'); 2157 exit(1); 2158 } 2159 2160 $e->{akey} = $e->{okey} if (!exists($e->{akey})); 2161 2162 # 'cfgs' stores the okey config for easier access later 2163 $ARGS{cfgs}{$e->{okey}} = $e; 2164 } 2165 2166 # we want to process config files first. There's a default config file in 2167 # ~/.swaksrc, but it is possible for the user to override this with the 2168 # --config options. So, find the one and only file we will use here. 2169 # If we encounter --config in later processing it is a noop. 2170 # first find the default file 2171 my $config_file = ''; 2172 my $skip_config = 0; 2173 my $config_is_default = 1; 2174 foreach my $v (qw(SWAKS_HOME HOME LOGDIR)) { 2175 if (exists($ENV{$v}) && length($ENV{$v}) && -f $ENV{$v} . '/.swaksrc') { 2176 $config_file = $ENV{$v} . '/.swaksrc'; 2177 last; 2178 } 2179 } 2180 # then look through the ENV args to see if another file set there 2181 if (exists($ENV{SWAKS_OPT_config})) { 2182 if (!$ENV{SWAKS_OPT_config}) { 2183 # if exist but not set, it just means "don't use default file" 2184 $skip_config = 1; 2185 } else { 2186 $config_file = $ENV{SWAKS_OPT_config}; 2187 $config_is_default = 0; 2188 } 2189 } 2190 # lastly go (backwards) through original command line looking for config file, 2191 # choosing the first one found (meaning last one specified) 2192 for (my $i = scalar(@ARGV) - 1; $i >= 0; $i--) { 2193 if ($ARGV[$i] =~ /^-?-config$/) { 2194 if ($i == scalar(@ARGV) - 1 || $ARGV[$i+1] =~ /^-/) { 2195 $skip_config = 1; 2196 } else { 2197 $config_file = $ARGV[$i+1]; 2198 $config_is_default = 0; 2199 $skip_config = 0; 2200 } 2201 last; 2202 } 2203 } 2204 2205 # All of the above will result in $config_file either being empty or 2206 # containing the one and only config file we will use (though merged with DATA) 2207 if (!$skip_config) { 2208 my @configs = ('&DATA'); 2209 push(@configs, $config_file) if ($config_file); 2210 foreach my $configf (@configs) { 2211 my @fakeARGV = (); 2212 if (open(C, '<' . $configf)) { 2213 # "#" in col 0 is a comment 2214 while (defined(my $m = <C>)) { 2215 next if ($m =~ m|^#|); 2216 chomp($m); 2217 $m = '--' . $m if ($m !~ /^-/); 2218 push(@fakeARGV, split(/\s/, $m, 2)); 2219 } 2220 close(C); 2221 } elsif (!$config_is_default && $configf eq $config_file) { 2222 # we only print an error if the config was specified explicitly 2223 ptrans(12, 'Config file ' . $configf . ' could not be opened ($!). Exiting'); 2224 exit(1); 2225 } 2226 2227 # OK, all that work to load @fakeARGV with values from the config file. Now 2228 # we just need to process it. (don't call if nothing set in @fakeARGV) 2229 fetch_args(\%ARGS, $option_list, \@fakeARGV) if (scalar(@fakeARGV)); 2230 check_opt_processing(\@fakeARGV, 'Config file ' . $configf); 2231 } 2232 } 2233 2234 # OK, %ARGS contains all the settings from the config file. Now do it again 2235 # with SWAKS_OPT_* environment variables 2236 @fakeARGV = (); 2237 foreach my $v (sort keys %ENV) { 2238 if ($v =~ m|^SWAKS_OPT_(.*)$|) { 2239 my $tv = $1; $tv =~ s|_|-|g; 2240 push(@fakeARGV, '--' . $tv); 2241 push(@fakeARGV, $ENV{$v}) if (length($ENV{$v})); 2242 } 2243 } 2244 fetch_args(\%ARGS, $option_list, \@fakeARGV) if (scalar(@fakeARGV)); 2245 check_opt_processing(\@fakeARGV, 'environment'); 2246 2247 # and now, after all of that, process the actual cmdline args 2248 fetch_args(\%ARGS, $option_list, \@ARGV) if (scalar(@ARGV)); 2249 check_opt_processing(\@ARGV, 'command line'); 2250 2251 return(\%ARGS); 2252} 2253 2254# if there's anything left in the fake argv after Getopts processed it, it's an error. There's nothing 2255# that can be passed in to swaks that isn't an option or an argument to an option, all of which Getopt 2256# should consume. So if there's anything left, the user did something weird. Just let them know and 2257# error instead of letting them think their ignored stuff is working. 2258sub check_opt_processing { 2259 my $argv_local = shift; 2260 my $option_type = shift; 2261 2262 if (scalar(@$argv_local)) { 2263 ptrans(12, 'Data left in option list when processing ' . $option_type . ' (' . 2264 join(', ', map { "'$_'" } (@$argv_local)) . 2265 '). Exiting'); 2266 exit(1); 2267 } 2268} 2269 2270sub fetch_args { 2271 my $r = shift; 2272 my $l = shift; 2273 my $argv_local = shift; 2274 2275 my %to_delete = (); 2276 2277 # need to rewrite header-HEADER opts before std option parsing 2278 # also see if there are any --no- options that need to be processed 2279 RUNOPTS: 2280 for (my $i = 0; $i < scalar(@$argv_local); $i++) { 2281 # before doing any option processing, massage from the optional '--option=arg' format into '--option arg' format. 2282 if ($argv_local->[$i] =~ /^(-[^=]+)=(.*)$/) { 2283 $argv_local->[$i] = $1; 2284 splice(@$argv_local, $i+1, 0, $2); 2285 } 2286 2287 # -g is not really necessary. It is now deprecated. During the deprecation window, make 2288 # it a straight-up alias to `--data -`. If has already appeared, just ignore -g. If 2289 # --data has not appeared, change -g into `--data -`. 2290 if ($argv_local->[$i] =~ /^-?-g$/) { 2291 deprecate('The -g option is deprecated and will be removed. Please use \'--data -\' instead.'); 2292 if (scalar(grep(/^-?-data$/, @$argv_local)) || check_arg('mail_data', $r)) { 2293 # if --data appears in the current stream or has already appeared in a previous stream, ignore -g 2294 splice(@$argv_local, $i, 1); # remove the current index from @$argv_local 2295 redo(RUNOPTS); # since there's now a new value at $i, redo this iteration of the loop 2296 } 2297 else { 2298 # if we haven't seen --data yet, change -g into `--data -` 2299 splice(@$argv_local, $i, 1, '--data', '-'); 2300 } 2301 } 2302 2303 if ($argv_local->[$i] =~ /^-?-h(?:eader)?-([^:]+):?$/) { 2304 # rewrite '--header-Foo bar' into '--header "Foo: bar"' 2305 $argv_local->[$i] = "--header"; 2306 $argv_local->[$i+1] = $1 . ': ' . $argv_local->[$i+1]; 2307 } 2308 elsif ($argv_local->[$i] =~ /^-?-no-h(?:eader)?-/) { 2309 # rewrite '--no-header-Foo' into '--no-header' 2310 $argv_local->[$i] = "--no-header"; 2311 } 2312 } 2313 2314 # build the actual hash we will pass to GetOptions from our config list ($l): 2315 # In the end I decided to build this at each call of this sub so that $r 2316 # is defined. It's not much of a performance issue. 2317 my %options = (); 2318 foreach my $e (@$l) { 2319 my $k = join('|', @{$e->{opts}}) . $e->{suffix}; 2320 my $nk = join('|', map { "no-$_" } (@{$e->{opts}})); 2321 my $eval; 2322 if ($e->{type} eq 'scalar' || $e->{type} eq 'list') { 2323 $eval = "\$options{\$k} = sub { store_option(\$e, \$r, 0, \@_); };" 2324 . "\$options{\$nk} = sub { store_option(\$e, \$r, 1, \@_); };"; 2325 } 2326 else { 2327 ptrans(12, "Unknown option type '$e->{type}' (this is a swaks bug)"); 2328 exit(1); 2329 } 2330 eval($eval); 2331 if ($@) { 2332 chomp($@); 2333 ptrans(12, "Unable to load callback for $k option processing: $@"); 2334 exit(1); 2335 } 2336 } 2337 2338 if (!load("Getopt::Long")) { 2339 ptrans(12, "Unable to load Getopt::Long for option processing, Exiting"); 2340 exit(1); 2341 } 2342 2343 Getopt::Long::Configure("no_ignore_case"); 2344 Getopt::Long::GetOptionsFromArray($argv_local, %options) || exit(1); 2345} 2346 2347sub store_option { 2348 my $cfg_struct = shift; # this is the option definition structure 2349 my $opt_struct = shift; # this is where we will be saving the option for later retrieval 2350 my $remove = shift; # if true, we received a "no-" version of the option, remove all previous instances 2351 my $opt_name = shift; # --xclient-name || --dump-mail || -f 2352 my $opt_value = shift; # NAME || undef || foo@example.com 2353 my $accum_key = $cfg_struct->{akey}; # xclient_attrs || dump_mail || mail_from 2354 my $opt_key = $cfg_struct->{okey}; # xclient_name || dump_mail || mail_from 2355 my $type = $cfg_struct->{type}; # scalar or list 2356 2357 # print "store_options called -> $cfg_struct, $opt_struct, $opt_name, $opt_value, $accum_key, $opt_key, $type\n"; 2358 2359 if ($cfg_struct->{cfgs} & OP_DEPRECATED) { 2360 deprecate("Option --$opt_name will be removed in the future. Please see documentation for more information."); 2361 } 2362 2363 # 'accum' stores lists of the order they were received in 2364 $opt_struct->{accums}{$accum_key} ||= []; 2365 # 'values' stores the actual values and the name of the option that was used to pass it 2366 $opt_struct->{values}{$opt_key} ||= []; 2367 2368 # if we're recording a scalar or were asked to remove, reset the values list to throw away any previous values 2369 # and remove any previous recordings of this okey from the accumulator list 2370 if ($type eq 'scalar' || $remove) { 2371 $opt_struct->{values}{$opt_key} = []; 2372 $opt_struct->{accums}{$accum_key} = [ grep { $_ ne $opt_key } (@{$opt_struct->{accums}{$accum_key}}) ]; 2373 } 2374 2375 # if we were asked to remove (which means called with a "--no-" prefix), get out now, there's nothing to record 2376 return if ($remove); 2377 2378 push(@{$opt_struct->{accums}{$accum_key}}, $opt_key); 2379 2380 my $arg = $opt_value; 2381 if ($cfg_struct->{callout}) { 2382 $arg = $cfg_struct->{callout}("$opt_name", $arg); 2383 } 2384 2385 push(@{$opt_struct->{values}{$opt_key}}, { 2386 okey => $opt_key, 2387 akey => $accum_key, 2388 opt => "$opt_name", 2389 arg => $arg, 2390 }); 2391} 2392 2393# take a string and quote it such that it could be used in the shell 2394# O'Reilley -> 'O'\''Reilley' 2395sub shquote { my $s = shift; $s =~ s%'%'\\''%g; return "'$s'"; } 2396 2397sub reconstruct_options { 2398 my $o = shift; # ref to raw option hash (as returned by load_args) 2399 my @c = (); # array to hold our reconstructed command line 2400 my %already_seen = (); # for okeys like xclient_attrs, they only need to be processed once 2401 my %indexer = (); 2402 2403 foreach my $opt (@G::raw_option_data) { 2404 next if ($already_seen{$opt->{akey}}); 2405 next if (!exists($o->{accums}{$opt->{akey}})); 2406 2407 foreach my $okey (@{$o->{accums}{$opt->{akey}}}) { 2408 $indexer{$okey} ||= 0; 2409 my $optStruct = $o->{values}{$okey}[$indexer{$okey}]; 2410 my $lopt = $o->{cfgs}{$okey}{opts}[0]; 2411 2412 push(@c, '--'.$lopt); 2413 if (length($optStruct->{arg}) && !($o->{cfgs}{$okey}{cfgs} & OP_ARG_NONE)) { 2414 if ($okey eq 'auth_pass') { 2415 push(@c, shquote('%RAW_PASSWORD_STRING%')); 2416 } 2417 else { 2418 push(@c, shquote($optStruct->{arg})); 2419 } 2420 } 2421 } 2422 $already_seen{$opt->{akey}} = 1; 2423 } 2424 2425 #print join(', ', @c), "\n"; 2426 return join(' ', @c); 2427} 2428 2429sub get_accum { 2430 my $accum_key = shift; 2431 my $userOpts = shift; 2432 2433 if (!exists($userOpts->{accums}{$accum_key})) { 2434 return([]); 2435 } 2436 2437 return($userOpts->{accums}{$accum_key}); 2438} 2439 2440# I might change this interface later, but I want a way to check whether the user provided the option 2441# without actually processing it. 2442sub check_arg { 2443 my $opt = shift; 2444 my $userOpts = shift; 2445 2446 if (exists($userOpts->{values}{$opt}) && scalar(@{$userOpts->{values}{$opt}})) { 2447 return(1); 2448 } 2449 2450 return(0); 2451} 2452 2453# get the next value for $opt without doing any processing or popping it off of the list. 2454sub peek_arg { 2455 my $opt = shift; # this should correspond to an okey from the @G::raw_option_data array 2456 my $userOpts = shift; # all options we got from the command line 2457 2458 if (!exists($userOpts->{values}{$opt})) { 2459 return(undef()); 2460 } 2461 2462 if (!scalar(@{$userOpts->{values}{$opt}})) { 2463 return(undef()); 2464 } 2465 2466 return($userOpts->{values}{$opt}[0]{arg}); 2467} 2468 2469# there was a ton of repeated, boiler plate code in process_args. Attempt to abstract it out to get_arg 2470sub get_arg { 2471 my $opt = shift; # this should correspond to an okey from the @G::raw_option_data array 2472 my $userOpts = shift; # all options we got from the command line 2473 my $optConfig = shift; 2474 my $force = shift; 2475 my $arg; 2476 my $argExt; 2477 my $return; 2478 2479 # print "in get_arg, opt = $opt\n"; 2480 2481 # If the user didn't pass in a specific option config, look it up from the global option config 2482 if (!$optConfig) { 2483 if (!exists($userOpts->{cfgs}{$opt})) { 2484 ptrans(12, "Internal option processing error: asked to evaluate non-existent option $opt"); 2485 exit(1); 2486 } 2487 $optConfig = $userOpts->{cfgs}{$opt}; 2488 } 2489 2490 # $arg will be the value actually provided on the command line 2491 # !defined = not provided 2492 # defined && !length = option provided but no argument provided 2493 # defined && length = option provided and argument provided 2494 if (!exists($userOpts->{values}{$opt})) { 2495 # if the caller passed in $force, we act as if the option is present with an empty arg 2496 # this is used when we need to use get_arg features like interact() even when the user 2497 # didn't specify the option (specifically, --auth forces --auth-password to need to be 2498 # processed, even if the user didn't pass it in) 2499 $arg = $force ? '' : undef(); 2500 } 2501 else { 2502 $argExt = shift(@{$userOpts->{values}{$opt}}); 2503 $arg = $argExt->{arg}; 2504 } 2505 2506 # this option takes no arguments - it's a straight boolean 2507 if ($optConfig->{cfgs} & OP_ARG_NONE) { 2508 if ($arg) { 2509 $return = 1; 2510 } 2511 else { 2512 $return = 0; 2513 } 2514 } 2515 2516 # if the option is present, it must have an argument. 2517 # theoretically I should have code here actually requiring the argument, 2518 # but at the moment that's being handled by Getopt::Long 2519 elsif ($optConfig->{cfgs} & OP_ARG_REQ) { 2520 if (!defined($arg)) { 2521 # the opt wasn't specified at all. Perfectly legal, return undef 2522 $return = undef; 2523 } 2524 else { 2525 # if there was an arg provided, just return it 2526 if (length($arg)) { 2527 $return = $arg; 2528 } 2529 # No arg, but we were requested to prompt the user - do so 2530 elsif ($optConfig->{cfgs} & OP_FROM_PROMPT) { 2531 if (!exists($optConfig->{prompt})) { 2532 ptrans(12, "Internal option processing error: option $argExt->{opt} missing required prompt key (this is a swaks bug)"); 2533 exit(1); 2534 } 2535 if (!exists($optConfig->{match})) { 2536 ptrans(12, "Internal option processing error: option $argExt->{opt} missing required match key (this is a swaks bug)"); 2537 exit(1); 2538 } 2539 $return = interact($optConfig->{prompt}, $optConfig->{match}, $optConfig->{cfgs} & OP_SENSITIVE); 2540 } 2541 # No arg, no request to prompt - this is an error since we're requiring an arg 2542 else { 2543 ptrans(12, "Option processing error: option $argExt->{opt} specified with no argument"); 2544 exit(1); 2545 } 2546 2547 # OP_FROM_FILE means that the above options might have resolved into '-' or @filename. If so, return the actual 2548 # data contained in STDIN/@filename 2549 if ($optConfig->{cfgs} & OP_FROM_FILE) { 2550 if ($return eq '-') { 2551 if (defined($G::stdin)) { 2552 # multiple options can specify stdin, but we can only read it once. If anyone has 2553 # already read stdin, provide the saved value here 2554 $return = $G::stdin; 2555 } 2556 else { 2557 $return = join('', <STDIN>); 2558 $G::stdin = $return; 2559 } 2560 } 2561 elsif ($return =~ /^\@\@/) { 2562 # if the argument starts with \@\@, we take that to mean that the user wants a literal value that starts 2563 # with an @. The first @ is just an indicator, so strip it off before continuing 2564 $return =~ s/^\@//; 2565 } 2566 elsif ($return =~ /^\@/) { 2567 # a single @ means it's a filename. Open it and use the contents as the return value 2568 $return =~ s/^\@//; 2569 if (!open(F, "<$return")) { 2570 ptrans(12, "Option processing error: file $return not openable for option $argExt->{opt} ($!)"); 2571 exit(1); 2572 } 2573 $return = join('', <F>); 2574 close(F); 2575 } 2576 2577 { 2578 # All of the functionality in this bare block is deprecated, remove the whole thing later. 2579 # if --data and single line, try to open it, error otherwise 2580 # if !--data and is openable file, try to open and read, otherwise just use it as literal data 2581 if ($argExt->{opt} eq 'data') { 2582 # the old rule for --data was that anything that didn't have a newline in it would be treated 2583 # as a file, and we would error if we couldn't open it. That would prevent us from sending 2584 # typoed filenames as the data of messages 2585 if ($return !~ m/\\n|\n|%NEWLINE%/) { 2586 deprecate('Inferring a filename from the argument to --' . $argExt->{opt} . 2587 ' will be removed in the future. Prefix filenames with \'@\' instead.'); 2588 if (!open(F, "<$return")) { 2589 ptrans(12, "$argExt->{opt} option appears to be a file but is not openable: $return ($!)"); 2590 exit(1); 2591 } 2592 $return = join('', <F>); 2593 close(F); 2594 } 2595 } 2596 elsif (open(F, "<$return")) { 2597 # the old rule for any other file option (--attach, --attach-body, --body) was that 2598 # if it was openable, we would use the contents of the file, otherwise we would 2599 # use the string itself 2600 deprecate('Inferring a filename from the argument to --' . $argExt->{opt} . 2601 ' will be removed in the future. Prefix filenames with \'@\' instead.'); 2602 $return = join('', <F>); 2603 close(F); 2604 } 2605 } 2606 } 2607 } 2608 } 2609 2610 # The option can be present with or without an argument 2611 # any "true" return value will be an actual provided option 2612 # false and defined = option given but no argument given 2613 # false and undefined = option not specified 2614 elsif ($optConfig->{cfgs} & OP_ARG_OPT) { 2615 if (!defined($arg)) { 2616 # the opt wasn't specified at all. Perfectly legal, return undef 2617 $return = undef; 2618 } 2619 else { 2620 # we have an opt and an arg, return the arg 2621 $return = $arg; 2622 } 2623 } 2624 2625 # if we read the last arg off an array, put it back on the array for future reads. I can't 2626 # decide if this is the right behavior or not, but this makes it more like scalars, which 2627 # can (and in a couple of cases, must) be read multiple times. 2628 if (defined($arg) && ref($userOpts->{values}{$opt}) && !scalar(@{$userOpts->{values}{$opt}})) { 2629 push(@{$userOpts->{values}{$opt}}, $argExt); 2630 } 2631 2632 # print "returning "; 2633 # if (defined($return)) { 2634 # print length($return) ? "$return\n" : "defined but empty\n"; 2635 # } 2636 # else { 2637 # print "undefined\n"; 2638 # } 2639 return($return); 2640} 2641 2642# A couple of global options are set in here, they will be in the G:: namespace 2643sub process_args { 2644 my $o = shift; # This is the args we got from command line 2645 my %n = (); # This is the hash we will return w/ the fixed-up args 2646 my $a = get_option_struct(); # defining information for all options 2647 2648 # handle the output file handles early so they can be used for errors 2649 # we don't need to keep track of the actual files but it will make debugging 2650 # easier later 2651 $G::trans_fh_oh = \*STDOUT; 2652 $G::trans_fh_of = "STDOUT"; 2653 $G::trans_fh_eh = \*STDERR; 2654 $G::trans_fh_ef = "STDERR"; 2655 my $output_file = get_arg('output_file', $o); 2656 my $output_file_stderr = get_arg('output_file_stderr', $o) || $output_file; 2657 my $output_file_stdout = get_arg('output_file_stdout', $o) || $output_file; 2658 if ($output_file_stderr) { 2659 if (!open(OUTEFH, '>>'.$output_file_stderr)) { 2660 ptrans(12, 'Unable to open ' . $output_file_stderr . ' for writing'); 2661 exit(1); 2662 } 2663 $G::trans_fh_eh = \*OUTEFH; 2664 $G::trans_fh_ef = $output_file_stderr; 2665 } 2666 if ($output_file_stdout && $output_file_stdout eq $output_file_stderr) { 2667 $G::trans_fh_oh = $G::trans_fh_eh; 2668 $G::trans_fh_of = $G::trans_fh_ef; 2669 } 2670 elsif ($output_file_stdout) { 2671 if (!open(OUTOFH, '>>'.$output_file_stdout)) { 2672 ptrans(12, 'Unable to open ' . $output_file_stdout . ' for writing'); 2673 exit(1); 2674 } 2675 $G::trans_fh_oh = \*OUTOFH; 2676 $G::trans_fh_of = $output_file_stdout; 2677 } 2678 2679 if (get_arg('no_hints', $o)) { 2680 $G::no_hints_send = 1; 2681 $G::no_hints_recv = 1; 2682 } 2683 else { 2684 $G::no_hints_send = get_arg('no_hints_send', $o); 2685 $G::no_hints_recv = get_arg('no_hints_recv', $o); 2686 } 2687 $G::dump_mail = get_arg('dump_mail', $o); 2688 $G::suppress_data = get_arg('suppress_data', $o); 2689 $G::no_hints_info = get_arg('no_hints_info', $o); 2690 $G::hide_send = get_arg('hide_send', $o); 2691 $G::hide_receive = get_arg('hide_receive', $o); 2692 $G::hide_informational = get_arg('hide_informational', $o); 2693 $G::hide_all = get_arg('hide_all', $o); 2694 $G::show_raw_text = get_arg('show_raw_text', $o); 2695 $G::protect_prompt = get_arg('protect_prompt', $o); 2696 $G::pipeline = get_arg('pipeline', $o); 2697 $G::prdr = get_arg('prdr', $o); 2698 $G::silent = get_arg('silent', $o) || 0; 2699 2700 if (defined(my $dump_args = get_arg('dump_args', $o))) { 2701 map { $G::dump_args{uc($_)} = 1; } (split('\s*,\s*', $dump_args)); # map comma-delim options into a hash 2702 $G::dump_args{'ALL'} = 1 if (!scalar(keys(%G::dump_args))); # if no options were given, just set ALL 2703 } 2704 2705 my $mail_server_t = get_arg('mail_server', $o); 2706 my $socket_t = get_arg('socket', $o); 2707 my $pipe_cmd_t = get_arg('pipe_cmd', $o); 2708 2709 # it is an error if >1 of --server, --socket, or --pipe is specified 2710 if ((defined($mail_server_t) && defined($socket_t)) || 2711 (defined($mail_server_t) && defined($pipe_cmd_t)) || 2712 (defined($pipe_cmd_t) && defined($socket_t))) 2713 { 2714 ptrans(12, "Multiple transport types specified, exiting"); 2715 exit(1); 2716 } 2717 2718 my %protos = ( 2719 smtp => { proto => 'smtp', auth => 0, tls => '0' }, 2720 ssmtp => { proto => 'esmtp', auth => 0, tls => 'c' }, 2721 ssmtpa => { proto => 'esmtp', auth => 1, tls => 'c' }, 2722 smtps => { proto => 'smtp', auth => 0, tls => 'c' }, 2723 esmtp => { proto => 'esmtp', auth => 0, tls => '0' }, 2724 esmtpa => { proto => 'esmtp', auth => 1, tls => '0' }, 2725 esmtps => { proto => 'esmtp', auth => 0, tls => 's' }, 2726 esmtpsa => { proto => 'esmtp', auth => 1, tls => 's' }, 2727 lmtp => { proto => 'lmtp', auth => 0, tls => '0' }, 2728 lmtpa => { proto => 'lmtp', auth => 1, tls => '0' }, 2729 lmtps => { proto => 'lmtp', auth => 0, tls => 's' }, 2730 lmtpsa => { proto => 'lmtp', auth => 1, tls => 's' }, 2731 ); 2732 $G::protocol = lc(get_arg('mail_protocol', $o)) || 'esmtp'; 2733 my $tls = get_arg('tls', $o); 2734 my $tls_optional = get_arg('tls_optional', $o); 2735 my $tls_optional_strict = get_arg('tls_optional_strict', $o); 2736 my $tls_on_connect = get_arg('tls_on_connect', $o); 2737 if (!$protos{$G::protocol}) { 2738 ptrans(12, "Unknown protocol $G::protocol specified, exiting"); 2739 exit(1); 2740 } 2741 my $auth_user_t = get_arg('auth_user', $o); 2742 my $auth_pass_t = get_arg('auth_pass', $o); 2743 my $auth_optional_t = get_arg('auth_optional', $o); 2744 my $auth_optional_strict_t = get_arg('auth_optional_strict', $o); 2745 my $auth_t = get_arg('auth', $o); 2746 if ($protos{$G::protocol}{auth} && !$auth_user_t && !$auth_pass_t && !$auth_optional_t && !$auth_optional_strict_t && !$auth_t) { 2747 $auth_t = ''; # cause auth to be processed below 2748 } 2749 if ($protos{$G::protocol}{tls} && !$tls && !$tls_optional && !$tls_optional_strict && !$tls_on_connect){ 2750 # 'touch' the variable so we process it below 2751 if ($protos{$G::protocol}{tls} eq 's') { 2752 $tls = 1; 2753 } elsif ($protos{$G::protocol}{tls} eq 'c') { 2754 $tls_on_connect = 1; 2755 } 2756 } 2757 $G::protocol = $protos{$G::protocol}{proto}; 2758 2759 # set global options for --quit-after, --drop-after, and --drop-after-send 2760 foreach my $opt ('quit_after', 'drop_after', 'drop_after_send') { 2761 no strict "refs"; 2762 if (my $value = get_arg($opt, $o)) { 2763 ${"G::$opt"} = lc($value); 2764 if (${"G::$opt"} =~ /^[el]hlo$/) { ${"G::$opt"} = 'helo'; } 2765 elsif (${"G::$opt"} =~ /first-[el]hlo/) { ${"G::$opt"} = 'first-helo'; } 2766 elsif (${"G::$opt"} eq 'starttls') { ${"G::$opt"} = 'tls'; } 2767 elsif (${"G::$opt"} eq 'banner') { ${"G::$opt"} = 'connect'; } 2768 elsif (${"G::$opt"} eq 'from') { ${"G::$opt"} = 'mail'; } 2769 elsif (${"G::$opt"} eq 'to') { ${"G::$opt"} = 'rcpt'; } 2770 elsif (${"G::$opt"} ne 'connect' && ${"G::$opt"} ne 'first-helo' && 2771 ${"G::$opt"} ne 'tls' && ${"G::$opt"} ne 'helo' && 2772 ${"G::$opt"} ne 'auth' && ${"G::$opt"} ne 'mail' && 2773 ${"G::$opt"} ne 'rcpt' && ${"G::$opt"} ne 'xclient' && 2774 ${"G::$opt"} ne 'data' && ${"G::$opt"} ne 'dot') 2775 { 2776 ptrans(12, "Unknown $opt value " . ${"G::$opt"} . ", exiting"); 2777 exit(1); 2778 } 2779 # only rcpt, data, and dot _require_ a to address 2780 $G::server_only = 1 if (${"G::$opt"} !~ /^(rcpt|data|dot)$/); 2781 2782 # data and dot aren't legal for quit_after 2783 if ($opt eq 'quit_after' && (${"G::$opt"} eq 'data' || ${"G::$opt"} eq 'dot')) { 2784 ptrans(12, "Unknown $opt value " . ${"G::$opt"} . ", exiting"); 2785 exit(1); 2786 } 2787 } else { 2788 ${"G::$opt"} = ''; 2789 } 2790 } 2791 2792 # set global flag for -stl flag 2793 $G::show_time_lapse = get_arg('show_time_lapse', $o); 2794 if (defined($G::show_time_lapse)) { 2795 if (length($G::show_time_lapse) && $G::show_time_lapse !~ /^i/i) { 2796 ptrans(12, "Unknown argument '$G::show_time_lapse' to option show-time-lapse, exiting"); 2797 exit(1); 2798 } 2799 if (avail("hires_timing") && $G::show_time_lapse !~ /^i/i) { 2800 $G::show_time_lapse = 'hires'; 2801 } 2802 else { 2803 $G::show_time_lapse = 'integer'; 2804 } 2805 } 2806 2807 # pipe command, if one is specified 2808 if ($pipe_cmd_t) { 2809 $G::link{process} = $pipe_cmd_t; 2810 $G::link{type} = 'pipe'; 2811 } 2812 2813 # socket file, if one is specified 2814 if ($socket_t) { 2815 $G::link{sockfile} = $socket_t; 2816 $G::link{type} = 'socket-unix'; 2817 } 2818 2819 $n{force_getpwuid} = get_arg('force_getpwuid', $o); # make available for --dump 2820 my $user = get_username($n{force_getpwuid}); 2821 my $hostname = get_hostname(); 2822 2823 # SMTP mail from 2824 if (!($n{from} = get_arg('mail_from', $o))) { 2825 if ($hostname || ($G::server_only && $G::quit_after ne 'mail' && $G::drop_after ne 'mail' && $G::drop_after_send ne 'mail')) { 2826 # if we have a hostname, or it doesn't matter anyway because we won't actually need it, use our manufactured from 2827 $n{from} = "$user\@$hostname"; 2828 } 2829 else { 2830 ptrans(12, "From string required but couldn't be determined automatically. Please use --from"); 2831 exit(1); 2832 } 2833 } 2834 $n{from} = '' if ($n{from} eq '<>'); 2835 2836 # local interface and port 2837 ($G::link{lint},$G::link{lport}) = parse_server(get_arg('lint', $o), get_arg('lport', $o)); 2838 if ($G::link{lport} && $G::link{lport} !~ /^\d+$/) { 2839 if (my $port = getservbyname($G::link{lport}, 'tcp')) { 2840 $G::link{lport} = $port; 2841 } 2842 else { 2843 ptrans(12, "unable to resolve service name $G::link{lport} into a port, exiting"); 2844 exit(1); 2845 } 2846 } 2847 2848 # SMTP helo/ehlo 2849 if (!($n{helo} = get_arg('mail_helo', $o))) { 2850 if ($hostname || ($G::quit_after eq 'connect' || $G::drop_after eq 'connect' || $G::drop_after_send eq 'connect')) { 2851 # if we have a hostname, or it doesn't matter anyway because we won't actually need it, use our manufactured from 2852 $n{helo} = $hostname; 2853 } 2854 else { 2855 ptrans(12, "Helo string required but couldn't be determined automatically. Please use --helo"); 2856 exit(1); 2857 } 2858 } 2859 2860 # SMTP server, port and rcpt-to are interdependant, so they are handled together 2861 $G::link{type} ||= 'socket-inet'; 2862 ($G::link{server},$G::link{port}) = parse_server($mail_server_t, get_arg('mail_port', $o)); 2863 $n{to} = get_arg('mail_to', $o); 2864 # we absolutely must have a recipient. If we don't have one yet, prompt for one 2865 if (!$n{to} && !($G::server_only && ($G::link{server} || $G::link{type} eq 'socket-unix' || $G::link{type} eq 'pipe'))) { 2866 $n{to} = interact("To: ", '^.+$'); # WCSXXXFIXME I wish we could look up the prompt and re from $a 2867 } 2868 2869 # try to catch obvious -s/-li/-4/-6 errors as soon as possible. We don't actually do any DNS 2870 # lookups ourselves, so errors like -s being a domain with only A RRs and -li being a domain 2871 # with only AAAA RRs, or -s being an ipv6 and -li being a domain with only A RRs, will 2872 # get passed into the IO::Socket module to deal with and will just registed as a connection 2873 # failure. 2874 if ($G::link{type} eq 'socket-inet') { 2875 my $forceIPv4 = get_arg('force_ipv4', $o); 2876 my $forceIPv6 = get_arg('force_ipv6', $o); 2877 if ($forceIPv4 && $forceIPv6) { 2878 ptrans(12, "Options -4 and -6 are mutually exclusive, cannot proceed"); 2879 exit 1; 2880 } elsif ($forceIPv6) { 2881 $G::link{force_ipv6} = 1; 2882 } elsif ($forceIPv4) { 2883 $G::link{force_ipv4} = 1; 2884 } 2885 2886 if ($n{copy_routing} = get_arg('copy_routing', $o)) { 2887 $G::link{server} ||= get_server($n{copy_routing}); 2888 } 2889 else { 2890 $G::link{server} ||= get_server($n{to}); 2891 } 2892 2893 if ($forceIPv4 && $G::link{server} =~ m|:|) { 2894 ptrans(12, "Option -4 is set but server appears to be ipv6, cannot proceed"); 2895 exit 1; 2896 } elsif ($forceIPv4 && $G::link{lint} =~ m|:|) { 2897 ptrans(12, "Option -4 is set but local-interface appears to be ipv6, cannot proceed"); 2898 exit 1; 2899 } elsif ($forceIPv6 && $G::link{server} =~ m|^\d+\.\d+\.\d+\.\d+$|) { 2900 ptrans(12, "Option -6 is set but server appears to be ipv4, cannot proceed"); 2901 exit 1; 2902 } elsif ($forceIPv6 && $G::link{lint} =~ m|^\d+\.\d+\.\d+\.\d+$|) { 2903 ptrans(12, "Option -6 is set but local-interface appears to be ipv4, cannot proceed"); 2904 exit 1; 2905 } elsif ($G::link{server} =~ m|:| && $G::link{lint} =~ m|^\d+\.\d+\.\d+\.\d+$|) { 2906 ptrans(12, "server is ipv6 but local-interface is ipv4, cannot proceed"); 2907 exit 1; 2908 } elsif ($G::link{server} =~ m|^\d+\.\d+\.\d+\.\d+$| && $G::link{lint} =~ m|:|) { 2909 ptrans(12, "server is ipv4 but local-interface is ipv6, cannot proceed"); 2910 exit 1; 2911 } 2912 } 2913 2914 # Verify we are able to handle the requested transport 2915 if ($G::link{type} eq 'pipe') { 2916 if (!avail("pipe")) { 2917 ptrans(12, avail_str("pipe").". Exiting"); 2918 exit(10); 2919 } 2920 } else { 2921 if (!avail("socket")) { 2922 ptrans(12, avail_str("socket").". Exiting"); 2923 exit(10); 2924 } elsif (($G::link{force_ipv6} || $G::link{server} =~ m|:| || $G::link{lint} =~ m|:|) && !avail("ipv6")) { 2925 ptrans(12, avail_str("ipv6").". Exiting"); 2926 exit(10); 2927 } 2928 } 2929 2930 # SMTP timeout 2931 $G::link{timeout} = time_to_seconds(get_arg('timeout', $o) // '30s'); 2932 2933 my $dab_sp = get_arg('dab_sp', $o); 2934 my $dump_as_body = get_arg('dump_as_body', $o); 2935 $dump_as_body = '' if ($dab_sp && !defined($dump_as_body)); 2936 my $body = 'This is a test mailing'; # default message body 2937 $body = 'DUMP_AS_BODY_HAS_BEEN_SET' if (defined($dump_as_body)); 2938 my $bound = ''; 2939 my $main_content_type = 'multipart/mixed'; 2940 my $stdin = undef; 2941 if (defined(my $body_822_t = get_arg('body_822', $o))) { 2942 # the --body option is the entire 822 body and trumps any other options 2943 # that mess with the body 2944 $body = $body_822_t; 2945 } 2946 my $attach_accum = get_accum('attach_accum', $o); 2947 if (scalar(@$attach_accum)) { 2948 # this option is a list of files (or STDIN) to attach. In this case, 2949 # the message become a mime message and the "body" goes in the 2950 # first text/plain part 2951 my $mime_type = '%SWAKS_DEFAULT_MIMETYTPE%'; 2952 my $next_name = undef(); 2953 my %parts = ( body => [], rest => [] ); 2954 $bound = "----=_MIME_BOUNDARY_000_$$"; 2955 foreach my $part (@$attach_accum) { 2956 if ($part eq 'attach_type') { 2957 $mime_type = get_arg($part, $o); 2958 } 2959 elsif ($part eq 'attach_name') { 2960 $next_name = get_arg($part, $o); 2961 } 2962 elsif ($part eq 'attach_body') { 2963 if ($mime_type eq '%SWAKS_DEFAULT_MIMETYTPE%') { 2964 $mime_type = 'text/plain'; 2965 } 2966 push(@{$parts{body}}, { body => get_arg($part, $o), type => $mime_type }); 2967 $next_name = undef(); # can't set filename for body, unset next_name so random attachment doesn't get it 2968 $mime_type = '%SWAKS_DEFAULT_MIMETYTPE%'; # after each body, reset the default mime type 2969 } 2970 elsif ($part eq 'attach_attach') { 2971 my $name = peek_arg($part, $o); 2972 my $tpart = { body => get_arg($part, $o), type => $mime_type }; 2973 if (defined($next_name)) { 2974 $tpart->{name} = $next_name; 2975 $next_name = undef(); 2976 } 2977 else { 2978 my $filename = $name; 2979 $filename =~ s/^\@//; 2980 if ($name ne '-' && $filename !~ /^\@/ && $name ne $tpart->{body} && -f $filename) { 2981 # name will have the unprocessed arg. If we think it came from a file, use the filename for 2982 # the attachment name. Not super happy with this logic, try to improve in the future 2983 ($tpart->{name}) = $name =~ m|/?([^/]+)$|; 2984 } 2985 } 2986 push(@{$parts{rest}}, $tpart); 2987 } else { 2988 ptrans(12, "Error processing attach args, unknown type $part when processing attachment options"); 2989 exit(1); 2990 } 2991 } 2992 2993 # if no body parts were set via --attach-body, set a text/plain body to $body 2994 if (!scalar(@{$parts{body}})) { 2995 push(@{$parts{body}}, { body => $body, type => 'text/plain' }); 2996 } 2997 2998 $body = ''; 2999 if (!scalar(@{$parts{rest}})) { 3000 # if there are no non-body parts 3001 if (scalar(@{$parts{body}}) > 1) { 3002 $main_content_type = 'multipart/alternative'; 3003 } 3004 else { 3005 $main_content_type = 'multipart/mixed'; 3006 } 3007 3008 foreach my $part (@{$parts{body}}) { 3009 $body .= encode_mime_part($part, $bound, 1); 3010 } 3011 } 3012 else { 3013 # otherwise, there's a mixture of both body and other. multipart/mixed 3014 $main_content_type = 'multipart/mixed'; 3015 if (scalar(@{$parts{body}}) > 1) { 3016 # we have multiple body parts, plus other attachments. Need to create a mp/mixes mime object for the bodies 3017 my $mp_bound = "----=_MIME_BOUNDARY_004_$$"; 3018 3019 $body .= "--$bound\n" 3020 . 'Content-Type: multipart/alternative; boundary="' . $mp_bound . '"' . "\n\n"; 3021 3022 foreach my $part (@{$parts{body}}) { 3023 $body .= encode_mime_part($part, $mp_bound, 1); 3024 } 3025 $body .= "--$mp_bound--\n"; 3026 } 3027 else { 3028 $body .= encode_mime_part($parts{body}[0], $bound, 1); 3029 } 3030 3031 # now handle the non-body attachments 3032 foreach my $part (@{$parts{rest}}) { 3033 $body .= encode_mime_part($part, $bound); 3034 } 3035 } 3036 $body .= "--$bound--\n"; 3037 } 3038 $body =~ s|%SWAKS_DEFAULT_MIMETYTPE%|application/octet-stream|g; 3039 3040 # SMTP DATA 3041 $n{data} = get_arg('mail_data', $o) || 3042 'Date: %DATE%\nTo: %TO_ADDRESS%\nFrom: %FROM_ADDRESS%\nSubject: test %DATE%\n' . 3043 "Message-Id: <%MESSAGEID%>\n" . 3044 "X-Mailer: swaks v%SWAKS_VERSION% jetmore.org/john/code/swaks/".'\n' . 3045 ($bound ? 'MIME-Version: 1.0\nContent-Type: ' . $main_content_type . '; boundary="' . $bound. '"\n' : '') . 3046 '%NEW_HEADERS%' . # newline will be added in replacement if it exists 3047 '\n' . 3048 '%BODY%\n'; 3049 if (!get_arg('no_data_fixup', $o)) { 3050 $n{data} =~ s/%BODY%/$body/g; 3051 $n{data} =~ s/\\n/\r\n/g; 3052 my $addHeader_accum = get_accum('add_header', $o); 3053 my $addHeaderOpt = []; 3054 3055 foreach my $okey (@$addHeader_accum) { 3056 push(@$addHeaderOpt, get_arg($okey, $o)); 3057 } 3058 3059 # split the headers off into their own struct temporarily to make it much easier to manipulate them 3060 my $header; 3061 my @headers = (); 3062 my %headers = (); 3063 3064 # cut the headers off of the data 3065 if ($n{data} =~ s/\A(.*?)\r?\n\r?\n//s) { 3066 $header = $1; 3067 } 3068 else { 3069 $header = $n{data}; 3070 $n{data} = ''; 3071 } 3072 3073 # build the header string into an object. Each header is an array, each index is a line (to handle header continuation lines) 3074 foreach my $headerLine (split(/\r?\n/, $header)) { 3075 if ($headerLine =~ /^\s/) { 3076 # continuation line 3077 if (scalar(@headers)) { 3078 push(@{$headers[-1]}, $headerLine); 3079 } 3080 else { 3081 # it's illegal to have a continuation line w/o a previous header, but we're a test tool 3082 push(@headers, [ $headerLine ]); 3083 } 3084 } 3085 elsif ($headerLine =~ /^(\S[^:]+):/) { 3086 # properly formed header 3087 push(@headers, [ $headerLine ]); 3088 $headers{$1} = $headers[-1]; 3089 } 3090 else { 3091 # malformed header - no colon. Allow it anyway, we're a test tool 3092 push(@headers, [ $headerLine ]); 3093 $headers{$headerLine} = $headers[-1]; 3094 } 3095 } 3096 3097 # If the user specified headers and the header exists, replace it. If not, push it onto add_header to be added as new 3098 my $header_accum = get_accum('header', $o); 3099 my $headerOpt = []; 3100 foreach my $okey (@$header_accum) { 3101 push(@$headerOpt, get_arg($okey, $o)); 3102 } 3103 foreach my $headerLine (map { split(/\\n/) } @{$headerOpt}) { 3104 if (my($headerName) = $headerLine =~ /^([^:]+):/) { 3105 if ($headers{$headerName}) { 3106 $headers{$headerName}[0] = $headerLine; 3107 splice(@{$headers{$headerName}}, 1); # remove from index 1 onward, if they existed (possible continuations) 3108 } 3109 else { 3110 push(@{$addHeaderOpt}, $headerLine); 3111 } 3112 } 3113 else { 3114 push(@{$addHeaderOpt}, $headerLine); 3115 } 3116 } 3117 3118 # rebuild the header using our (possibly replaced) headers 3119 my $newHeader = ''; 3120 foreach my $headerObj (@headers) { 3121 foreach my $line (@$headerObj) { 3122 $newHeader .= $line . "\r\n"; 3123 } 3124 } 3125 3126 # if there are new headers, add them as appropriate 3127 if ($newHeader =~ /%NEW_HEADERS%/) { 3128 $n{add_header} = join("\r\n", @{$addHeaderOpt}) . "\r\n" if (@{$addHeaderOpt}); 3129 $newHeader =~ s/%NEW_HEADERS%/$n{add_header}/g; 3130 } elsif (scalar(@{$addHeaderOpt})) { 3131 foreach my $line (@{$addHeaderOpt}) { 3132 $newHeader .= $line . "\r\n"; 3133 } 3134 } 3135 3136 # Now re-assemble our data by adding the headers back on to the front 3137 $n{data} = $newHeader . "\r\n" . $n{data}; 3138 3139 $n{data} =~ s/\\n|%NEWLINE%/\r\n/g; 3140 $n{data} =~ s/%FROM_ADDRESS%/$n{from}/g; 3141 $n{data} =~ s/%TO_ADDRESS%/$n{to}/g; 3142 $n{data} =~ s/%MESSAGEID%/get_messageid()/ge; 3143 $n{data} =~ s/%SWAKS_VERSION%/$p_version/g; 3144 $n{data} =~ s/%DATE%/get_date_string()/ge; 3145 $n{data} =~ s/^From [^\n]*\n// if (!get_arg('no_strip_from', $o)); 3146 $n{data} =~ s/\r?\n\.\r?\n?$//s; # If there was a trailing dot, remove it 3147 $n{data} =~ s/\n\./\n../g; # quote any other leading dots 3148 $n{data} =~ s/([^\r])\n/$1\r\n/gs; 3149 $n{data} =~ s/([^\r])\n/$1\r\n/gs; # this identical call is not a bug, called twice to get consecutive \n correctly 3150 $n{data} .= "\r\n."; # add a trailing dot 3151 } 3152 3153 # Handle TLS options 3154 # tls => 0 - no. STARTTLS must be advertised and must succeed, else error. 3155 # 1 - yes. Success if not advertised, advertised and fails _or_ succeeds. 3156 # 2 - strict. Satisfied if not advertised, or advertised and succeeded. 3157 # However, if it's advertised and fails, it's an error. 3158 $G::tls_optional = 1 if ($tls_optional); 3159 $G::tls_optional = 2 if ($tls_optional_strict); 3160 $G::tls = 1 if ($tls || $G::tls_optional); 3161 $G::tls_on_connect = 1 if ($tls_on_connect); 3162 $G::link{tls}{active} = 0; 3163 if ($G::tls || $G::tls_on_connect) { 3164 if (!avail("tls")) { 3165 if ($G::tls_optional) { 3166 $G::tls = undef; # so we won't try it later 3167 ptrans(12,avail_str("tls")); 3168 } else { 3169 ptrans(12,avail_str("tls").". Exiting"); 3170 exit(10); 3171 } 3172 } 3173 $G::tls_verify = get_arg('tls_verify', $o); 3174 $G::tls_sni_hostname = get_arg('tls_sni_hostname', $o); 3175 $G::tls_cipher = get_arg('tls_cipher', $o); 3176 $G::tls_cert = get_arg('tls_cert', $o); 3177 $G::tls_key = get_arg('tls_key', $o); 3178 if (($G::tls_cert || $G::tls_key) && !($G::tls_cert && $G::tls_key)) { 3179 ptrans(12, "--tls-cert and --tls-key require each other. Exiting"); 3180 exit(1); 3181 } 3182 if (($G::tls_ca_path = get_arg('tls_ca_path', $o)) && !-f $G::tls_ca_path && !-d $G::tls_ca_path) { 3183 ptrans(12, "--tls-ca-path: $G::tls_ca_path is not a valid file or directory. Exiting."); 3184 exit(1); 3185 } 3186 3187 # this is kind of a kludge. There doesn't appear to be a specific openssl call to find supported 3188 # protocols, but the OP_NO_protocol functions exist for supported protocols. Loop through 3189 # "known" protocols (which will unfortunately need to be added-to by hand when new protocols 3190 # become available) to find out which of them are available (when adding new types here, see 3191 # also the code that calls Net::SSLeay::version() and translates to a readable value 3192 @G::tls_supported_protocols = (); 3193 foreach my $p (qw(SSLv2 SSLv3 TLSv1 TLSv1_1 TLSv1_2 TLSv1_3)) { 3194 eval { no strict "refs"; &{"Net::SSLeay::OP_NO_$p"}(); }; 3195 push(@G::tls_supported_protocols, $p) if (!$@); 3196 } 3197 3198 if (my $tls_protocols = get_arg('tls_protocol', $o)) { 3199 @G::tls_protocols = (); 3200 my @requested = split(/,\s*/, $tls_protocols); 3201 if (my $c = scalar(grep(/^no_/i, @requested))) { 3202 if ($c != scalar(@requested)) { 3203 ptrans(12, "cannot mix X and no_X forms in --tls-protocol option"); 3204 exit(1); 3205 } 3206 } 3207 foreach my $p (@requested) { 3208 my $t = $p; 3209 $t =~ s/^no_//i; 3210 if (grep /^$t$/i, @G::tls_supported_protocols) { 3211 push(@G::tls_protocols, $p); 3212 } else { 3213 ptrans(12, "$p in --tls-protocol is not a known/supported protocol"); 3214 } 3215 } 3216 if (!scalar(@G::tls_protocols)) { 3217 ptrans(12, "no valid arguments provided to --tls-protocol, exiting"); 3218 exit(1); 3219 } 3220 } 3221 3222 $G::tls_get_peer_cert = get_arg('tls_get_peer_cert', $o); 3223 $G::tls_get_peer_cert = 'STDOUT' if (defined($G::tls_get_peer_cert) && !length($G::tls_get_peer_cert)); 3224 } 3225 3226 # SMTP port 3227 if ($G::link{port}) { 3228 if ($G::link{port} !~ /^\d+$/) { 3229 if (my $port = getservbyname($G::link{port}, 'tcp')) { 3230 $G::link{port} = $port; 3231 } 3232 else { 3233 ptrans(12, "unable to resolve service name $G::link{port} into a port, exiting"); 3234 exit(1); 3235 } 3236 } 3237 } else { 3238 # in here, user wants us to use default ports, so try look up services, 3239 # use default numbers is service names don't resolve. Never prompt user 3240 if ($G::protocol eq 'lmtp') { 3241 $G::link{port} = getservbyname('lmtp', 'tcp') || '24'; 3242 } elsif ($G::tls_on_connect) { 3243 $G::link{port} = getservbyname('smtps', 'tcp') || '465'; 3244 } else { 3245 $G::link{port} = getservbyname('smtp', 'tcp') || '25'; 3246 } 3247 } 3248 3249 # XCLIENT 3250 { # Create a block for local variables 3251 $G::xclient{try} = 0; 3252 $G::xclient{attr} = {}; 3253 $G::xclient{strings} = []; 3254 my @pieces = (); 3255 my $xclient_accum = get_accum('xclient_accum', $o); 3256 foreach my $attr (@$xclient_accum) { 3257 if ($attr eq 'xclient_delim' || $attr eq 'xclient_raw') { 3258 if (scalar(@pieces)) { 3259 push(@{$G::xclient{strings}}, join(' ', @pieces)); 3260 @pieces = (); 3261 } 3262 3263 if ($attr eq 'xclient_raw') { 3264 push(@{$G::xclient{strings}}, get_arg('xclient_raw', $o)); 3265 } 3266 } else { 3267 if (my $value = get_arg($attr, $o)) { 3268 $attr =~ /^xclient_(.*)$/; 3269 my $name = uc($1); 3270 $G::xclient{attr}{$name} = 1; # used later to verify that we haven't asked for an un-advertised attr 3271 push(@pieces, $name . '=' . to_xtext($value)); 3272 } 3273 } 3274 } 3275 push(@{$G::xclient{strings}}, join(' ', @pieces)) if (scalar(@pieces)); 3276 $G::xclient{no_verify} = get_arg('xclient_no_verify', $o); 3277 $G::xclient{optional} = get_arg('xclient_optional', $o); 3278 $G::xclient{optional} = 2 if (get_arg('xclient_optional_strict', $o)); 3279 #$G::xclient{after} = $o->{"xclient_after"} || interact("XCLIENT quit after: ", '^.+$') 3280 # if (defined($o->{"xclient_after"})); 3281 $G::xclient{try} = 1 if (scalar(@{$G::xclient{strings}})); 3282 $G::xclient{before_tls} = get_arg('xclient_before_starttls', $o); 3283 } 3284 3285 # PROXY 3286 $G::proxy{try} = 0; 3287 $G::proxy{attr} = {}; 3288 $G::proxy{version} = get_arg('proxy_version', $o); 3289 $G::proxy{raw} = get_arg('proxy_raw', $o); 3290 foreach my $attr ('family', 'source', 'source_port', 'dest', 'dest_port', 'protocol', 'command') { 3291 if (my $val = get_arg('proxy_' . $attr, $o)) { 3292 if ($G::proxy{raw}) { 3293 ptrans(12, "Can't mix --proxy option with other --proxy-* options"); 3294 exit(35); 3295 } 3296 $G::proxy{attr}{$attr} = $val; 3297 } 3298 } 3299 if ($G::proxy{version}) { 3300 if ($G::proxy{version} != 1 && $G::proxy{version} != 2) { 3301 ptrans(12, "Invalid argument to --proxy: $G::proxy{version} is not a legal proxy version"); 3302 exit(35); 3303 } 3304 } 3305 else { 3306 $G::proxy{version} = 1; 3307 } 3308 $G::proxy{try} = 1 if ($G::proxy{raw} || scalar(keys(%{$G::proxy{attr}}))); 3309 if ($G::proxy{try} && !$G::proxy{raw}) { 3310 $G::proxy{attr}{protocol} ||= 'STREAM'; 3311 $G::proxy{attr}{command} ||= 'PROXY'; 3312 foreach my $attr ('family', 'source', 'source_port', 'dest', 'dest_port', 'protocol', 'command') { 3313 if (!$G::proxy{attr}{$attr}) { 3314 ptrans(12, "Incomplete set of --proxy-* options (missing $attr)"); 3315 exit(35); 3316 } 3317 $G::proxy{attr}{$attr} = uc($G::proxy{attr}{$attr}); 3318 } 3319 if ($G::proxy{attr}{protocol} !~ /^(UNSPEC|STREAM|DGRAM)$/) { 3320 ptrans(12, 'unknown --proxy-protocol argument ' . $G::proxy{attr}{protocol}); 3321 exit(35); 3322 } 3323 if ($G::proxy{attr}{command} !~ /^(LOCAL|PROXY)$/) { 3324 ptrans(12, 'unknown --proxy-command argument ' . $G::proxy{attr}{command}); 3325 exit(35); 3326 } 3327 if ($G::proxy{version} == 2 && $G::proxy{attr}{family} !~ /^(AF_UNSPEC|AF_INET|AF_INET6|AF_UNIX)$/) { 3328 ptrans(12, 'unknown --proxy-family argument ' . $G::proxy{attr}{family} . ' for version 2'); 3329 exit(35); 3330 } 3331 if ($G::proxy{version} == 1 && $G::proxy{attr}{family} !~ /^(TCP4|TCP6)$/) { 3332 ptrans(12, 'unknown --proxy-family argument ' . $G::proxy{attr}{family} . ' for version 1'); 3333 exit(35); 3334 } 3335 } 3336 3337 # Handle AUTH options 3338 # auth_optional => 0 - no. Auth must be advertised and must succeed, else error. 3339 # 1 - yes. Success if not advertised, advertised and fails _or_ succeeds. 3340 # 2 - strict. Satisfied if not advertised, or advertised and succeeded. 3341 # However, if it's advertised and fails, it's an error. 3342 $G::auth_optional = 1 if (defined($auth_optional_t)); 3343 $G::auth_optional = 2 if (defined($auth_optional_strict_t)); 3344 my $auth_types_t = []; 3345 if ($auth_t) { 3346 @{$auth_types_t} = map { uc($_) } (split(/,/, $auth_t)); 3347 } elsif ($auth_optional_strict_t) { 3348 @{$auth_types_t} = map { uc($_) } (split(/,/, $auth_optional_strict_t)); 3349 } elsif ($auth_optional_t) { 3350 @{$auth_types_t} = map { uc($_) } (split(/,/, $auth_optional_t)); 3351 } elsif (defined($auth_user_t) || defined($auth_pass_t) || $G::auth_optional || (defined($auth_t) && !$auth_t)) { 3352 $auth_types_t->[0] = 'ANY'; 3353 $auth_t = 'ANY'; # this is checked below 3354 $G::auth_type = 'ANY'; 3355 } 3356 # if after that processing we've defined some auth type, do some more 3357 # specific processing 3358 if (scalar(@{$auth_types_t})) { 3359 # there's a lot of option processing below. If any type looks like it 3360 # will succeed later, set this to true 3361 my $valid_auth_found = 0; 3362 3363 # handle the --auth-map options plus our default mappings 3364 foreach (split(/\s*,\s*/, get_arg('auth_map', $o)),"PLAIN=PLAIN","LOGIN=LOGIN", 3365 "CRAM-MD5=CRAM-MD5","DIGEST-MD5=DIGEST-MD5", 3366 "CRAM-SHA1=CRAM-SHA1","NTLM=NTLM","SPA=NTLM","MSN=NTLM") 3367 { 3368 if (/^([^=]+)=(.+)$/) { 3369 my($alias,$type) = ($1,$2); 3370 $G::auth_map_f{$alias} = $type; # this gives us a list of all aliases pointing to types 3371 $G::auth_map_t{$type} ||= []; # this gives a list of all base types and any aliases for it. 3372 push(@{$G::auth_map_t{$type}}, $alias); 3373 } else { 3374 ptrans(12, "Unknown auth-map format '$_'"); 3375 exit(1); 3376 } 3377 } 3378 # Now handle the --auth-extra options 3379 foreach (split(/\s*,\s*/, get_arg('auth_extra', $o))) { 3380 if (/^([^=]+)=(.+)$/) { 3381 $G::auth_extras{uc($1)} = $2; 3382 } else { 3383 ptrans(12, "Unknown auth-extra format '$_'"); 3384 exit(1); 3385 } 3386 } 3387 # handle the realm/domain synonyms 3388 if ($G::auth_extras{DOMAIN}) { 3389 $G::auth_extras{REALM} = $G::auth_extras{DOMAIN}; 3390 } elsif ($G::auth_extras{DOMAIN}) { 3391 $G::auth_extras{DOMAIN} = $G::auth_extras{REALM}; 3392 } 3393 if (!avail("auth")) { # check for general auth requirements 3394 if ($G::auth_optional == 2) { 3395 # we don't know yet if this is really an error. If the server 3396 # doesn't advertise auth, then it's not really an error. So just 3397 # save it in case we need it later 3398 $G::auth_unavailable = avail_str("auth"); 3399 ptrans(12, avail_str("auth")); 3400 } elsif ($G::auth_optional == 1) { 3401 ptrans(12, avail_str("auth"). ". Skipping optional AUTH"); 3402 } else { 3403 ptrans(12, avail_str("auth"). ". Exiting"); 3404 exit(10); 3405 } 3406 } else { 3407 # if the user doesn't specify an auth type, create a list from our 3408 # auth-map data. Simplifies processing later 3409 if ($auth_types_t->[0] eq 'ANY') { 3410 $auth_types_t = [sort keys %G::auth_map_f]; 3411 } 3412 3413 foreach my $type (@{$auth_types_t}) { 3414 # we need to evaluate whether we will be able to run the auth types 3415 # specified by the user 3416 if (!$G::auth_map_f{$type}) { 3417 ptrans(12, "$type is not a recognized auth type, skipping"); 3418 } elsif ($G::auth_map_f{$type} eq 'CRAM-MD5' && !avail("auth_cram_md5")) { 3419 ptrans(12, avail_str("auth_cram_md5")) if ($auth_t ne 'ANY'); 3420 } elsif ($G::auth_map_f{$type} eq 'CRAM-SHA1' && !avail("auth_cram_sha1")) { 3421 ptrans(12, avail_str("auth_cram_sha1")) if ($auth_t ne 'ANY'); 3422 } elsif ($G::auth_map_f{$type} eq 'NTLM' && !avail("auth_ntlm")) { 3423 ptrans(12, avail_str("auth_ntlm")) if ($auth_t ne 'ANY'); 3424 } elsif ($G::auth_map_f{$type} eq 'DIGEST-MD5' && !avail("auth_digest_md5")) { 3425 ptrans(12, avail_str("auth_digest_md5")) if ($auth_t ne 'ANY'); 3426 } else { 3427 $valid_auth_found = 1; 3428 push(@{$n{a_type}}, $type); 3429 } 3430 } 3431 3432 if (!$valid_auth_found) { 3433 ptrans(12, "No auth types supported"); 3434 if ($G::auth_optional == 2) { 3435 $G::auth_unavailable .= "No auth types supported"; 3436 } elsif ($G::auth_optional == 1) { 3437 $n{a_user} = $n{a_pass} = $n{a_type} = undef; 3438 } else { 3439 exit(10); 3440 } 3441 } else { 3442 $auth_user_t ||= obtain_from_netrc('login'); 3443 if (!$auth_user_t) { 3444 my $cfg = { cfgs => OP_ARG_REQ|OP_FROM_PROMPT, prompt => 'Username: ', match => 'SKIP', okey => 'auth_user', akey => 'auth_user' }; 3445 $auth_user_t = get_arg('auth_user', $o, $cfg, 1); 3446 } 3447 $n{a_user} = $auth_user_t eq '<>' ? '' : $auth_user_t; 3448 3449 $auth_pass_t ||= obtain_from_netrc('password', $n{a_user}); 3450 if (!$auth_pass_t) { 3451 my $cfg = { cfgs => OP_ARG_REQ|OP_FROM_PROMPT|OP_SENSITIVE, prompt => 'Password: ', match => 'SKIP', okey => 'auth_pass', akey => 'auth_pass' }; 3452 $auth_pass_t = get_arg('auth_pass', $o, $cfg, 1); 3453 } 3454 $n{a_pass} = $auth_pass_t eq '<>' ? '' : $auth_pass_t; 3455 3456 $G::auth_showpt = get_arg('auth_showpt', $o); 3457 $G::auth_hidepw = get_arg('auth_hidepw', $o); 3458 if (defined($G::auth_hidepw) && !$G::auth_hidepw) { 3459 $G::auth_hidepw = 'PROVIDED_BUT_REMOVED'; 3460 } 3461 } 3462 } # end avail("auth") 3463 } # end auth parsing 3464 3465 # the very last thing we do is swap out the body if --dump-as-body used 3466 if (defined($dump_as_body)) { 3467 if ($dump_as_body) { 3468 $dump_as_body = uc($dump_as_body); 3469 $dump_as_body =~ s/\s//g; 3470 map { $G::dump_as_body{$_} = 1; } (split(',', $dump_as_body)); 3471 } 3472 else { 3473 $G::dump_as_body{'ALL'} = 1; 3474 } 3475 3476 $n{data} =~ s|DUMP_AS_BODY_HAS_BEEN_SET|get_running_state(\%n, \%G::dump_as_body, {SUPPORT => 1, DATA => 1})|e; 3477 if ($dab_sp) { 3478 $n{data} =~ s|'%RAW_PASSWORD_STRING%'|shquote($n{a_pass})|eg; 3479 } elsif ($G::auth_hidepw) { 3480 $n{data} =~ s|'%RAW_PASSWORD_STRING%'|shquote($G::auth_hidepw)|eg; 3481 } else { 3482 $n{data} =~ s|'%RAW_PASSWORD_STRING%'|shquote('PROVIDED_BUT_REMOVED')|eg; 3483 } 3484 } 3485 3486 return(\%n); 3487} 3488 3489sub encode_mime_part { 3490 my $part = shift; 3491 my $boundary = shift; 3492 my $no_attach_text = shift; # if this is true and there's no name, Don't set disposition to attachment 3493 my $text = ''; 3494 3495 $text .= "--$boundary\n"; 3496 if ($part->{type} =~ m|^text/plain$|i && !$part->{name}) { 3497 $text .= "Content-Type: $part->{type}\n\n" . $part->{body} . "\n"; 3498 } 3499 else { 3500 if ($part->{name}) { 3501 $text .= "Content-Type: $part->{type}; name=\"$part->{name}\"\n" 3502 . "Content-Description: $part->{name}\n" 3503 . "Content-Disposition: attachment; filename=\"$part->{name}\"\n"; 3504 } 3505 else { 3506 $text .= "Content-Type: $part->{type}\n"; 3507 if (!($part->{type} =~ m|^text/|i && $no_attach_text)) { 3508 $text .= "Content-Disposition: attachment\n"; 3509 } 3510 } 3511 $text .= "Content-Transfer-Encoding: BASE64\n" 3512 . "\n" . eb64($part->{body}, "\n") . "\n"; 3513 } 3514 3515 3516 return($text); 3517} 3518 3519sub parse_server { 3520 my $server = shift; 3521 my $port = shift; 3522 3523 if ($server =~ m|^\[([^\]]+)\]:(.*)$|) { 3524 # [1.2.3.4]:25 3525 # [hostname]:25 3526 # [1:2::3]:25 3527 return($1, $2); 3528 } elsif ($server =~ m|^([^:]+):([^:]+)$|) { 3529 # 1.2.3.4:25 3530 # hostname:25 3531 return($1, $2); 3532 } elsif ($server =~ m|^\[?([^/\]]*)\]?/(\w+)$|) { 3533 # 1.2.3.4/25 [1.2.3.4]/25 3534 # hostname/25 [hostname]/25 3535 # 1:2::3/25 [1:2::3]/25 3536 return($1, $2); 3537 } elsif ($server =~ m|^\[([^\]]+)\]$|) { 3538 # [1.2.3.4] 3539 # [hostname] 3540 # [1:2::3] 3541 return($1, $port); 3542 } 3543 return($server, $port); 3544} 3545 3546sub get_running_state { 3547 my $opts = shift; 3548 my $dump_args = shift; 3549 my $skip = shift; 3550 my @parts = (); 3551 3552 if (($dump_args->{'SUPPORT'} || $dump_args->{'ALL'}) && !$skip->{'SUPPORT'}) { 3553 push(@parts, test_support(1)); 3554 } 3555 3556 if ($dump_args->{'APP'} || $dump_args->{'ALL'}) { 3557 push(@parts, [ 3558 'App Info:', 3559 " X-Mailer = $p_name v$p_version jetmore.org/john/code/swaks/", 3560 ' Cmd Line = ' . $0 . ' ' . $G::cmdline, 3561 ]); 3562 } 3563 3564 if ($dump_args->{'OUTPUT'} || $dump_args->{'ALL'}) { 3565 push(@parts, [ 3566 'Output Info:', 3567 ' show_time_lapse = ' . ($G::show_time_lapse ? "TRUE ($G::show_time_lapse)" : 'FALSE'), 3568 ' show_raw_text = ' . ($G::show_raw_text ? 'TRUE' : 'FALSE'), 3569 ' suppress_data = ' . ($G::suppress_data ? 'TRUE' : 'FALSE'), 3570 ' protect_prompt = ' . ($G::protect_prompt ? 'TRUE' : 'FALSE'), 3571 ' no_hints_send = ' . ($G::no_hints_send ? 'TRUE' : 'FALSE'), 3572 ' no_hints_recv = ' . ($G::no_hints_recv ? 'TRUE' : 'FALSE'), 3573 ' no_hints_info = ' . ($G::no_hints_info ? 'TRUE' : 'FALSE'), 3574 " silent = $G::silent", 3575 ' dump_mail = ' . ($G::dump_mail ? 'TRUE' : 'FALSE'), 3576 ' hide_send = ' . ($G::hide_send ? 'TRUE' : 'FALSE'), 3577 ' hide_receive = ' . ($G::hide_receive ? 'TRUE' : 'FALSE'), 3578 ' hide_informational = ' . ($G::hide_informational ? 'TRUE' : 'FALSE'), 3579 ' hide_all = ' . ($G::hide_all ? 'TRUE' : 'FALSE'), 3580 " trans_fh_of = $G::trans_fh_of ($G::trans_fh_oh," . \*STDOUT . ')', 3581 " trans_fh_ef = $G::trans_fh_ef ($G::trans_fh_eh," . \*STDERR . ')', 3582 ]); 3583 } 3584 3585 if ($dump_args->{'TRANSPORT'} || $dump_args->{'ALL'}) { 3586 push(@parts, [ 3587 'Transport Info:', 3588 " type = $G::link{type}" 3589 ]); 3590 if ($G::link{type} eq 'socket-inet') { 3591 push(@{$parts[-1]}, 3592 ' inet protocol = ' . ($G::link{force_ipv4} ? '4' : ($G::link{force_ipv6} ? '6' : 'any')), 3593 " server = $G::link{server}", 3594 " port = $G::link{port}", 3595 " local interface = $G::link{lint}", 3596 " local port = $G::link{lport}", 3597 ' copy routing = ' . ($opts->{copy_routing} ? $opts->{copy_routing} : 'FALSE'), 3598 ); 3599 } 3600 elsif ($G::link{type} eq 'socket-unix') { 3601 push(@{$parts[-1]}, " sockfile = $G::link{sockfile}"); 3602 } 3603 elsif ($G::link{type} eq 'pipe') { 3604 push(@{$parts[-1]}, " process = $G::link{process}"); 3605 } 3606 else { 3607 push(@{$parts[-1]}, " UNKNOWN TRANSPORT TYPE"); 3608 } 3609 } 3610 3611 if ($dump_args->{'PROTOCOL'} || $dump_args->{'ALL'}) { 3612 push(@parts, [ 3613 'Protocol Info:', 3614 " protocol = $G::protocol", 3615 " helo = $opts->{helo}", 3616 " from = $opts->{from}", 3617 " to = $opts->{to}", 3618 ' force getpwuid = ' . ($opts->{force_getpwuid} ? 'TRUE' : 'FALSE'), 3619 " quit after = $G::quit_after", 3620 " drop after = $G::drop_after", 3621 " drop after send = $G::drop_after_send", 3622 ' server_only = ' . ($G::server_only ? 'TRUE' : 'FALSE'), 3623 " timeout = $G::link{timeout}", 3624 ' pipeline = ' . ($G::pipeline ? 'TRUE' : 'FALSE'), 3625 ' prdr = ' . ($G::prdr ? 'TRUE' : 'FALSE'), 3626 ]); 3627 } 3628 3629 if ($dump_args->{'XCLIENT'} || $dump_args->{'ALL'}) { 3630 push(@parts, ['XCLIENT Info:']); 3631 if ($G::xclient{try}) { 3632 if ($G::xclient{optional} == 2) { push(@{$parts[-1]}, ' xclient = optional-strict'); } 3633 elsif ($G::xclient{optional} == 1) { push(@{$parts[-1]}, ' xclient = optional'); } 3634 else { push(@{$parts[-1]}, ' xclient = required'); } 3635 push(@{$parts[-1]}, 3636 ' no_verify = ' . ($G::xclient{no_verify} ? 'TRUE' : 'FALSE'), 3637 ' before starttls = ' . ($G::xclient{before_tls} ? 'TRUE' : 'FALSE'), 3638 ); 3639 for (my $i = 0; $i < scalar(@{$G::xclient{strings}}); $i++) { 3640 my $prefix = $i ? ' ' : ' strings ='; 3641 push(@{$parts[-1]}, "$prefix XCLIENT $G::xclient{strings}[$i]"); 3642 } 3643 } else { 3644 push(@{$parts[-1]}, ' xclient = no'); 3645 } 3646 } 3647 3648 if ($dump_args->{'PROXY'} || $dump_args->{'ALL'}) { 3649 push(@parts, ['PROXY Info:']); 3650 if ($G::proxy{try}) { 3651 push(@{$parts[-1]}, ' proxy = yes'); 3652 push(@{$parts[-1]}, " version = $G::proxy{version}"); 3653 if ($G::proxy{raw}) { 3654 push(@{$parts[-1]}, " raw string = $G::proxy{raw}"); 3655 } else { 3656 push(@{$parts[-1]}, 3657 ' family = ' . $G::proxy{attr}{family}, 3658 ' source = ' . $G::proxy{attr}{source}, 3659 ' source port = ' . $G::proxy{attr}{source_port}, 3660 ' dest = ' . $G::proxy{attr}{dest}, 3661 ' dest port = ' . $G::proxy{attr}{dest_port}, 3662 ' protocol = ' . $G::proxy{attr}{protocol}, 3663 ' command = ' . $G::proxy{attr}{command}, 3664 ); 3665 } 3666 } else { 3667 push(@{$parts[-1]}, ' proxy = no'); 3668 } 3669 } 3670 3671 if ($dump_args->{'TLS'} || $dump_args->{'ALL'}) { 3672 push(@parts, ['TLS / Encryption Info:']); 3673 if ($G::tls || $G::tls_on_connect) { 3674 if ($G::tls) { 3675 if ($G::tls_optional == 2) { push(@{$parts[-1]}, ' tls = starttls (optional-strict)'); } 3676 elsif ($G::tls_optional == 1) { push(@{$parts[-1]}, ' tls = starttls (optional)'); } 3677 else { push(@{$parts[-1]}, ' tls = starttls (required)'); } 3678 } 3679 elsif ($G::tls_on_connect) { push(@{$parts[-1]}, ' tls = starttls on connect (required)'); } 3680 push(@{$parts[-1]}, 3681 " peer cert = $G::tls_get_peer_cert", 3682 " local cert = $G::tls_cert", 3683 " local key = $G::tls_key", 3684 " local cipher list = $G::tls_cipher", 3685 " ca path = $G::tls_ca_path", 3686 " sni string = $G::tls_sni_hostname", 3687 ' verify server cert = ' . ($G::tls_verify ? 'TRUE' : 'FALSE'), 3688 ' available protocols = ' . join(', ', @G::tls_supported_protocols), 3689 ' requested protocols = ' . join(', ', @G::tls_protocols), 3690 ); 3691 } 3692 else { 3693 push(@{$parts[-1]}, ' tls = no'); 3694 } 3695 } 3696 3697 if ($dump_args->{'AUTH'} || $dump_args->{'ALL'}) { 3698 push(@parts, ['Authentication Info:']); 3699 if ($opts->{a_type}) { 3700 if ($G::auth_optional == 2) { push(@{$parts[-1]}, ' auth = optional-strict'); } 3701 elsif ($G::auth_optional == 1) { push(@{$parts[-1]}, ' auth = optional'); } 3702 else { push(@{$parts[-1]}, ' auth = required'); } 3703 push(@{$parts[-1]}, 3704 " username = '$opts->{a_user}'", 3705 " password = '%RAW_PASSWORD_STRING%'", 3706 ' show plaintext = ' . ($G::auth_showpt ? 'TRUE' : 'FALSE'), 3707 ' hide password = ' . ($G::auth_hidepw ? $G::auth_hidepw : 'FALSE'), 3708 ' allowed types = ' . join(', ', @{$opts->{a_type}}), 3709 ' extras = ' . join(', ', map { "$_=$G::auth_extras{$_}" } (sort(keys((%G::auth_extras))))), 3710 ' type map = ' . join("\n".' 'x19, map { "$_ = ". join(', ', @{$G::auth_map_t{$_}}) } (sort(keys(%G::auth_map_t)))), 3711 ); 3712 } 3713 else { 3714 push(@{$parts[-1]}, " auth = no"); 3715 } 3716 } 3717 3718 if (($dump_args->{'DATA'} || $dump_args->{'ALL'}) && !$skip->{'DATA'}) { 3719 push(@parts, [ 3720 'DATA Info:', 3721 ' data = <<.', 3722 $opts->{data} 3723 ]); 3724 } 3725 3726 # rejoin the parts into a string now 3727 # this whole exercise was to avoid extra newlines when only dumping certain parts 3728 foreach my $part (@parts) { 3729 $part = join("\n", @$part) . "\n"; 3730 } 3731 return(join("\n", @parts)); 3732} 3733 3734sub get_username { 3735 my $force_getpwuid = shift; 3736 if ($^O eq 'MSWin32') { 3737 require Win32; 3738 return Win32::LoginName(); 3739 } 3740 if ($force_getpwuid) { 3741 return (getpwuid($<))[0]; 3742 } 3743 return $ENV{LOGNAME} || (getpwuid($<))[0]; 3744} 3745 3746sub get_date_string { 3747 return($G::date_string) if (length($G::date_string) > 0); 3748 3749 my $et = time(); 3750 my @month_names = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); 3751 my @day_names = qw(Sun Mon Tue Wed Thu Fri Sat); 3752 3753 if (!avail("date_manip")) { 3754 ptrans(12, avail_str("date_manip").". Date strings will be in GMT"); 3755 my @l = gmtime($et); 3756 $G::date_string = sprintf("%s, %02d %s %d %02d:%02d:%02d %+05d", 3757 $day_names[$l[6]], 3758 $l[3], 3759 $month_names[$l[4]], 3760 $l[5]+1900, $l[2], $l[1], $l[0], 3761 0); 3762 } else { 3763 # this is convoluted because %a (week day name) and %b (month name) are localized, but per RFC they should be in English. Since 3764 # un-localizing didn't work on every system I tested, jump through hoops here to not use those fields at all. 3765 my @l = localtime($et); 3766 $G::date_string = sprintf("%s, %s %s %s", 3767 $day_names[POSIX::strftime("%w", @l)], 3768 POSIX::strftime("%d", @l), 3769 $month_names[POSIX::strftime("%m", @l) - 1], 3770 POSIX::strftime("%Y %H:%M:%S %z", @l)); 3771 } 3772 return($G::date_string); 3773} 3774 3775# partially Cribbed from "Programming Perl" and MIME::Base64 v2.12 3776sub db64 { 3777 my $s = shift; 3778 if (load("MIME::Base64")) { 3779 return(decode_base64($s)); 3780 } else { 3781 $s =~ tr#A-Za-z0-9+/##cd; 3782 $s =~ s|=+$||; 3783 $s =~ tr#A-Za-z0-9+/# -_#; 3784 my $r = ''; 3785 while ($s =~ s/(.{1,60})//s) { 3786 $r .= unpack("u", chr(32 + int(length($1)*3/4)) . $1); 3787 } 3788 return($r); 3789 } 3790} 3791 3792# partially Cribbed from MIME::Base64 v2.12 3793sub eb64 { 3794 my $s = shift; 3795 my $e = shift || ''; # line ending to use "empty by default" 3796 if (load("MIME::Base64")) { 3797 return(encode_base64($s, $e)); 3798 } else { 3799 my $l = length($s); 3800 chomp($s = pack("u", $s)); 3801 $s =~ s|\n.||gms; 3802 $s =~ s|\A.||gms; 3803 $s =~ tr#` -_#AA-Za-z0-9+/#; 3804 my $p = (3 - $l%3) % 3; 3805 $s =~ s/.{$p}$/'=' x $p/e if ($p); 3806 $s =~ s/(.{1,76})/$1$e/g if (length($e)); 3807 return($s); 3808 } 3809} 3810 3811sub build_version { 3812 my $static = shift; 3813 my $svn = shift; 3814 3815 if ($static ne 'DEVRELEASE') { 3816 # if gen-util passed in a static version, use it unconditionally 3817 return $static; 3818 } elsif ($svn =~ /\$Id:\s+\S+\s+(\d+)\s+(\d+)-(\d+)-(\d+)\s+/) { 3819 # otherwise, this is a dev copy, dynamically build a version string for it 3820 return("$2$3$4.$1-dev"); 3821 } else { 3822 # we wanted a dynamic version, but the SVN Id tag wasn't in the format 3823 # we expected, punt 3824 return("DEVRELEASE"); 3825 } 3826} 3827 3828sub ext_usage { 3829 require Config; 3830 $ENV{PATH} .= ":" unless $ENV{PATH} eq ""; 3831 $ENV{PATH} = $ENV{PATH} . $Config::Config{'installscript'}; 3832 $< = $> = 1 if ($> == 0 || $< == 0); 3833 exec("perldoc", $0) || exit(1); 3834 # make parser happy 3835 %Config::Config = (); 3836 3837 exit(0); 3838} 3839 3840 3841=pod 3842 3843=head1 NAME 3844 3845Swaks - Swiss Army Knife SMTP, the all-purpose SMTP transaction tester 3846 3847=head1 DESCRIPTION 3848 3849Swaks' primary design goal is to be a flexible, scriptable, transaction-oriented SMTP test tool. It handles SMTP features and extensions such as TLS, authentication, and pipelining; multiple version of the SMTP protocol including SMTP, ESMTP, and LMTP; and multiple transport methods including UNIX-domain sockets, internet-domain sockets, and pipes to spawned processes. Options can be specified in environment variables, configuration files, and the command line allowing maximum configurability and ease of use for operators and scripters. 3850 3851=head1 QUICK START 3852 3853Deliver a standard test email to user@example.com on port 25 of test-server.example.net: 3854 3855=over 4 3856 3857 swaks --to user@example.com --server test-server.example.net 3858 3859=back 3860 3861Deliver a standard test email, requiring CRAM-MD5 authentication as user me@example.com. An "X-Test" header will be added to the email body. The authentication password will be prompted for if it cannot be obtained from your L<.netrc|Net::Netrc> file. 3862 3863=over 4 3864 3865 swaks --to user@example.com --from me@example.com --auth CRAM-MD5 --auth-user me@example.com --header-X-Test "test email" 3866 3867=back 3868 3869Test a virus scanner using EICAR in an attachment. Don't show the message DATA part.: 3870 3871=over 4 3872 3873 swaks -t user@example.com --attach - --server test-server.example.com --suppress-data </path/to/eicar.txt 3874 3875=back 3876 3877Test a spam scanner using GTUBE in the body of an email, routed via the MX records for example.com: 3878 3879=over 4 3880 3881 swaks --to user@example.com --body /path/to/gtube/file 3882 3883=back 3884 3885Deliver a standard test email to user@example.com using the LMTP protocol via a UNIX domain socket file 3886 3887=over 4 3888 3889 swaks --to user@example.com --socket /var/lda.sock --protocol LMTP 3890 3891=back 3892 3893Report all the recipients in a text file that are non-verifiable on a test server: 3894 3895=over 4 3896 3897 for E in `cat /path/to/email/file` 3898 do 3899 swaks --to $E --server test-server.example.com --quit-after RCPT --hide-all 3900 [ $? -ne 0 ] && echo $E 3901 done 3902 3903=back 3904 3905=head1 TERMS AND CONVENTIONS 3906 3907This document tries to be consistent and specific in its use of the following terms to reduce confusion. 3908 3909=over 4 3910 3911=item Target 3912 3913The target of a transaction is the thing that Swaks connects to. This generic term is used throughout the documentation because most other terms improperly imply something about the transport being used. 3914 3915=item Transport 3916 3917The transport is the underlying method used to connect to the target. 3918 3919=item Transaction 3920 3921A transaction is the opening of a connection over a transport to a target and using a messaging protocol to attempt to deliver a message. 3922 3923=item Protocol 3924 3925The protocol is the application language used to communicate with the target. This document uses SMTP to speak generically of all three supported protocols unless it states that it is speaking of the specific 'SMTP' protocol and excluding the others. 3926 3927=item Message 3928 3929SMTP protocols exist to transfer messages, a set of bytes in an agreed-upon format that has a sender and a recipient. 3930 3931=item Envelope 3932 3933A message's envelope contains the "true" sender and receiver of a message. It can also be referred to as its components, envelope-sender and envelope-recipients. It is important to note that a messages envelope does not have to match its C<To:> and C<From:> headers. 3934 3935=item DATA 3936 3937The DATA portion of an SMTP transaction is the actual message that is being transported. It consists of both the message's headers and its body. DATA and body are sometimes used synonymously, but they are always two distinct things in this document. 3938 3939=item Headers 3940 3941A message's headers are defined as all the lines in the message's DATA section before the first blank line. They contain information about the email that will be displayed to the recipient such as C<To:>, C<From:>, C<Subject:>, etc. In this document headers will always be written with a capitalized first letter and a trailing colon. 3942 3943=item Body 3944 3945A message's body is the portion of its DATA section following the first blank line. 3946 3947=item Option 3948 3949An option is a flag which changes Swaks' behavior. Always called an option regardless of how it is provided. For instance, C<--no-data-fixup> is an option. 3950 3951=item Argument 3952 3953When an option takes addition data beside the option itself, that additional data is called an argument. In C<< --quit-after <stop-point>' >>, C<< <stop-point> >> is the argument to the C<--quit-after> option. 3954 3955=item <literal-string> 3956 3957When used in the definition of an option, text that is inside of angle brackets (C<< <> >>) indicates a descriptive label for a value that the user should provide. For instance, C<< --quit-after <stop-point> >> indicates that C<< <stop-point> >> should be replaced with a valid stop-point value. 3958 3959=item [<optional-value>] 3960 3961When used in the definition of an option, text inside of square brackets ([]) indicates that the value is optional and can be omitted. For instance, C<< --to [<recipient>] >> indicates that the C<--to> option can be used with or without a specified C<< <recipient> >>. 3962 3963=back 3964 3965=head1 OPTION PROCESSING 3966 3967To prevent potential confusion in this document a flag to Swaks is always referred to as an "option". If the option takes additional data, that additional data is referred to as an argument to the option. For example, C<--from fred@example.com> might be provided to Swaks on the command line, with C<--from> being the option and C<fred@example.com> being C<--from>'s argument. 3968 3969Options and arguments are the only way to provide information to Swaks. If Swaks finds data during option processing that is neither an option nor an option's argument, it will error and exit. For instance, if C<--no-data-fixup 1> were found on the command line, this would result in an error because C<--no-data-fixup> does not take an argument and therefore Swaks would not know what to do with C<1>. 3970 3971Options can be given to Swaks in three ways. They can be specified in a configuration file, in environment variables, and on the command line. Depending on the specific option and whether an argument is given to it, Swaks may prompt the user for the argument. 3972 3973When Swaks evaluates its options, it first looks for a configuration file (either in a default location or specified with C<--config>). Then it evaluates any options in environment variables. Finally, it evaluates command line options. At each round of processing, any options set earlier will be overridden. Additionally, any option can be prefixed with C<no-> to cause Swaks to forget that the variable had previously been set (either in an earlier round, or earlier in the same round). This capability is necessary because many options treat defined-but-no-argument differently than not-defined. 3974 3975As a general rule, if the same option is given multiple time, the last time it is given is the one that will be used. This applies to both intra-method (if C<--from user1@example.com --from user2@example.com> is given, C<user2@example.com> will be used) and inter-method (if C<from user1@example.com> is given in a config file and C<--from user2@example.com> is given on the command line, C<user2@example.com> will be used) 3976 3977Each option definition ends with a parenthetical synopsis of how the option behaves. The following codes can be used 3978 3979=over 4 3980 3981=item Arg-None, Arg-Optional, Arg-Required 3982 3983These three codes are mutually exclusive and describe whether or not the option takes an argument. Note that this does not necessarily describe whether the argument is required to be specified directly, but rather whether an argument is required eventually. For instance, C<--to> is labeled as Arg-Required, but it is legal to specify C<--to> on the command line without an argument. This is because Swaks can prompt for the required argument if it is not directly provided. 3984 3985=item From-Prompt 3986 3987An option labeled with From-Prompt will prompt the user interactively for the argument if none is provided. 3988 3989=item From-File 3990 3991An option labeled with From-File will handle arguments as files in certain situations. 3992 3993If the initial argument is C<->, the final argument is the contents of C<STDIN>. Multiple options can all specify C<STDIN>, but the same content will be used for each of them. 3994 3995If the initial argument is prefixed with C<@>, the argument will be treated as a path to a file. The file will be opened and the contents will be used as the final argument. If the contents of the file can't be read, Swaks will exit. To specify a literal value starting with an C<@>, use two C<@> symbols. The first will be stripped. 3996 3997=item Sensitive 3998 3999If an option marked Sensitive attempts to prompt the user for an argument and the C<--protect-prompt> option is set, Swaks will attempt to mask the user input from being echoed on the terminal. Swaks tries to mask the input in several ways, but if none of them work program flow will continue with unmasked input. 4000 4001=item Deprecated 4002 4003An option labeled Deprecated has been officially deprecated and will be removed in a future release. See the L</DEPRECATIONS> section of this documentation for details about the deprecations. 4004 4005=back 4006 4007The exact mechanism and format for using each of the types is listed below. 4008 4009=over 4 4010 4011=item CONFIGURATION FILES 4012 4013A configuration file can be used to set commonly-used or abnormally verbose options. By default, Swaks looks in order for F<$SWAKS_HOME/.swaksrc>, F<$HOME/.swaksrc>, and F<$LOGDIR/.swaksrc>. If one of those is found to exist (and C<--config> has not been used) that file is used as the configuration file. 4014 4015Additionally, a configuration file in a non-default location can be specified using C<--config>. If this is set and not given an argument Swaks will not use any configuration file, including any default file. If C<--config> points to a readable file, it is used as the configuration file, overriding any default that may exist. If it points to a non-readable file an error will be shown and Swaks will exit. 4016 4017A set of "portable" defaults can also be created by adding options to the end of the Swaks program file. As distributed, the last line of Swaks should be C<__END__>. Any lines added after C<__END__> will be treated as the contents of a configuration file. This allows a set of user preferences to be automatically copied from server to server in a single file. 4018 4019If configuration files have not been explicitly turned off, the C<__END__> config is always read. Only one other configuration file will ever be used per single invocation of Swaks, even if multiple configuration files are specified. If the C<__END__> config and another config are to be read, the C<__END__> config will be processed first. Specifying the C<--config> option with no argument turns off the processing of both the C<__END__> config and any actual config files. 4020 4021In a configuration file lines beginning with a hash (C<#>) are ignored. All other lines are assumed to be an option to Swaks, with the leading dash or dashes optional. Everything after an option line's first space is assumed to be the option's argument and is not shell processed. Therefore, quoting is usually unneeded and will be included literally in the argument. 4022 4023There is a subtle difference between providing an option with no argument and providing an option with an empty argument. If an option line does not have a space, the entire line is treated as an option and there is no argument. If the line ends in a single space, it will be processed as an option with an empty argument. So, C<apt> will be treated as C<--apt>, but C<apt > will be treated as C<S<--apt ''>>. 4024 4025Here is an example of the contents of a configuration file: 4026 4027 # always use this sender, no matter server or logged in user 4028 --from fred@example.com 4029 # I prefer my test emails have a pretty from header. Note 4030 # the lack of dashes on option and lack of quotes around 4031 # entire argument. 4032 h-From: "Fred Example" <fred@example.com> 4033 4034Options specific to configuration file: 4035 4036=over 4 4037 4038=item --config [<config-file>] 4039 4040This option provides a path to a specific configuration file to be used. If specified with no argument, no automatically-found configuration file (via C<$HOME>, etc, or C<__END__>) will be processed. If the argument is a valid file, that file will be used as the configuration file (after C<__END__> config). If argument is not a valid, readable file, Swaks will error and exit. This option can be specified multiple times, but only the first time it is specified (in environment variable and the command line search order) will be used. (Arg-Optional) 4041 4042=back 4043 4044=item CONFIGURATION ENVIRONMENT VARIABLES 4045 4046Options can be supplied via environment variables. The variables are in the form C<$SWAKS_OPT_name>, where C<name> is the name of the option that would be specified on the command line. Because dashes aren't allowed in environment variable names in most UNIX-ish shells, no leading dashes should be used and any dashes inside the option's name should be replaced with underscores. The following would create the same options shown in the configuration file example: 4047 4048 $ SWAKS_OPT_from='fred@example.com' 4049 $ SWAKS_OPT_h_From='"Fred Example" <fred@example.com>' 4050 4051Setting a variable to an empty value is the same as specifying it on the command line with no argument. For instance, setting <SWAKS_OPT_server=""> would cause Swaks to prompt the user for the server to which to connect at each invocation. 4052 4053Because there is no inherent order in options provided by setting environment variables, the options are sorted before being processed. This is not a great solution, but it at least defines the behavior, which would be otherwise undefined. As an example, if both C<$SWAKS_OPT_from> and C<$SWAKS_OPT_f> were set, the value from C<$SWAKS_OPT_from> would be used, because it sorts after C<$SWAKS_OPT_f>. Also as a result of not having an inherent order in environment processing, unsetting options with the C<no-> prefix is unreliable. It works if the option being turned off sorts before C<no->, but fails if it sorts after. Because C<no-> is primarily meant to operate between config types (for instance, unsetting from the command line an option that was set in a config file), this is not likely to be a problem. 4054 4055In addition to setting the equivalent of command line options, C<$SWAKS_HOME> can be set to a directory containing the default F<.swaksrc> to be used. 4056 4057=item COMMAND LINE OPTIONS 4058 4059The final method of supplying options to Swaks is via the command line. The options behave in a manner consistent with most UNIX-ish command line programs. Many options have both a short and long form (for instance C<-s> and C<--server>). By convention short options are specified with a single dash and long options are specified with a double-dash. This is only a convention and either prefix will work with either type. 4060 4061The following demonstrates the example shown in the configuration file and environment variable sections: 4062 4063 $ swaks --from fred@example.com --h-From: '"Fred Example" <fred@example.com>' 4064 4065=back 4066 4067=head1 TRANSPORTS 4068 4069Swaks can connect to a target via UNIX pipes ("pipes"), UNIX domain sockets ("UNIX sockets"), or internet domain sockets ("network sockets"). Connecting via network sockets is the default behavior. Because of the singular nature of the transport used, each set of options in the following section is mutually exclusive. Specifying more than one of C<--server>, C<--pipe>, or C<--socket> will result in an error. Mixing other options between transport types will only result in the irrelevant options being ignored. Below is a brief description of each type of transport and the options that are specific to that transport type. 4070 4071=over 4 4072 4073=item NETWORK SOCKETS 4074 4075This transport attempts to deliver a message via TCP/IP, the standard method for delivering SMTP. This is the default transport for Swaks. If none of C<--server>, C<--pipe>, or C<--socket> are given then this transport is used and the target server is determined from the recipient's domain (see C<--server> below for more details). 4076 4077This transport requires the L<IO::Socket> module which is part of the standard Perl distribution. If this module is not loadable, attempting to use this transport will result in an error and program termination. 4078 4079IPv6 is supported when the L<IO::Socket::INET6> module is present. 4080 4081=over 4 4082 4083=item -s, --server [<target-server>[:<port>]] 4084 4085Explicitly tell Swaks to use network sockets and specify the hostname or IP address to which to connect, or prompt if no argument is given. If this option is not given and no other transport option is given, the target mail server is determined from the appropriate DNS records for the domain of the recipient email address using the L<Net::DNS> module. If L<Net::DNS> is not available Swaks will attempt to connect to localhost to deliver. The target port can optionally be set here. Supported formats for this include SERVER:PORT (supporting names and IPv4 addresses); [SERVER]:PORT and SERVER/PORT (supporting names, IPv4 and IPv6 addresses). See also C<--copy-routing>. (Arg-Required, From-Prompt) 4086 4087=item -p, --port [<port>] 4088 4089Specify which TCP port on the target is to be used, or prompt if no argument is listed. The argument can be a service name (as retrieved by L<getservbyname(3)>) or a port number. The default port is smtp/25 unless influenced by the C<--protocol> or C<--tls-on-connect> options. (Arg-Required, From-Prompt) 4090 4091=item -li, --local-interface [<local-interface>[:<port>]] 4092 4093Use argument as the local interface for the outgoing SMTP connection, or prompt user if no argument given. Argument can be an IP address or a hostname. Default action is to let the operating system choose the local interface. See C<--server> for additional comments on :<port> format. (Arg-Required, From-Prompt) 4094 4095=item -lp, --local-port, --lport [<port>] 4096 4097Specify the outgoing port from which to originate the transaction. The argument can be a service name (as retrieved by L<getservbyname(3)>) or a port number. If this option is not specified the system will pick an ephemeral port. Note that regular users cannot specify some ports. (Arg-Required, From-Prompt) 4098 4099=item --copy-routing <domain> 4100 4101The argument is interpreted as the domain part of an email address and it is used to find the target server using the same logic that would be used to look up the target server for a recipient email address. See C<--to> option for more details on how the target is determined from the email domain. (Arg-Required) 4102 4103=item -4, -6 4104 4105Force IPv4 or IPv6. (Arg-None) 4106 4107=back 4108 4109=item UNIX SOCKETS 4110 4111This transport method attempts to deliver messages via a UNIX-domain socket file. This is useful for testing MTA/MDAs that listen on socket files (for instance, testing LMTP delivery to Cyrus). This transport requires the L<IO::Socket> module which is part of the standard Perl distribution. If this module is not loadable, attempting to use this transport will result in an error and program termination. 4112 4113=over 4 4114 4115=item --socket [<socket-file>] 4116 4117This option takes as its argument a UNIX-domain socket file. If Swaks is unable to open this socket it will display an error and exit. (Arg-Required, From-Prompt) 4118 4119=back 4120 4121=item PIPES 4122 4123This transport attempts to spawn a process and communicate with it via pipes. The spawned program must be prepared to behave as a mail server over C<STDIN>/C<STDOUT>. Any MTA designed to operate from inet/xinet should support this. In addition, some MTAs provide testing modes that can be communicated with via C<STDIN>/C<STDOUT>. This transport can be used to automate that testing. For example, if you implemented DNSBL checking with Exim and you wanted to make sure it was working, you could run C<swaks --pipe "exim -bh 127.0.0.2">. Ideally, the process you are talking to should behave exactly like an SMTP server on C<STDIN> and C<STDOUT>. Any debugging should be sent to C<STDERR>, which will be directed to your terminal. In practice, Swaks can generally handle some debug on the child's C<STDOUT>, but there are no guarantees on how much it can handle. 4124 4125This transport requires the L<IPC::Open2> module which is part of the standard Perl distribution. If this module is not loadable, attempting to use this transport will result in an error and program termination. 4126 4127=over 4 4128 4129=item --pipe [<command-and-arguments>] 4130 4131Provide a process name and arguments to the process. Swaks will attempt to spawn the process and communicate with it via pipes. If the argument is not an executable Swaks will display an error and exit. (Arg-Required, From-Prompt) 4132 4133=back 4134 4135=back 4136 4137=head1 PROTOCOL OPTIONS 4138 4139These options are related to the protocol layer. 4140 4141=over 4 4142 4143=item -t, --to [<email-address>[,<email-address>[,...]]] 4144 4145Tells Swaks to use argument(s) as the envelope-recipient for the email, or prompt for recipient if no argument provided. If multiple recipients are provided and the recipient domain is needed to determine routing the domain of the last recipient provided is used. 4146 4147There is no default value for this option. If no recipients are provided via any means, user will be prompted to provide one interactively. The only exception to this is if a C<--quit-after> value is provided which will cause the SMTP transaction to be terminated before the recipient is needed. (Arg-Required, From-Prompt) 4148 4149=item -f, --from [<email-address>] 4150 4151Use argument as envelope-sender for email, or prompt user if no argument specified. The string C<< <> >> can be supplied to mean the null sender. If user does not specify a sender address a default value is used. The domain-part of the default sender is a best guess at the fully-qualified domain name of the local host. The method of determining the local-part varies. On Windows, C<Win32::LoginName()> is used. On UNIX-ish platforms, the C<$LOGNAME> environment variable is used if it is set. Otherwise L<getpwuid(3)> is used. See also C<--force-getpwuid>. If Swaks cannot determine a local hostname and the sender address is needed for the transaction, Swaks will error and exit. In this case, a valid string must be provided via this option. (Arg-Required, From-Prompt) 4152 4153=item --ehlo, --lhlo, -h, --helo [<helo-string>] 4154 4155String to use as argument to HELO/EHLO/LHLO command, or prompt user if no argument is specified. If this option is not used a best guess at the fully-qualified domain name of the local host is used. If Swaks cannot determine a local hostname and the helo string is needed for the transaction, Swaks will error and exit. In this case, a valid string must be provided via this option. (Arg-Required, From-Prompt) 4156 4157=item -q, --quit, --quit-after <stop-point> 4158 4159Point at which the transaction should be stopped. When the requested stopping point is reached in the transaction, and provided that Swaks has not errored out prior to reaching it, Swaks will send "QUIT" and attempt to close the connection cleanly. These are the valid arguments and notes about their meaning. (Arg-Required) 4160 4161=over 4 4162 4163=item CONNECT, BANNER 4164 4165Terminate the session after receiving the greeting banner from the target. 4166 4167=item FIRST-HELO, FIRST-EHLO, FIRST-LHLO 4168 4169In a STARTTLS (but not tls-on-connect) session, terminate the transaction after the first of two HELOs. In a non-STARTTLS transaction, behaves the same as HELO (see below). 4170 4171=item XCLIENT 4172 4173Quit after XCLIENT is sent. 4174 4175=item STARTTLS, TLS 4176 4177Quit the transaction immediately following TLS negotiation. Note that this happens in different places depending on whether STARTTLS or tls-on-connect are used. This always quits after the point where TLS would have been negotiated, regardless of whether it was attempted. 4178 4179=item HELO, EHLO, LHLO 4180 4181In a STARTTLS or XCLIENT session, quit after the second HELO. Otherwise quit after the first and only HELO. 4182 4183=item AUTH 4184 4185Quit after authentication. This always quits after the point where authentication would have been negotiated, regardless of whether it was attempted. 4186 4187=item MAIL, FROM 4188 4189Quit after MAIL FROM: is sent. 4190 4191=item RCPT, TO 4192 4193Quit after RCPT TO: is sent. 4194 4195=back 4196 4197=item --da, --drop-after <stop-point> 4198 4199The option is similar to C<--quit-after>, but instead of trying to cleanly shut down the session it simply terminates the session. This option accepts the same stop-points as C<--quit-after> and additionally accepts DATA and DOT, detailed below. (Arg-Required) 4200 4201=over 4 4202 4203=item DATA 4204 4205Quit after DATA is sent. 4206 4207=item DOT 4208 4209Quit after the final '.' of the message is sent. 4210 4211=back 4212 4213=item --das, --drop-after-send <stop-point> 4214 4215This option is similar to C<--drop-after>, but instead of dropping the connection after reading a response to the stop-point, it drops the connection immediately after sending stop-point. It accepts the same stop-points as C<--drop-after>. (Arg-Required) 4216 4217=item --timeout [<time>] 4218 4219Use argument as the SMTP transaction timeout, or prompt user if no argument given. Argument can either be a pure digit, which will be interpreted as seconds, or can have a specifier s, m, or h (5s = 5 seconds, 3m = 180 seconds, 1h = 3600 seconds). As a special case, 0 means don't timeout the transactions. Default value is 30s. (Arg-Required, From-Prompt) 4220 4221=item --protocol <protocol> 4222 4223Specify 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 tersely specify default ports, whether authentication should be attempted, and the type of TLS connection that should be attempted. The default protocol is ESMTP. The following table demonstrates the available arguments to C<--protocol> and the options each sets as a side effect. (Arg-Required) 4224 4225=over 4 4226 4227=item SMTP 4228 4229HELO, "-p 25" 4230 4231=item SSMTP 4232 4233EHLO-E<gt>HELO, "-tlsc -p 465" 4234 4235=item SSMTPA 4236 4237EHLO-E<gt>HELO, "-a -tlsc -p 465" 4238 4239=item SMTPS 4240 4241HELO, "-tlsc -p 465" 4242 4243=item ESMTP 4244 4245EHLO-E<gt>HELO, "-p 25" 4246 4247=item ESMTPA 4248 4249EHLO-E<gt>HELO, "-a -p 25" 4250 4251=item ESMTPS 4252 4253EHLO-E<gt>HELO, "-tls -p 25" 4254 4255=item ESMTPSA 4256 4257EHLO-E<gt>HELO, "-a -tls -p 25" 4258 4259=item LMTP 4260 4261LHLO, "-p 24" 4262 4263=item LMTPA 4264 4265LHLO, "-a -p 24" 4266 4267=item LMTPS 4268 4269LHLO, "-tls -p 24" 4270 4271=item LMTPSA 4272 4273LHLO, "-a -tls -p 24" 4274 4275=back 4276 4277=item --pipeline 4278 4279If the remote server supports it, attempt SMTP PIPELINING (RFC 2920). (Arg-None) 4280 4281=item --prdr 4282 4283If the server supports it, attempt Per-Recipient Data Response (PRDR) (L<https://tools.ietf.org/html/draft-hall-prdr-00.txt>). PRDR is not yet standardized, but MTAs have begun implementing the proposal. (Arg-None) 4284 4285=item --force-getpwuid 4286 4287Tell Swaks to use the getpwuid method of finding the default sender local-part instead of trying C<$LOGNAME> first. (Arg-None) 4288 4289=back 4290 4291=head1 TLS / ENCRYPTION 4292 4293These are options related to encrypting the transaction. These have been tested and confirmed to work with all three transport methods. The L<Net::SSLeay> module is used to perform encryption when it is requested. If this module is not loadable Swaks will either ignore the TLS request or error out, depending on whether the request was optional. STARTTLS is defined as an extension in the ESMTP protocol and will be unavailable if C<--protocol> is set to a variation of SMTP. Because it is not defined in the protocol itself, C<--tls-on-connect> is available for any protocol type if the target supports it. 4294 4295A local certificate is not required for a TLS connection to be negotiated. However, some servers use client certificate checking to verify that the client is allowed to connect. Swaks can be told to use a specific local certificate using the C<--tls-cert> and C<--tls-key> options. 4296 4297=over 4 4298 4299=item -tls 4300 4301Require connection to use STARTTLS. Exit if TLS not available for any reason (not advertised, negotiations failed, etc). (Arg-None) 4302 4303=item -tlso, --tls-optional 4304 4305Attempt to use STARTTLS if available, continue with normal transaction if TLS was unable to be negotiated for any reason. Note that this is a semi-useless option as currently implemented because after a negotiation failure the state of the connection is unknown. In some cases, like a version mismatch, the connection should be left as plaintext. In others, like a verification failure, the server-side may think that it should continue speaking TLS while the client thinks it is plaintext. There may be an attempt to add more granular state detection in the future, but for now just be aware that odd things may happen with this option if the TLS negotiation is attempted and fails. (Arg-None) 4306 4307=item -tlsos, --tls-optional-strict 4308 4309Attempt to use STARTTLS if available. Proceed with transaction if TLS is negotiated successfully or STARTTLS not advertised. If STARTTLS is advertised but TLS negotiations fail, treat as an error and abort transaction. Due to the caveat noted above, this is a much saner option than C<--tls-optional>. (Arg-None) 4310 4311=item -tlsc, --tls-on-connect 4312 4313Initiate a TLS connection immediately on connection. Following common convention, if this option is specified the default port changes from 25 to 465, though this can still be overridden with the --port option. (Arg-None) 4314 4315=item -tlsp, --tls-protocol <tls-version-specification> 4316 4317Specify which protocols to use (or not use) when negotiating TLS. At the time of this writing, the available protocols are sslv2, sslv3, tlsv1, tlsv1_1, tlsv1_2, and tlsv1_3. The availability of these protocols is dependent on your underlying OpenSSL library, so not all of these may be available. The list of available protocols is shown in the output of C<--dump> (assuming TLS is available at all). 4318 4319The specification string is a comma-delimited list of protocols that can be used or not used. For instance 'tlsv1,tlsv1_1' will only succeed if one of those two protocols is available on both the client and the server. Conversely, 'no_sslv2,no_sslv3' will attempt to negotiate any protocol except sslv2 and sslv3. The two forms of specification cannot be mixed. (Arg-Required) 4320 4321=item --tls-cipher <cipher-string> 4322 4323The argument to this option is passed to the underlying OpenSSL library to set the list of acceptable ciphers to the be used for the connection. The format of this string is opaque to Swaks and is defined in L<http://www.openssl.org/docs/apps/ciphers.html#CIPHER_LIST_FORMAT>. A brief example would be C<--tls-cipher '3DES:+RSA'>. (Arg-Required) 4324 4325=item --tls-verify 4326 4327Tell Swaks to attempt to verify the server's certificate. If this option is set and the server's certificate is not verifiable (either using the system-default CA information, or custom CA information (see C<--tls-ca-path>)) TLS negotiation will not succeed. By default, Swaks does not attempt certificate verification. (Arg-None) 4328 4329=item --tls-ca-path <ca-location> 4330 4331Specify an alternate location for CA information for verifying server certificates. The argument can point to a file or directory. The default behavior is to use the underlying OpenSSL library's default information. (Arg-Required) 4332 4333=item --tls-cert <cert-file> 4334 4335Provide a path to a file containing the local certificate Swaks should use if TLS is negotiated. The file path argument is required. As currently implemented the certificate in the file must be in PEM format. Contact the author if there's a compelling need for ASN1. If this option is set, C<--tls-key> is also required. (Arg-Required) 4336 4337=item --tls-key <key-file> 4338 4339Provide a path to a file containing the local private key Swaks should use if TLS is negotiated. The file path argument is required. As currently implemented the certificate in the file must be in PEM format. Contact the author if there's a compelling need for ASN1. If this option is set, C<--tls-cert> is also required. (Arg-Required) 4340 4341=item --tls-get-peer-cert [<output-file>] 4342 4343Get a copy of the TLS peer's certificate. If no argument is given, it will be displayed to C<STDOUT>. If an argument is given it is assumed to be a filesystem path specifying where the certificate should be written. The saved certificate can then be examined using standard tools such as the openssl command. If a file is specified its contents will be overwritten. (Arg-Optional) 4344 4345=item --tls-sni <sni-string> 4346 4347Specify the Server Name Indication field to send when the TLS connection is initiated. (Arg-Required) 4348 4349=back 4350 4351=head1 AUTHENTICATION 4352 4353Swaks will attempt to authenticate to the target mail server if instructed to do so. This section details available authentication types, requirements, options and their interactions, and other fine points in authentication usage. Because authentication is defined as an extension in the ESMTP protocol it will be unavailable if C<--protocol> is set to a variation of SMTP. 4354 4355All authentication methods require base64 encoding. If the L<MIME::Base64> Perl module is loadable Swaks attempts to use it to perform these encodings. If L<MIME::Base64> is not available Swaks will use its own onboard base64 routines. These are slower than the L<MIME::Base64> routines and less reviewed, though they have been tested thoroughly. Using the L<MIME::Base64> module is encouraged. 4356 4357If authentication is required (see options below for when it is and isn't required) and the requirements aren't met for the authentication type available, Swaks displays an error and exits. Two ways this can happen include forcing Swaks to use a specific authentication type that Swaks can't use due to missing requirements, or allowing Swaks to use any authentication type, but the server only advertises types Swaks can't support. In the former case Swaks errors out at option processing time since it knows up front it won't be able to authenticate. In the latter case Swaks will error out at the authentication stage of the SMTP transaction since Swaks will not be aware that it will not be able to authenticate until that point. 4358 4359Following are the supported authentication types including any individual notes and requirements. 4360 4361The following options affect Swaks' use of authentication. These options are all inter-related. For instance, specifying C<--auth-user> implies C<--auth> and C<--auth-password>. Specifying C<--auth-optional> implies C<--auth-user> and C<--auth-password>, etc. 4362 4363=over 4 4364 4365=item -a, --auth [<auth-type>[,<auth-type>[,...]]] 4366 4367Require Swaks to authenticate. If no argument is given, any supported auth-types advertised by the server are tried until one succeeds or all fail. If one or more auth-types are specified as an argument, each that the server also supports is tried in order until one succeeds or all fail. This option requires Swaks to authenticate, so if no common auth-types are found or no credentials succeed, Swaks displays an error and exits. (Arg-Optional) 4368 4369The following tables lists the valid auth-types 4370 4371=over 4 4372 4373=item LOGIN, PLAIN 4374 4375These basic authentication types are fully supported and tested and have no additional requirements 4376 4377=item CRAM-MD5 4378 4379The CRAM-MD5 authenticator requires the L<Digest::MD5> module. It is fully tested and believed to work against any server that implements it. 4380 4381=item DIGEST-MD5 4382 4383The DIGEST-MD5 authenticator (RFC2831) requires the Authen::SASL module. Version 20100211.0 and earlier used L<Authen::DigestMD5> which had some protocol level errors which prevented it from working with some servers. L<Authen::SASL>'s DIGEST-MD5 handling is much more robust. 4384 4385The DIGEST-MD5 implementation in Swaks is fairly immature. It currently supports only the "auth" qop type, for instance. If you have DIGEST-MD5 experience and would like to help Swaks support DIGEST-MD5 better, please get in touch with me. 4386 4387The DIGEST-MD5 protocol's "realm" value can be set using the C<--auth-extra> "realm" keyword. If no realm is given, a reasonable default will be used. 4388 4389The DIGEST-MD5 protocol's "digest-uri" values can be set using the C<--auth-extra> option. For instance, you could create the digest-uri-value of "lmtp/mail.example.com/example.com" with the option C<--auth-extra dmd5-serv-type=lmtp,dmd5-host=mail.example.com,dmd5-serv-name=example.com>. The "digest-uri-value" string and its components is defined in RFC2831. If none of these values are given, reasonable defaults will be used. 4390 4391=item CRAM-SHA1 4392 4393The CRAM-SHA1 authenticator requires the L<Digest::SHA> module. This type has only been tested against a non-standard implementation on an Exim server and may therefore have some implementation deficiencies. 4394 4395=item NTLM/SPA/MSN 4396 4397These authenticators require the Authen::NTLM module. Note that there are two modules using the L<Authen::NTLM> namespace on CPAN. The Mark Bush implementation (Authen/NTLM-1.03.tar.gz) is the version required by Swaks. This type has been tested against Exim, Communigate, and Exchange 2007. 4398 4399In addition to the standard username and password, this authentication type can also recognize a "domain". The domain can be set using the C<--auth-extra> "domain" keyword. Note that this has never been tested with a mail server that doesn't ignore DOMAIN so this may be implemented incorrectly. 4400 4401=back 4402 4403=item -ao, --auth-optional [<auth-type>[,<auth-type>[,...]]] 4404 4405This option behaves identically to C<--auth> except that it requests authentication rather than requiring it. If no common auth-types are found or no credentials succeed, Swaks proceeds as if authentication had not been requested. (Arg-Optional) 4406 4407=item -aos, --auth-optional-strict [<auth-type>[,<auth-type>[,...]]] 4408 4409This option is a compromise between C<--auth> and C<--auth-optional>. If no common auth-types are found, Swaks behaves as if C<--auth-optional> were specified and proceeds with the transaction. If Swaks can't support requested auth-type, the server doesn't advertise any common auth-types, or if no credentials succeed, Swaks behaves as if C<--auth> were used and exits with an error. (Arg-Optional) 4410 4411=item -au, --auth-user [<username>] 4412 4413Provide the username to be used for authentication. If no username is provided, indicate that Swaks should attempt to find the username via F<.netrc> (requires the L<Net::Netrc> module). If no username is provided and cannot be found via F<.netrc>, the user will be prompted to provide one. The string C<< <> >> can be supplied to mean an empty username. (Arg-Required, From-Prompt) 4414 4415=item -ap, --auth-password [<password>] 4416 4417Provide the password to be used for authentication. If no password is provided, indicate that Swaks should attempt to find the password via F<.netrc> (requires the L<Net::Netrc> module). If no password is provided and cannot be found via F<.netrc>, the user will be prompted to provide one. The string C<< <> >> can be supplied to mean an empty password. (Arg-Required, From-Prompt, Sensitive) 4418 4419=item -ae, --auth-extra <key-value-pair>[,<key-value-pair>[,...]] 4420 4421Some of the authentication types allow extra information to be included in the authentication process. Rather than add a new option for every nook and cranny of each authenticator, the C<--auth-extra> option allows this information to be supplied. The format for <key-value-pair> is KEYWORD=VALUE. (Arg-Required) 4422 4423The following table lists the currently recognized keywords and the authenticators that use them 4424 4425=over 4 4426 4427=item realm, domain 4428 4429The realm and domain keywords are synonymous. Using either will set the "domain" option in NTLM/MSN/SPA and the "realm" option in DIGEST-MD5 4430 4431=item dmd5-serv-type 4432 4433The dmd5-serv-type keyword is used by the DIGEST-MD5 authenticator and is used, in part, to build the digest-uri-value string (see RFC2831) 4434 4435=item dmd5-host 4436 4437The dmd5-host keyword is used by the DIGEST-MD5 authenticator and is used, in part, to build the digest-uri-value string (see RFC2831) 4438 4439=item dmd5-serv-name 4440 4441The dmd5-serv-name keyword is used by the DIGEST-MD5 authenticator and is used, in part, to build the digest-uri-value string (see RFC2831) 4442 4443=back 4444 4445=item -am, --auth-map <key-value-pair>[,<key-value-pair>[,...]] 4446 4447Provides a way to map alternate names onto base authentication types. Useful for any sites that use alternate names for common types. The format for <key-value-pair> is AUTH-ALIAS=AUTH-TYPE. 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 C<--auth-map SPA=NTLM,MSN=NTLM>. All of the auth-types listed above are valid targets for mapping except SPA and MSN. (Arg-Required) 4448 4449=item -apt, --auth-plaintext 4450 4451Instead of showing AUTH strings base64 encoded as they are transmitted, translate them to plaintext before printing on screen. (Arg-None) 4452 4453=item -ahp, --auth-hide-password [<replacement-string>] 4454 4455If this option is specified, any time a readable password would be printed to the terminal (specifically AUTH PLAIN and AUTH LOGIN) the password is replaced with the string 'PROVIDED_BUT_REMOVED' (or the contents of <replacement-string> if provided). The dummy string may or may not be base64 encoded, contingent on the C<--auth-plaintext> option. 4456 4457Note that C<--auth-hide-password> is similar, but not identical, to the C<--protect-prompt> option. The former protects passwords from being displayed in the SMTP transaction regardless of how they are entered. The latter protects sensitive strings when the user types them at the terminal, regardless of how the string would be used. (Arg-Optional) 4458 4459=back 4460 4461=head1 XCLIENT OPTIONS 4462 4463XCLIENT is an SMTP extension introduced by the Postfix project. XCLIENT allows a (properly-authorized) client to tell a server to use alternate information, such as IP address or hostname, for the client. This allows much easier paths for testing mail server configurations. Full details on the protocol are available at L<http://www.postfix.org/XCLIENT_README.html>. 4464 4465The XCLIENT verb can be passed to the server multiple times per SMTP session with different attributes. For instance, HELO and PROTO might be passed in one call and NAME and ADDR passed in a second. Because it can be useful for testing, Swaks exposes some control over how the attributes are grouped and in what order they are passed to the server. The different options attempt to expose simplicity for those using Swaks as a client, and complexity for those using Swaks to test installs. 4466 4467=over 4 4468 4469=item --xclient-addr [<string>] 4470 4471=item --xclient-name [<string>] 4472 4473=item --xclient-port [<string>] 4474 4475=item --xclient-proto [<string>] 4476 4477=item --xclient-destaddr [<string>] 4478 4479=item --xclient-destport [<string>] 4480 4481=item --xclient-helo [<string>] 4482 4483=item --xclient-login [<string>] 4484 4485=item --xclient-reverse-name [<string>] 4486 4487These options specify XCLIENT attributes that should be sent to the target server. If <string> is not provided, Swaks will prompt and read the value on C<STDIN>. See L<http://www.postfix.org/XCLIENT_README.html> for official documentation for what the attributes mean and their possible values, including the special "[UNAVAILABLE]" and "[TEMPUNAVAIL]" values. 4488 4489By way of simple example, setting C<--xclient-name foo.example.com --xclient-addr 192.168.1.1> will cause Swaks to send the SMTP command C<XCLIENT NAME=foo.example.com ADDR=192.168.1.1>. 4490 4491Note that the "REVERSE_NAME" attribute doesn't seem to appear in the official documentation. There is a mailing list thread that documents it, viewable at L<http://comments.gmane.org/gmane.mail.postfix.user/192623>. 4492 4493These options can all be mixed with each other, and can be mixed with the C<--xclient> option (see below). By default all attributes will be combined into one XCLIENT call, but see C<--xclient-delim>. (Arg-Required, From-Prompt) 4494 4495=item --xclient-delim 4496 4497When this option is specified, it indicates a break in XCLIENT attributes to be sent. For instance, setting C<--xclient-helo 'helo string' --xclient-delim --xclient-name foo.example.com --xclient-addr 192.168.1.1> will cause Swaks to send two XCLIENT calls, C<XCLIENT HELO=helo+20string> and C<XCLIENT NAME=foo.example.com ADDR=192.168.1.1>. This option is ignored where it doesn't make sense (at the start or end of XCLIENT options, by itself, consecutively, etc). (Arg-None) 4498 4499=item --xclient [<string>] 4500 4501This is the "free form" XCLIENT option. Whatever value is provided for <string> will be sent verbatim as the argument to the XCLIENT SMTP command. For example, if C<--xclient 'NAME= ADDR=192.168.1.1 FOO=bar'> is used, Swaks will send the SMTP command C<XCLIENT NAME= ADDR=192.168.1.1 FOO=bar>. If no argument is passed on command line, Swaks will prompt and read the value on STDIN. 4502 4503The primary advantage to this over the more specific options above is that there is no XCLIENT syntax validation here. This allows you to send invalid XCLIENT to the target server for testing. Additionally, at least one MTA (Message Systems' Momentum, formerly ecelerity) implements XCLIENT without advertising supported attributes. The C<--xclient> option allows you to skip the "supported attributes" check when communicating with this type of MTA (though see also C<--xclient-no-verify>). 4504 4505The C<--xclient> option can be mixed freely with the C<--xclient-*> options above. The argument to C<--xclient> will be sent in its own command group. For instance, if C<--xclient-addr 192.168.0.1 --xclient-port 26 --xclient 'FOO=bar NAME=wind'> is given to Swaks, C<XCLIENT ADDR=192.168.0.1 PORT=26> and C<XCLIENT FOO=bar NAME=wind> will both be sent to the target server. (Arg-Required, From-Prompt) 4506 4507=item --xclient-no-verify 4508 4509Do not enforce the requirement that an XCLIENT attribute must be advertised by the server in order for Swaks to send it in an XCLIENT command. This is to support servers which don't advertise the attributes but still support them. (Arg-None) 4510 4511=item --xclient-before-starttls 4512 4513If Swaks is configured to attempt both XCLIENT and STARTTLS, it will do STARTTLS first. If this option is specified it will attempt XCLIENT first. (Arg-None) 4514 4515=item --xclient-optional 4516 4517=item --xclient-optional-strict 4518 4519In normal operation, setting one of the C<--xclient*> options will require a successful XCLIENT transaction to take place in order to proceed (that is, XCLIENT needs to be advertised, all the user-requested attributes need to have been advertised, and the server needs to have accepted Swaks' XCLIENT request). These options change that behavior. C<--xclient-optional> tells Swaks to proceed unconditionally past the XCLIENT stage of the SMTP transaction, regardless of whether it was successful. C<--xclient-optional-strict> is similar but more granular. The strict version will continue to XCLIENT was not advertised, but will fail if XCLIENT was attempted but did not succeed. (Arg-None) 4520 4521=back 4522 4523=head1 PROXY OPTIONS 4524 4525Swaks implements the Proxy protocol as defined in L<http://www.haproxy.org/download/1.5/doc/proxy-protocol.txt>. Proxy allows an application load balancer, such as HAProxy, to be used in front of an MTA while still allowing the MTA access to the originating host information. Proxy support in Swaks allows direct testing of an MTA configured to expect requests from a proxy, bypassing the proxy itself during testing. 4526 4527Swaks makes no effort to ensure that the Proxy options used are internally consistent. For instance, C<--proxy-family> (in version 1) is expected to be one of "TCP4" or "TCP6". While it will likely not make sense to the target server, Swaks makes no attempt to ensure that C<--proxy-source> and C<--proxy-dest> are in the same protocol family as C<--proxy-family> or each other. 4528 4529The C<--proxy> option is mutually exclusive with all other C<--proxy-*> options except C<--proxy-version>. 4530 4531When C<--proxy> is not used, all of C<--proxy-family>, C<--proxy-source>, C<--proxy-source-port>, C<--proxy-dest>, and C<--proxy-dest-port> are required. Additionally, when C<--proxy-version> is 2, C<--proxy-protocol> and C<--proxy-command> are optional. 4532 4533=over 4 4534 4535=item --proxy-version [ 1 | 2 ] 4536 4537Whether to use version 1 (human readable) or version 2 (binary) of the Proxy protocol. Version 1 is the default. Version 2 is only implemented through the "address block", and is roughly on par with the information provided in version 1. 4538 4539=item --proxy [<string>] 4540 4541If this option is used, its argument is passed unchanged after the "PROXY " portion (or the 12-byte protocol header for version 2) of the Proxy exchange. This option allows sending incomplete or malformed Proxy strings to a target server for testing. No attempt to translate or modify this string is made, so if used with C<--proxy-version 2> the argument should be in the appropriate binary format. This option is mutually exclusive with all other C<--proxy-*> options which provide granular proxy information. (Arg-Required, From-Prompt) 4542 4543=item --proxy-family [<string>] 4544 4545For version 1, specifies both the address family and transport protocol. The protocol defines TCP4 and TCP6. 4546 4547For version 2, specifies only the address family. The protocol defines AF_UNSPEC, AF_INET, AF_INET6, and AF_UNIX. (Arg-Required, From-Prompt) 4548 4549=item --proxy-protocol [<string>] 4550 4551For version 2, specifies the transport protocol. The protocol defines UNSPEC, STREAM, and DGRAM. The default is STREAM. This option is unused in version 1. (Arg-Required, From-Prompt) 4552 4553=item --proxy-command [<string>] 4554 4555For version 2, specifies the transport protocol. The protocol defines LOCAL and PROXY. The default is PROXY. This option is unused in version 1. (Arg-Required, From-Prompt) 4556 4557=item --proxy-source [<string>] 4558 4559Specify the source address of the proxied connection. (Arg-Required, From-Prompt) 4560 4561=item --proxy-source-port [<string>] 4562 4563Specify the source port of the proxied connection. (Arg-Required, From-Prompt) 4564 4565=item --proxy-dest [<string>] 4566 4567Specify the destination address of the proxied connection. (Arg-Required, From-Prompt) 4568 4569=item --proxy-dest-port [<string>] 4570 4571Specify the destination port of the proxied connection. (Arg-Required, From-Prompt) 4572 4573=back 4574 4575=head1 DATA OPTIONS 4576 4577These options pertain to the contents for the DATA portion of the SMTP transaction. By default a very simple message is sent. If the C<--attach> or C<--attach-body> options are used, Swaks attempts to upgrade to a MIME message. 4578 4579=over 4 4580 4581=item -d, --data [<data-portion>] 4582 4583Use argument as the entire contents of DATA. 4584 4585If no argument is provided, user will be prompted to supply value. 4586 4587If the argument C<-> is provided the data will be read from C<STDIN> with no prompt. 4588 4589If the argument starts with C<@> it will be treated as a filename. If you would like to pass in an argument that starts with C<@> and isn't a filename, prefix the argument with an additional C<@>. For example, C<@file.txt> will force processing of F<file.txt>. C<@@data> will use the string '@data'. 4590 4591If the argument does not contain any literal (0x0a) or representative (0x5c, 0x6e or %NEWLINE%) newline characters, it will be treated as a filename. If the file is open-able, the contents of the file will be used as the data portion. If the file cannot be opened, Swaks will error and exit. The entire behavior described in this paragraph is deprecated and will be removed in a future release. Instead use a leading C<@> to explicitly set that the argument is a filename. 4592 4593Any other argument will be used as the DATA contents. 4594 4595The value can be on one single line, with C<\n> (ASCII 0x5c, 0x6e) representing where line breaks should be placed. Leading dots will be quoted. Closing dot is not required but is allowed. The default value for this option is C<Date: %DATE%\nTo: %TO_ADDRESS%\nFrom: %FROM_ADDRESS%\nSubject: test %DATE%\nMessage-Id: <%MESSAGEID%>\nX-Mailer: swaks v%SWAKS_VERSION% jetmore.org/john/code/swaks/\n%NEW_HEADERS%\n%BODY%\n>. 4596 4597Very basic token parsing is performed on the DATA portion. The following table shows the recognized tokens and their replacement values. (Arg-Required, From-Prompt, From-File) 4598 4599=over 4 4600 4601=item %FROM_ADDRESS% 4602 4603Replaced with the envelope-sender. 4604 4605=item %TO_ADDRESS% 4606 4607Replaced with the envelope-recipient(s). 4608 4609=item %DATE% 4610 4611Replaced with the current time in a format suitable for inclusion in the Date: header. Note this attempts to use the standard module L<POSIX> for timezone calculations. If this module is unavailable the date string will be in GMT. 4612 4613=item %MESSAGEID% 4614 4615Replaced with a message ID string suitable for use in a Message-Id header. The value for this token will remain consistent for the life of the process. 4616 4617=item %SWAKS_VERSION% 4618 4619Replaced with the version of the currently-running Swaks process. 4620 4621=item %NEW_HEADERS% 4622 4623Replaced with the contents of the C<--add-header> option. If C<--add-header> is not specified this token is simply removed. 4624 4625=item %BODY% 4626 4627Replaced with the value specified by the C<--body> option. See C<--body> for default. 4628 4629=item %NEWLINE% 4630 4631Replaced with carriage return, newline (0x0d, 0x0a). This is identical to using C<\n> (0x5c, 0x6e), but doesn't have the escaping concerns that the backslash can cause on the newline. 4632 4633=back 4634 4635=item -dab, --dump-as-body [<section>[,<section>[,...]]] 4636 4637If C<--dump-as-body> is used and no other option is used to change the default body of the message, the body is replaced with output similar to the output of what is provided by C<--dump>. C<--dump>'s initial program capability stanza is not displayed, and the "data" section is not included. Additionally, C<--dump> always includes passwords. By default C<--dump-as-body> does not include passwords, though this can be changed with C<--dump-as-body-shows-password>. C<--dump-as-body> takes the same arguments as C<--dump> except the SUPPORT and DATA arguments are not supported. (Arg-Optional) 4638 4639=item -dabsp, --dump-as-body-shows-password 4640 4641Cause C<--dump-as-body> to include plaintext passwords. This option is not recommended. This option implies C<--dump-as-body>. (Arg-None) 4642 4643=item --body [<body-specification>] 4644 4645Specify the body of the email. The default is "This is a test mailing". If no argument to C<--body> is given, prompt to supply one interactively. If C<-> is supplied, the body will be read from standard input. Arguments beginning with C<@> will be treated as filenames containing the body data to use (see C<--data> for more detail). 4646 4647If, after the above processing, the argument represents an open-able file, the content of that file is used as the body. This is deprecated behavior and will be removed in a future release. Instead use a leading C<@> to explicitly set that the argument is a filename. 4648 4649If the message is forced to MIME format (see C<--attach>) C<--body 'body text'> is the same as C<--attach-type text/plain --attach-body 'body text'>. See C<--attach-body> for details on creating a multipart/alternative body. (Arg-Required, From-Prompt, From-File) 4650 4651=item --attach [<attachment-specification>] 4652 4653When one or more C<--attach> option is supplied, the message is changed into a multipart/mixed MIME message. The arguments to C<--attach> are processed the same as C<--body> with respect to C<STDIN>, file contents, etc. C<--attach> can be supplied multiple times to create multiple attachments. By default, each attachment is attached as an application/octet-stream file. See C<--attach-type> for changing this behavior. 4654 4655If the contents of the attachment are provided via a file name, the MIME encoding will include that file name. See C<--attach-name> for more detail on file naming. 4656 4657It is legal for C<-> (C<STDIN>) to be specified as an argument multiple times (once for C<--body> and multiple times for C<--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. (Arg-Required, From-File) 4658 4659=item --attach-body [<body-specification>] 4660 4661This is a variation on C<--attach> that is specifically for the body part of the email. It behaves identically to C<--attach> in that it takes the same arguments and forces the creation of a MIME message. However, it is different in that the argument will always be the first MIME part in the message, no matter where in option processing order it is encountered. Additionally, C<--attach-body> options stack to allow creation of multipart/alternative bodies. For example, C<--attach-type text/plain --attach-body 'plain text body' --attach-type text/html --attach-body 'html body'> would create a multipart/alternative message body. (Arg-Required, From-File) 4662 4663=item --attach-type <mime-type> 4664 4665By default, content that gets MIME attached to a message with the C<--attach> option is encoded as application/octet-stream (except for the body, which is text/plain by default). C<--attach-type> changes the mime type for every C<--attach> option which follows it. It can be specified multiple times. The current MIME type gets reset to application/octet-stream between processing body parts and other parts. (Arg-Required) 4666 4667=item --attach-name [<name>] 4668 4669This option sets the filename that will be included in the MIME part created for the next C<--attach> option. If no argument is set for this option, it causes no filename information to be included for the next MIME part, even if Swaks could generate it from the local file name. (Arg-Optional) 4670 4671=item -ah, --add-header <header> 4672 4673This option allows headers to be added to the DATA. If C<%NEW_HEADERS%> is present in the DATA it is replaced with the argument to this option. If C<%NEW_HEADERS%> is not present, the argument is inserted between the first two consecutive newlines in the DATA (that is, it is inserted at the end of the existing headers). 4674 4675The option can either be specified multiple times or a single time with multiple headers separated by a literal C<\n> string. So, C<--add-header 'Foo: bar' --add-header 'Baz: foo'" and "--add-header 'Foo: bar\nBaz: foo'> end up adding the same two headers. (Arg-Required) 4676 4677=item --header <header-and-data>, --h-<header> <data> 4678 4679These options allow a way to change headers that already exist in the DATA. C<--header 'Subject: foo'> and C<--h-Subject foo> are equivalent. If the header does not already exist in the data then this argument behaves identically to C<--add-header>. However, if the header already exists it is replaced with the one specified. Negating the version of this option with the header name in the option (eg C<--no-header-Subject>) will remove all previously processed C<--header> options, not just the ones used for 'Subject'. (Arg-Required) 4680 4681=item -g 4682 4683This option is a direct alias to C<--data -> (read DATA from C<STDIN>). It is totally secondary to C<--data>. Any occurrence of C<--data> will cause C<-g> to be ignored. This option cannot be negated with the C<no-> prefix. This option is deprecated and will be removed in a future version of Swaks. (Arg-None, Deprecated) 4684 4685=item --no-data-fixup, -ndf 4686 4687This option forces Swaks to do no massaging of the DATA portion of the email. This includes token replacement, From_ stripping, trailing-dot addition, C<--body>/attachment inclusion, and any header additions. This option is only useful when used with C<--data>, since the internal default DATA portion uses tokens. (Arg-None) 4688 4689=item --no-strip-from, -nsf 4690 4691Don't strip the From_ line from the DATA portion, if present. (Arg-None) 4692 4693=back 4694 4695=head1 OUTPUT OPTIONS 4696 4697Swaks provides a transcript of its transactions to its caller (C<STDOUT>/C<STDERR>) by default. This transcript aims to be as faithful a representation as possible of the transaction though it does modify this output by adding informational prefixes to lines and by providing plaintext versions of TLS transactions 4698 4699The "informational prefixes" are referred to as transaction hints. These hints are initially composed of those marking lines that are output of Swaks itself, either informational or error messages, and those that indicate a line of data actually sent or received in a transaction. This table indicates the hints and their meanings: 4700 4701=over 4 4702 4703=item C<===> 4704 4705Indicates an informational line generated by Swaks. 4706 4707=item C<***> 4708 4709Indicates an error generated within Swaks. 4710 4711=item C<S< >-E<gt>> 4712 4713Indicates an expected line sent by Swaks to target server. 4714 4715=item C<S< >~E<gt>> 4716 4717Indicates a TLS-encrypted, expected line sent by Swaks to target server. 4718 4719=item C<**E<gt>> 4720 4721Indicates an unexpected line sent by Swaks to the target server. 4722 4723=item C<*~E<gt>> 4724 4725Indicates a TLS-encrypted, unexpected line sent by Swaks to target server. 4726 4727=item C<S< >E<gt>> 4728 4729Indicates a raw chunk of text sent by Swaks to a target server (see C<--show-raw-text>). There is no concept of "expected" or "unexpected" at this level. 4730 4731=item C<E<lt>-S< >> 4732 4733Indicates an expected line sent by target server to Swaks. 4734 4735=item C<E<lt>~S< >> 4736 4737Indicates a TLS-encrypted, expected line sent by target server to Swaks. 4738 4739=item C<E<lt>**> 4740 4741Indicates an unexpected line sent by target server to Swaks. 4742 4743=item C<E<lt>~*> 4744 4745Indicates a TLS-encrypted, unexpected line sent by target server to Swaks. 4746 4747=item C<E<lt>S< >> 4748 4749Indicates a raw chunk of text received by Swaks from a target server (see C<--show-raw-text>). There is no concept of "expected" or "unexpected" at this level. 4750 4751=back 4752 4753The following options control what and how output is displayed to the caller. 4754 4755=over 4 4756 4757=item -n, --suppress-data 4758 4759Summarizes the DATA portion of the SMTP transaction instead of printing every line. This option is very helpful, bordering on required, when using Swaks to send certain test emails. Emails with attachments, for instance, will quickly overwhelm a terminal if the DATA is not suppressed. (Arg-None) 4760 4761=item -stl, --show-time-lapse [i] 4762 4763Display time lapse between send/receive pairs. This option is most useful when L<Time::HiRes> is available, in which case the time lapse will be displayed in thousandths of a second. If L<Time::HiRes> is unavailable or "i" is given as an argument the lapse will be displayed in integer seconds only. (Arg-Optional) 4764 4765=item -nih, --no-info-hints 4766 4767Don't display the transaction hint for informational transactions. This is most useful when needing to copy some portion of the informational lines, for instance the certificate output from C<--tls-get-peer-cert>. (Arg-None) 4768 4769=item -nsh, --no-send-hints 4770 4771=item -nrh, --no-receive-hints 4772 4773=item -nth, --no-hints 4774 4775C<--no-send-hints> and C<--no-receive-hints> suppress the transaction hints from send and receive lines, respectively. This is often useful when copying some portion of the transaction for use elsewhere (for instance, C<--no-send-hints --hide-receive --hide-informational> is a useful way to get only the client-side commands for a given transaction). C<--no-hints> is identical to specifying both C<--no-send-hints> and C<--no-receive-hints>. (Arg-None) 4776 4777=item -raw, --show-raw-text 4778 4779This option will print a hex dump of raw data sent and received by Swaks. Each hex dump is the contents of a single read or write on the network. This should be identical to what is already being displayed (with the exception of the C<\r> characters being removed). This option is useful in seeing details when servers are sending lots of data in single packets, or breaking up individual lines into multiple packets. If you really need to go in depth in that area you're probably better with a packet sniffer, but this option is a good first step to seeing odd connection issues. (Arg-None) 4780 4781=item --output, --output-file <file-path> 4782 4783=item --output-file-stdout <file-path> 4784 4785=item --output-file-stderr <file-path> 4786 4787These options allow the user to send output to files instead of C<STDOUT>/C<STDERR>. The first option sends both to the same file. The arguments of C<&STDOUT> and C<&STDERR> are treated specially, referring to the "normal" file handles, so C<--output-file-stderr '&STDOUT'> would redirect C<STDERR> to C<STDOUT>. These options are honored for all output except C<--help> and C<--version>. (Arg-Required) 4788 4789=item -pp, --protect-prompt 4790 4791Don't echo user input on prompts that are potentially sensitive (right now only authentication password). Very specifically, any option which is marked 'Sensitive' and eventually prompts for an argument will do its best to mask that argument from being echoed. See also C<--auth-hide-password>. (Arg-None) 4792 4793=item -hr, --hide-receive 4794 4795Don't display lines sent from the remote server being received by Swaks. (Arg-None) 4796 4797=item -hs, --hide-send 4798 4799Don't display lines being sent by Swaks to the remote server. (Arg-None) 4800 4801=item -hi, --hide-informational 4802 4803Don't display non-error informational lines from Swaks itself. (Arg-None) 4804 4805=item -ha, --hide-all 4806 4807Do not display any content to the terminal. (Arg-None) 4808 4809=item -S, --silent [ 1 | 2 | 3 ] 4810 4811Cause Swaks to be silent. If no argument is given or if an argument of "1" is given, print no output unless/until an error occurs, after which all output is shown. If an argument of "2" is given, only print errors. If "3" is given, show no output ever. C<--silent> affects most output but not all. For instance, C<--help>, C<--version>, C<--dump>, and C<--dump-mail> are not affected. (Arg-Optional) 4812 4813=item --support 4814 4815Print capabilities and exit. Certain features require non-standard Perl modules. This option evaluates whether these modules are present and displays which functionality is available and which isn't, and which modules would need to be added to gain the missing functionality. (Arg-None) 4816 4817=item --dump-mail 4818 4819Cause Swaks to process all options to generate the message it would send, then print that message to C<STDOUT> instead of sending it. This output is identical to the "data" section of C<--dump>, except without the trailing dot. (Arg-None) 4820 4821=item --dump [<section>[,<section>[,...]]] 4822 4823This option causes Swaks to print the results of option processing, immediately before mail would have been sent. No mail will be sent when C<--dump> is used. Note that C<--dump> is a pure self-diagnosis tool and no effort is made or will ever be made to mask passwords in the C<--dump> output. If a section is provided as an argument to this option, only the requested section will be shown. Currently supported arguments are SUPPORT, APP, OUTPUT, TRANSPORT, PROTOCOL, XCLIENT, PROXY, TLS, AUTH, DATA, and ALL. If no argument is provided, all sections are displayed (Arg-Optional) 4824 4825=item --help 4826 4827Display this help information and exit. (Arg-None) 4828 4829=item --version 4830 4831Display version information and exit. (Arg-None) 4832 4833=back 4834 4835=head1 DEPRECATIONS 4836 4837The following features are deprecated and will be removed in a future version of Swaks 4838 4839=over 4 4840 4841=item -g option 4842 4843Will be removed no sooner than November 1, 2021. 4844 4845The -g option is currently a less-good alias to C<--data ->. Any uses of C<-g> should be able to be directly migrated to C<--data -> instead. 4846 4847=item auto-filename detection 4848 4849Will be removed no sooner than November 1, 2021. 4850 4851The C<--data>, C<--body>, C<--attach>, and C<--attach-body> options currently will attempt to distinguish between an argument that is the actual value to use vs. an argument that represents a file containing the data to use. This behavior has been superseded by prefixing an argument to these options with C<@> to explicitly indicate that the argument indicates a file. Any uses of providing a filename to one of these options should be moved to using C<@> to indicate a filename is being used. 4852 4853=back 4854 4855=head1 PORTABILITY 4856 4857=over 4 4858 4859=item OPERATING SYSTEMS 4860 4861This 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. 4862 4863This 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. 4864 4865Because 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. 4866 4867=item MAIL SERVERS 4868 4869This program was almost exclusively developed against Exim mail servers. It has been used casually by the author, though not thoroughly tested, with Sendmail, Smail, Exchange, Oracle Collaboration Suite, qpsmtpd, and Communigate. Because all functionality in Swaks is based on known standards it should work with any fairly modern mail server. If a problem is found, please alert the author at the address below. 4870 4871=back 4872 4873=head1 ENVIRONMENT VARIABLES 4874 4875=over 4 4876 4877=item LOGNAME 4878 4879If Swaks must create a sender address, C<$LOGNAME> is used as the message local-part if it is set, and unless C<--force-getpwuid> is used. 4880 4881=item SWAKS_HOME 4882 4883Used when searching for a F<.swaksrc> configuration file. See OPTION PROCESSING -> L</"CONFIGURATION FILES"> above. 4884 4885=item SWAKS_OPT_* 4886 4887Environment variable prefix used to specify Swaks options from environment variables. See OPTION PROCESSING -> L</"CONFIGURATION ENVIRONMENT VARIABLES"> above. 4888 4889=back 4890 4891=head1 EXIT CODES 4892 4893=over 4 4894 4895=item Z<>0 4896 4897no errors occurred 4898 4899=item Z<>1 4900 4901error parsing command line options 4902 4903=item Z<>2 4904 4905error connecting to remote server 4906 4907=item Z<>3 4908 4909unknown connection type 4910 4911=item Z<>4 4912 4913while running with connection type of "pipe", fatal problem writing to or reading from the child process 4914 4915=item Z<>5 4916 4917while running with connection type of "pipe", child process died unexpectedly. This can mean that the program specified with C<--pipe> doesn't exist. 4918 4919=item Z<>6 4920 4921Connection 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. 4922 4923=item Z<>10 4924 4925error in prerequisites (needed module not available) 4926 4927=item Z<>21 4928 4929error reading initial banner from server 4930 4931=item Z<>22 4932 4933error in HELO transaction 4934 4935=item Z<>23 4936 4937error in MAIL transaction 4938 4939=item Z<>24 4940 4941no RCPTs accepted 4942 4943=item Z<>25 4944 4945server returned error to DATA request 4946 4947=item Z<>26 4948 4949server did not accept mail following data 4950 4951=item Z<>27 4952 4953server returned error after normal-session quit request 4954 4955=item Z<>28 4956 4957error in AUTH transaction 4958 4959=item Z<>29 4960 4961error in TLS transaction 4962 4963=item Z<>30 4964 4965PRDR requested/required but not advertised 4966 4967=item Z<>32 4968 4969error in EHLO following TLS negotiation 4970 4971=item Z<>33 4972 4973error in XCLIENT transaction 4974 4975=item Z<>34 4976 4977error in EHLO following XCLIENT 4978 4979=item Z<>35 4980 4981error in PROXY option processing 4982 4983=item Z<>36 4984 4985error sending PROXY banner 4986 4987=back 4988 4989=head1 ABOUT THE NAME 4990 4991The name "Swaks" is a (sort-of) acronym for "SWiss Army Knife SMTP". It was chosen to be fairly distinct and pronounceable. While "Swaks" is unique as the name of a software package, it has some other, non-software meanings. Please send in other uses of "swak" or "swaks" for inclusion. 4992 4993=over 4 4994 4995=item "Sealed With A Kiss" 4996 4997SWAK/SWAKs turns up occasionally on the internet with the meaning "with love". 4998 4999=item bad / poor / ill (Afrikaans) 5000 5001Seen in the headline "SA se bes en swaks gekledes in 2011", which was translated as "best and worst dressed" by native speakers. Google Translate doesn't like "swaks gekledes", but it will translate "swak" as "poor" and "swak geklede" as "ill-dressed". 5002 5003=back 5004 5005=head1 LICENSE 5006 5007This program is free software; you can redistribute it and/or modify 5008it under the terms of the GNU General Public License as published by 5009the Free Software Foundation; either version 2 of the License, or 5010(at your option) any later version. 5011 5012This program is distributed in the hope that it will be useful, 5013but WITHOUT ANY WARRANTY; without even the implied warranty of 5014MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 5015GNU General Public License for more details. 5016 5017You should have received a copy of the GNU General Public License 5018along with this program; if not, write to the Free Software 5019Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. 5020 5021=head1 CONTACT INFORMATION 5022 5023General contact, questions, patches, requests, etc to proj-swaks@jetmore.net. 5024 5025Change logs, this help, and the latest version are found at L<http://www.jetmore.org/john/code/swaks/>. 5026 5027Swaks is crafted with love by John Jetmore from the cornfields of Indiana, United States of America. 5028 5029=head1 NOTIFICATIONS 5030 5031=over 4 5032 5033=item Email 5034 5035updates-swaks@jetmore.net 5036 5037If 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. There will not be a response to your email. 5038 5039=item Website 5040 5041L<http://www.jetmore.org/john/blog/c/swaks/> 5042 5043=item RSS Feed 5044 5045L<http://www.jetmore.org/john/blog/c/swaks/feed/> 5046 5047=item Twitter 5048 5049<http://twitter.com/SwaksSMTP> 5050 5051=back 5052 5053=cut 5054__END__ 5055