src/util/mailtest

   1 #!/usr/bin/perl
   2 #
   3 ###############################################################
   4 ###############################################################
   5
   6 use strict;
   7
   8 use Net::SMTP;
   9 #use IO::Socket::SSL qw( SSL_ERROR );
  10 use Net::Domain qw(hostfqdn);
  11 use Getopt::Long qw(:config default bundling no_ignore_case auto_version);
  12 use Pod::Usage;
  13 use Net::Cmd;
  14 use Data::Dumper;
  15
  16 our @ISA = qw(Net::Cmd);
  17
  18 ###############################################################
  19 ###############################################################
  20
  21 my ($smtp,$optsin,$opt,$mess,$rcpt,@headers,$finished_header,$ofh);
  22 $main::VERSION = '1.2.2';
  23
  24 $optsin = {
  25     'body|b'                    => \&optset,
  26     'debug|d'                   => \&optset,
  27     'ehlo|helo|m=s'             => \&optset,
  28     'rcptto|recipient|r=s'      => \&optset,
  29     'host|h=s'                  => \&optset,
  30     'from822|u=s'               => \&optset,
  31     'vrfy|v'                    => \&optset,
  32     'expn|e'                    => \&optset,
  33     'mailfrom|from821|from|f=s' => \&optset,
  34     'port|p=i'                  => \&optset,
  35     'wellknown|w=s'             => \&optset,
  36     'output|W=s'                => \&optset,
  37     'include_options|O'         => \&optset,
  38     'include_headers|H'         => \&optset,
  39     'bounce|B'                  => \&optset,
  40     'tls|S'                     => \&optset,
  41     'nostarttls|s'              => \&optset,
  42     'stricttls|strict_tls'      => \&optset,
  43     'sslargs|tlsargs=s'         => \&optset,
  44     'verbose'                   => \&optset,
  45     'help'                      => \&optset,
  46     'man'                       => \&optset,
  47 };
  48 map { my $t = $_; $t =~ s/\|.*//; $opt->{$t} = undef; } keys %$optsin;
  49 GetOptions( %$optsin ) or pod2usage(2);
  50 pod2usage(1) if $opt->{'help'};
  51 pod2usage(-exitval => 0, -verbose => 2) if $opt->{'man'};
  52
  53 print _Dumper($opt, 'Options')
  54     if $opt->{'debug'};
  55
  56 ###############################################################
  57 ###############################################################
  58 ##
  59 ## parameter checking
  60 ##
  61 ###############################################################
  62 ###############################################################
  63
  64 bail( 1, "Host(--host) must be provided" )
  65     if !$opt->{'host'};
  66
  67 $opt->{'port'} = $opt->{'tls'} ? 465 : 25
  68     if ! $opt->{'port'};
  69
  70 if (!$opt->{'ehlo'})
  71 {
  72     $opt->{'ehlo'} = hostfqdn();
  73     fret( "Machine set to $opt->{'ehlo'}" ) if $opt->{'debug'};
  74 }
  75 if (!$opt->{'mailfrom'} && !$opt->{'bounce'})
  76 {
  77     $opt->{'mailfrom'} = $ENV{USER}. "@". $opt->{'ehlo'};
  78     fret( "MAIL FROM set to $opt->{'mailfrom'}" ) if $opt->{'debug'};
  79 }
  80 if (!$opt->{'from822'})
  81 {
  82     $opt->{'from822'} = $opt->{'mailfrom'};
  83     fret( "From: set to $opt->{'from822'}" ) if $opt->{'debug'};
  84 }
  85 if ($opt->{'bounce'})
  86 {
  87     $opt->{'mailfrom'} = "";
  88     $opt->{'from822'} = 'mailer-daemon@'. hostfqdn();
  89     fret( "MAIL FROM set to $opt->{'mailfrom'}", "From: set to $opt->{'from822'}" ) if $opt->{'debug'};
  90 }
  91
  92 bail( 1, "EXPN or VRFY cannot be used without a recipient" )
  93     if ($opt->{'expn'} || $opt->{'vrfy'}) && ! $opt->{'rcptto'};
  94
  95 bail( 1, "Either a recipient or well-known resource must be specified" )
  96     if ! $opt->{'wellknown'} && ! $opt->{'rcptto'};
  97
  98 bail( 1, "Only one of recipient or well-known resource can be specified" )
  99     if $opt->{'wellknown'} && $opt->{'rcptto'};
 100
 101 if ( $opt->{'sslargs'} )
 102 {
 103     my @p = split /[=,]/, $opt->{'sslargs'};
 104     $opt->{'sslparams'} = \@p;
 105 }
 106 else
 107 {
 108     $opt->{'sslparams'} = [ 'SSL_verify_mode', $opt->{'stricttls'} ? 1 : 0 ];
 109 }
 110 fret( _Dumper( $opt->{'sslparams'}, 'sslparams' ) )
 111     if $opt->{'debug'} && ( $opt->{'tls'} || ! $opt->{'nostarttls'} );
 112
 113 ###############################################################
 114 ###############################################################
 115 ##
 116 ## parameter checking complete. now onto operations
 117 ##
 118 ##
 119 ###############################################################
 120 ###############################################################
 121
 122
 123
 124 $smtp= Net::SMTP->new(  $opt->{'host'},
 125                         Hello   => $opt->{'ehlo'},
 126                         Debug   => $opt->{'debug'},
 127                         ( $opt->{'tls'} ? ( 'SSL' => $opt->{'sslargs'} || 1 ) : () ),
 128                         Port    => $opt->{'port'},
 129                         );
 130 bail( 1, "Connection Failed: $@" )
 131     if !$smtp;
 132
 133 if (!$opt->{'nostarttls'})
 134 {
 135     bail( $smtp, 1, "Failed to STARTTLS - $@" )
 136         if ! $smtp->starttls( @{$opt->{'sslparams'}} );
 137
 138     fret( $smtp->message() )
 139         if $opt->{'verbose'};
 140 }
 141
 142 if ($opt->{'wellknown'})
 143 {
 144     bail( $smtp, 1, "Server does not support WELLKNOWN" )
 145         if ! $smtp->supports('WELLKNOWN');
 146
 147     my $e_wk = encode_xtext( $opt->{'wellknown'} );
 148
 149     bail( $smtp, 1, "Failed to WELLKNOWN - $e_wk", $smtp->message() )
 150         if ! ( $smtp->command( 'WELLKNOWN', $e_wk )->response() == CMD_OK );
 151
 152     fret( "Protocol violation. Code was OK, but not 250",   $smtp->code. " - ". $smtp->message )
 153         if $smtp->code ne '250';
 154
 155     $mess = $smtp->message;
 156     my ($info,$size);
 157     ($info,$mess) = split( /\n/, $mess, 2 );
 158     $info =~ /size=(\d+)/i;
 159     $size = $1 + 0;
 160     $mess = decode_xtext( $mess );
 161     fret( "Size mismatch on wellknown fetch", "Expected: ". $size, "Received: ". length($mess) )
 162         if length($mess) != $size;
 163
 164     if ( $opt->{'output'} )
 165     {
 166         # Output to named file
 167         #
 168         bail( $smtp, 1, "Unable to open file $opt->{'output'} for WELLKNOWN output - $!" )
 169             if ! ( $ofh = IO::File->new("> $opt->{'output'}") );
 170
 171         print $ofh $mess;
 172         $ofh->close;
 173     }
 174     else
 175     {
 176         # might be hazardous, output via pager
 177         print STDERR "$mess\n";
 178     }
 179 }
 180
 181 if ($opt->{'vrfy'})
 182 {
 183     $smtp->verify($opt->{'vrfy'});
 184     fret( $smtp->message() );
 185 }
 186
 187 if ($opt->{'expn'})
 188 {
 189     $smtp->expand($opt->{'expn'});
 190     fret( $smtp->message() );
 191 }
 192
 193 if ($opt->{'rcptto'})
 194 {
 195     bail( $smtp, 1, "MAIL FROM $opt->{'mailfrom'} failed", $@ )
 196         if ! $smtp->mail($opt->{'mailfrom'});
 197
 198     bail( $smtp, 1, "RCPT TO $opt->{'rcptto'} failed", $@ )
 199         if ! $smtp->to($opt->{'rcptto'});
 200
 201     # handle any recipients on command line
 202     while( $rcpt = shift @ARGV )
 203     {
 204         last if $rcpt eq '--';
 205         fret( "RCPT TO $rcpt failed", $@ )
 206             if ! $smtp->to($rcpt);
 207     }
 208
 209     bail( $smtp, 1, "Unable to set data mode", @_ )
 210         if ! $smtp->data();
 211
 212     if ($opt->{'body'})
 213     {
 214         push @headers, "Subject: Test Message\n";
 215         $smtp->datasend("From: $opt->{'from822'}\n");
 216         $smtp->datasend("To: $opt->{'rcptto'}\n");
 217         $smtp->datasend("Subject: Test Message\n");
 218         $smtp->datasend("\n");
 219         $smtp->datasend("This is a test message\n");
 220         $smtp->datasend("generated with mailtest\n");
 221     }else
 222     {
 223         while(<>)
 224         {
 225             if($finished_header==0)
 226             {
 227                 if (length($_)<=1)
 228                 {
 229                     $finished_header = 1;
 230                 }else
 231                 {
 232                     push @headers,"    ".$_;
 233                 }
 234             }
 235             $smtp->datasend("$_");
 236         }
 237     }
 238     if($opt->{'include_headers'} && @headers)
 239     {
 240         $smtp->datasend("\n Copy of headers follow....\n");
 241         foreach(@headers)
 242         {
 243             $smtp->datasend("$_");
 244         }
 245         $smtp->datasend("\n");
 246     }
 247     if($opt->{'include_options'})
 248     {
 249         $smtp->datasend("\n Copy of options follow....\n");
 250         $smtp->datasend("    SMTP HOST $opt->{'host'}\n");
 251         $smtp->datasend("    HELO $opt->{'ehlo'}\n");
 252         $smtp->datasend("    MAIL FROM: $opt->{'mailfrom'}\n");
 253         $smtp->datasend("    RCPT TO: $opt->{'rcptto'}\n\n");
 254     }
 255     fret( "dataend failed", $@ )
 256         if ! $smtp->dataend();
 257 }
 258 $smtp->quit();
 259
 260 exit;
 261
 262 ##############################################################
 263 ##############################################################
 264
 265 sub
 266 optset
 267 {
 268     my $n = shift;
 269     my $v = shift;
 270     #print STDERR "Setting $n to $v\n";
 271     $opt->{$n->{'name'}} = $v;
 272 }
 273
 274 sub
 275 decode_xtext
 276 {
 277     my $mess = shift;
 278     $mess =~ s/[\n\r]//g;
 279     $mess =~ s/\+([0-9a-fA-F]{2})/chr(hex($1))/ge;
 280     return $mess;
 281 }
 282
 283 sub
 284 encode_xtext
 285 {
 286     my $mess = shift;
 287     $mess =~ s/([^!-*,-<>-~])/'+'.uc(unpack('H*', $1))/eg;
 288     return $mess;
 289 }
 290
 291 sub
 292 _Dumper
 293 {
 294     return Data::Dumper->Dump( [$_[0]], [$_[1] || 'VAR1'] );
 295 }
 296
 297 sub
 298 fret
 299 {
 300     map { print STDERR $_,"\n"; } @_;
 301 }
 302
 303 sub
 304 bail
 305 {
 306     shift->quit
 307         if ref($_[0]);
 308     my $rc = shift;
 309     fret( @_ );
 310     exit $rc;
 311 }
 312
 313 ##############################################################
 314 ##############################################################
 315
 316 __END__
 317
 318 =head1 NAME
 319
 320 mailtest - Simple SMTP sending for diagnostics
 321
 322 =head1 SYNOPSIS
 323
 324 mailtest --host host.example.com --rcptto recipient@example.com [ send_options ... ] [ additional recipients ...]
 325
 326
 327 Options:
 328   --help
 329                 brief help message
 330   --debug
 331                 enable debugging
 332
 333   --host host
 334                 host to connect to
 335   --rcptto recipient
 336                 recipient for message
 337
 338   --helo machine
 339                 machine name for EHLO
 340
 341   --vrfy        request VRFY of recipient
 342   --expn        request EXPN of recipient
 343
 344   --mailfrom from
 345                 use as MAIL FROM value
 346   --from822 from
 347                 content From:
 348
 349   --port port
 350                 port to connect to
 351
 352   --body            generate body
 353   --include_options
 354                 include Options in body
 355   --include_headers
 356                 include generated headers in body
 357
 358   --tls         perform TLS on connect
 359   --nostarttls  do no attempt STARTTLS
 360   --stricttls   Enable strict verification on TLS connection
 361
 362   --tlsargs arg=value[,arg=value]
 363                 Explicitly define TLS options.
 364
 365   --bounce      sending as bounce (<>)
 366
 367   --wellknown path
 368                 well-known path
 369   --output file
 370                 Output file to receive well-known data
 371
 372 =head1 OPTIONS
 373
 374 =over 8
 375
 376
 377 =item B<--help>
 378
 379 Print a brief help message and exits.
 380
 381 =item B<-d, --debug>
 382
 383 Enables debugging, outpus additional information whilst processing requests.
 384
 385 =item B<-h, --host>=I<host>
 386
 387 Specifies the host to connect to. Must be specified and must be IP-resolvable.
 388
 389 =item B<-m, --ehlo>=I<machine>
 390
 391 Specified the machine name to use as the B<EHLO> value. Defaults to the fully-qualified name of the host running the command.
 392
 393 =item B<-r, --rcptto>=I<recipient>
 394
 395 Specifies the recipient of message. This is used as the B<RCPT TO> value.
 396
 397 =item B<-v, --vrfy>
 398
 399 Uses the I<recipient> parameter for the value in a B<VRFY> request. This disables the sending of an email.
 400
 401 =item B<-e, --expn>
 402
 403 Uses the I<recipient> parameter for the value in an B<EXPN> request. This disables the sending of an email.
 404
 405 =item B<-f, --mailfrom>=I<from_address>
 406
 407 Specified the value to use in the B<MAIL FROM> command. Defaults to the current username at the FQDN of the machine B<-m> unless the B<-B> option is used.
 408
 409 =item B<-u, --from822>=I<from_user>
 410
 411 Specified the value to use in the message headers. Defaults to the B<-f> I<from_address> value unless the B<-B> option is used.
 412
 413 =item B<-B, --bounce>
 414
 415 Replace the B<--mailfrom> I<from_address> with B<\<\>> and the B<--from833> I<from_user> with B<mailer-daemon@host> where the host is the value of B<--ehlo> I<machine>
 416
 417 =item B<-p, --port>=I<port>
 418
 419 Specified the port to connect to on the specified host. Defaults to port 25 unless B<-S> is given in which case it defaults to 465.
 420
 421 =item B<-S, --tls>
 422
 423 Specifies that TLS be used directly on the connection prior to any SMTP commands. Changes the connection port to 465 unless it has been explicitly provided. Disables any attempts at B<STARTTLS>.
 424
 425 =item B<-s, --nostarttls>
 426
 427 Disables attempting STARTTLS if offered. Disabled by use of B<-S>.
 428
 429 =item B<--stricttls>
 430
 431 Enables strict verification of the TLS connection. Sets the underlying SSL option B<SSL_verify_mode> to 1/SSL_VERIFY_PEER rather than 0/SSL_VERIFY_NONE. Since the aim of this tool is to test the SMTP protocol behaviour and not the TLS behaviour the decision was made to default the B<SSL_verify_mode> to 0/SSL_VERIFY_NONE.
 432
 433 =item B<--sslargs>=argname=argvalue[,argname=argvalue...]
 434
 435 Allow full control over underlying SSL options. Overrides B<--stricttls>. See the documentation for B<IO::Socket::SSL> for further details.
 436
 437     --sslargs SSL_verifycn_name=certname.example.com
 438
 439 =item B<-b, --body>
 440
 441 Generate a body for the message being sent.
 442
 443 =item B<-O, --include-options>
 444
 445 Include details of options used in the message body.
 446
 447 =item B<-H, --include-headers>
 448
 449 Include a copy of the generated headers in the message body.
 450
 451 =item B<-w, --wellknown>=I<well-known-path>
 452
 453 Provides the path value for a B<WELLKNOWN> command.
 454
 455 =item B<-W, --output>=I<output_file>
 456
 457 Provides the output file where the B<WELLKNOWN> data should be stored.
 458
 459 =back
 460
 461 =head1 DESCRIPTION
 462
 463 B<mailtest> is a simple utility for testing SMTP connections.
 464 It is designed to debug endpoints and not for full email generation.
 465
 466 It support a number of basic operations, SEND, VRFY, EXPN, WELLKNOWN.
 467
 468 =head1 COMPATIBILITY
 469
 470 C<mailtest> only requires modules that should be in all normal distributions.
 471
 472 =head1 AUTHOR
 473
 474 Bernard Quatermass <bernardq@exim.org>
 475
 476 =head1 COPYRIGHT AND LICENSE
 477
 478 This software is Copyright (c) 2008,2020,2024 by Bernard Quatermass.
 479
 480
 481 =cut
 482
 483 ###############################################################
 484 # vi: sw=4 et
 485 # End of File
 486 ###############################################################