+#!/usr/bin/perl
+#
+###############################################################
+###############################################################
+
+use strict;
+
+use Net::SMTP;
+#use IO::Socket::SSL qw( SSL_ERROR );
+use Net::Domain qw(hostfqdn);
+use Getopt::Long qw(:config default bundling no_ignore_case auto_version);
+use Pod::Usage;
+use Net::Cmd;
+use Data::Dumper;
+
+our @ISA = qw(Net::Cmd);
+
+###############################################################
+###############################################################
+
+my ($smtp,$optsin,$opt,$mess,$rcpt,@headers,$finished_header,$ofh);
+$main::VERSION = '1.2.2';
+
+$optsin = {
+ 'body|b' => \&optset,
+ 'debug|d' => \&optset,
+ 'ehlo|helo|m=s' => \&optset,
+ 'rcptto|recipient|r=s' => \&optset,
+ 'host|h=s' => \&optset,
+ 'from822|u=s' => \&optset,
+ 'vrfy|v' => \&optset,
+ 'expn|e' => \&optset,
+ 'mailfrom|from821|from|f=s' => \&optset,
+ 'port|p=i' => \&optset,
+ 'wellknown|w=s' => \&optset,
+ 'output|W=s' => \&optset,
+ 'include_options|O' => \&optset,
+ 'include_headers|H' => \&optset,
+ 'bounce|B' => \&optset,
+ 'tls|S' => \&optset,
+ 'nostarttls|s' => \&optset,
+ 'stricttls|strict_tls' => \&optset,
+ 'sslargs|tlsargs=s' => \&optset,
+ 'verbose' => \&optset,
+ 'help' => \&optset,
+ 'man' => \&optset,
+};
+map { my $t = $_; $t =~ s/\|.*//; $opt->{$t} = undef; } keys %$optsin;
+GetOptions( %$optsin ) or pod2usage(2);
+pod2usage(1) if $opt->{'help'};
+pod2usage(-exitval => 0, -verbose => 2) if $opt->{'man'};
+
+print _Dumper($opt, 'Options')
+ if $opt->{'debug'};
+
+###############################################################
+###############################################################
+##
+## parameter checking
+##
+###############################################################
+###############################################################
+
+bail( 1, "Host(--host) must be provided" )
+ if !$opt->{'host'};
+
+$opt->{'port'} = $opt->{'tls'} ? 465 : 25
+ if ! $opt->{'port'};
+
+if (!$opt->{'ehlo'})
+{
+ $opt->{'ehlo'} = hostfqdn();
+ fret( "Machine set to $opt->{'ehlo'}" ) if $opt->{'debug'};
+}
+if (!$opt->{'mailfrom'} && !$opt->{'bounce'})
+{
+ $opt->{'mailfrom'} = $ENV{USER}. "@". $opt->{'ehlo'};
+ fret( "MAIL FROM set to $opt->{'mailfrom'}" ) if $opt->{'debug'};
+}
+if (!$opt->{'from822'})
+{
+ $opt->{'from822'} = $opt->{'mailfrom'};
+ fret( "From: set to $opt->{'from822'}" ) if $opt->{'debug'};
+}
+if ($opt->{'bounce'})
+{
+ $opt->{'mailfrom'} = "";
+ $opt->{'from822'} = 'mailer-daemon@'. hostfqdn();
+ fret( "MAIL FROM set to $opt->{'mailfrom'}", "From: set to $opt->{'from822'}" ) if $opt->{'debug'};
+}
+
+bail( 1, "EXPN or VRFY cannot be used without a recipient" )
+ if ($opt->{'expn'} || $opt->{'vrfy'}) && ! $opt->{'rcptto'};
+
+bail( 1, "Either a recipient or well-known resource must be specified" )
+ if ! $opt->{'wellknown'} && ! $opt->{'rcptto'};
+
+bail( 1, "Only one of recipient or well-known resource can be specified" )
+ if $opt->{'wellknown'} && $opt->{'rcptto'};
+
+if ( $opt->{'sslargs'} )
+{
+ my @p = split /[=,]/, $opt->{'sslargs'};
+ $opt->{'sslparams'} = \@p;
+}
+else
+{
+ $opt->{'sslparams'} = [ 'SSL_verify_mode', $opt->{'stricttls'} ? 1 : 0 ];
+}
+fret( _Dumper( $opt->{'sslparams'}, 'sslparams' ) )
+ if $opt->{'debug'} && ( $opt->{'tls'} || ! $opt->{'nostarttls'} );
+
+###############################################################
+###############################################################
+##
+## parameter checking complete. now onto operations
+##
+##
+###############################################################
+###############################################################
+
+
+
+$smtp= Net::SMTP->new( $opt->{'host'},
+ Hello => $opt->{'ehlo'},
+ Debug => $opt->{'debug'},
+ ( $opt->{'tls'} ? ( 'SSL' => $opt->{'sslargs'} || 1 ) : () ),
+ Port => $opt->{'port'},
+ );
+bail( 1, "Connection Failed: $@" )
+ if !$smtp;
+
+if (!$opt->{'nostarttls'})
+{
+ bail( $smtp, 1, "Failed to STARTTLS - $@" )
+ if ! $smtp->starttls( @{$opt->{'sslparams'}} );
+
+ fret( $smtp->message() )
+ if $opt->{'verbose'};
+}
+
+if ($opt->{'wellknown'})
+{
+ bail( $smtp, 1, "Server does not support WELLKNOWN" )
+ if ! $smtp->supports('WELLKNOWN');
+
+ my $e_wk = encode_xtext( $opt->{'wellknown'} );
+
+ bail( $smtp, 1, "Failed to WELLKNOWN - $e_wk", $smtp->message() )
+ if ! ( $smtp->command( 'WELLKNOWN', $e_wk )->response() == CMD_OK );
+
+ fret( "Protocol violation. Code was OK, but not 250", $smtp->code. " - ". $smtp->message )
+ if $smtp->code ne '250';
+
+ $mess = $smtp->message;
+ my ($info,$size);
+ ($info,$mess) = split( /\n/, $mess, 2 );
+ $info =~ /size=(\d+)/i;
+ $size = $1 + 0;
+ $mess = decode_xtext( $mess );
+ fret( "Size mismatch on wellknown fetch", "Expected: ". $size, "Received: ". length($mess) )
+ if length($mess) != $size;
+
+ if ( $opt->{'output'} )
+ {
+ # Output to named file
+ #
+ bail( $smtp, 1, "Unable to open file $opt->{'output'} for WELLKNOWN output - $!" )
+ if ! ( $ofh = IO::File->new("> $opt->{'output'}") );
+
+ print $ofh $mess;
+ $ofh->close;
+ }
+ else
+ {
+ # might be hazardous, output via pager
+ print STDERR "$mess\n";
+ }
+}
+
+if ($opt->{'vrfy'})
+{
+ $smtp->verify($opt->{'vrfy'});
+ fret( $smtp->message() );
+}
+
+if ($opt->{'expn'})
+{
+ $smtp->expand($opt->{'expn'});
+ fret( $smtp->message() );
+}
+
+if ($opt->{'rcptto'})
+{
+ bail( $smtp, 1, "MAIL FROM $opt->{'mailfrom'} failed", $@ )
+ if ! $smtp->mail($opt->{'mailfrom'});
+
+ bail( $smtp, 1, "RCPT TO $opt->{'rcptto'} failed", $@ )
+ if ! $smtp->to($opt->{'rcptto'});
+
+ # handle any recipients on command line
+ while( $rcpt = shift @ARGV )
+ {
+ last if $rcpt eq '--';
+ fret( "RCPT TO $rcpt failed", $@ )
+ if ! $smtp->to($rcpt);
+ }
+
+ bail( $smtp, 1, "Unable to set data mode", @_ )
+ if ! $smtp->data();
+
+ if ($opt->{'body'})
+ {
+ push @headers, "Subject: Test Message\n";
+ $smtp->datasend("From: $opt->{'from822'}\n");
+ $smtp->datasend("To: $opt->{'rcptto'}\n");
+ $smtp->datasend("Subject: Test Message\n");
+ $smtp->datasend("\n");
+ $smtp->datasend("This is a test message\n");
+ $smtp->datasend("generated with mailtest\n");
+ }else
+ {
+ while(<>)
+ {
+ if($finished_header==0)
+ {
+ if (length($_)<=1)
+ {
+ $finished_header = 1;
+ }else
+ {
+ push @headers," ".$_;
+ }
+ }
+ $smtp->datasend("$_");
+ }
+ }
+ if($opt->{'include_headers'} && @headers)
+ {
+ $smtp->datasend("\n Copy of headers follow....\n");
+ foreach(@headers)
+ {
+ $smtp->datasend("$_");
+ }
+ $smtp->datasend("\n");
+ }
+ if($opt->{'include_options'})
+ {
+ $smtp->datasend("\n Copy of options follow....\n");
+ $smtp->datasend(" SMTP HOST $opt->{'host'}\n");
+ $smtp->datasend(" HELO $opt->{'ehlo'}\n");
+ $smtp->datasend(" MAIL FROM: $opt->{'mailfrom'}\n");
+ $smtp->datasend(" RCPT TO: $opt->{'rcptto'}\n\n");
+ }
+ fret( "dataend failed", $@ )
+ if ! $smtp->dataend();
+}
+$smtp->quit();
+
+exit;
+
+##############################################################
+##############################################################
+
+sub
+optset
+{
+ my $n = shift;
+ my $v = shift;
+ #print STDERR "Setting $n to $v\n";
+ $opt->{$n->{'name'}} = $v;
+}
+
+sub
+decode_xtext
+{
+ my $mess = shift;
+ $mess =~ s/[\n\r]//g;
+ $mess =~ s/\+([0-9a-fA-F]{2})/chr(hex($1))/ge;
+ return $mess;
+}
+
+sub
+encode_xtext
+{
+ my $mess = shift;
+ $mess =~ s/([^!-*,-<>-~])/'+'.uc(unpack('H*', $1))/eg;
+ return $mess;
+}
+
+sub
+_Dumper
+{
+ return Data::Dumper->Dump( [$_[0]], [$_[1] || 'VAR1'] );
+}
+
+sub
+fret
+{
+ map { print STDERR $_,"\n"; } @_;
+}
+
+sub
+bail
+{
+ shift->quit
+ if ref($_[0]);
+ my $rc = shift;
+ fret( @_ );
+ exit $rc;
+}
+
+##############################################################
+##############################################################
+
+__END__
+
+=head1 NAME
+
+mailtest - Simple SMTP sending for diagnostics
+
+=head1 SYNOPSIS
+
+mailtest --host host.example.com --rcptto recipient@example.com [ send_options ... ] [ additional recipients ...]
+
+
+Options:
+ --help
+ brief help message
+ --debug
+ enable debugging
+
+ --host host
+ host to connect to
+ --rcptto recipient
+ recipient for message
+
+ --helo machine
+ machine name for EHLO
+
+ --vrfy request VRFY of recipient
+ --expn request EXPN of recipient
+
+ --mailfrom from
+ use as MAIL FROM value
+ --from822 from
+ content From:
+
+ --port port
+ port to connect to
+
+ --body generate body
+ --include_options
+ include Options in body
+ --include_headers
+ include generated headers in body
+
+ --tls perform TLS on connect
+ --nostarttls do no attempt STARTTLS
+ --stricttls Enable strict verification on TLS connection
+
+ --tlsargs arg=value[,arg=value]
+ Explicitly define TLS options.
+
+ --bounce sending as bounce (<>)
+
+ --wellknown path
+ well-known path
+ --output file
+ Output file to receive well-known data
+
+=head1 OPTIONS
+
+=over 8
+
+
+=item B<--help>
+
+Print a brief help message and exits.
+
+=item B<-d, --debug>
+
+Enables debugging, outpus additional information whilst processing requests.
+
+=item B<-h, --host>=I<host>
+
+Specifies the host to connect to. Must be specified and must be IP-resolvable.
+
+=item B<-m, --ehlo>=I<machine>
+
+Specified the machine name to use as the B<EHLO> value. Defaults to the fully-qualified name of the host running the command.
+
+=item B<-r, --rcptto>=I<recipient>
+
+Specifies the recipient of message. This is used as the B<RCPT TO> value.
+
+=item B<-v, --vrfy>
+
+Uses the I<recipient> parameter for the value in a B<VRFY> request. This disables the sending of an email.
+
+=item B<-e, --expn>
+
+Uses the I<recipient> parameter for the value in an B<EXPN> request. This disables the sending of an email.
+
+=item B<-f, --mailfrom>=I<from_address>
+
+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.
+
+=item B<-u, --from822>=I<from_user>
+
+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.
+
+=item B<-B, --bounce>
+
+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>
+
+=item B<-p, --port>=I<port>
+
+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.
+
+=item B<-S, --tls>
+
+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>.
+
+=item B<-s, --nostarttls>
+
+Disables attempting STARTTLS if offered. Disabled by use of B<-S>.
+
+=item B<--stricttls>
+
+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.
+
+=item B<--sslargs>=argname=argvalue[,argname=argvalue...]
+
+Allow full control over underlying SSL options. Overrides B<--stricttls>. See the documentation for B<IO::Socket::SSL> for further details.
+
+ --sslargs SSL_verifycn_name=certname.example.com
+
+=item B<-b, --body>
+
+Generate a body for the message being sent.
+
+=item B<-O, --include-options>
+
+Include details of options used in the message body.
+
+=item B<-H, --include-headers>
+
+Include a copy of the generated headers in the message body.
+
+=item B<-w, --wellknown>=I<well-known-path>
+
+Provides the path value for a B<WELLKNOWN> command.
+
+=item B<-W, --output>=I<output_file>
+
+Provides the output file where the B<WELLKNOWN> data should be stored.
+
+=back
+
+=head1 DESCRIPTION
+
+B<mailtest> is a simple utility for testing SMTP connections.
+It is designed to debug endpoints and not for full email generation.
+
+It support a number of basic operations, SEND, VRFY, EXPN, WELLKNOWN.
+
+=head1 COMPATIBILITY
+
+C<mailtest> only requires modules that should be in all normal distributions.
+
+=head1 AUTHOR
+
+Bernard Quatermass <bernardq@exim.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is Copyright (c) 2008,2020,2024 by Bernard Quatermass.
+
+
+=cut
+
+###############################################################
+# vi: sw=4 et
+# End of File
+###############################################################
git://git.exim.org / exim.git / commitdiff