From 1d3aa3540da1a751c047e84fbc5dca793e411b2e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= Date: Wed, 21 Mar 2018 13:48:53 +0100 Subject: [PATCH 2/4] added tests for Net::SMTP SSL, save arguments in Net::SMTP to apply them on starttls MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Ported to Net::SMTP 2.31 as found in Perl 5.16.3 from libnet upstream: commit 34436780081aa8793b16f51864bce42a7cdd7e8b Author: Steffen Ullrich Date: Fri May 16 21:55:20 2014 +0200 added tests for Net::SMTP SSL and IPv6, save arguments in Net::SMTP to apply them on starttls IPv6 support excluded. Check for IO::Socket::SSL version removed because we have default sane default CA list since perl-IO-Socket-SSL-1.94-7.el7. Signed-off-by: Petr Písař --- MANIFEST | 1 + cpan/libnet/Net/SMTP.pm | 6 ++- cpan/libnet/t/smtp_ssl.t | 120 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 126 insertions(+), 1 deletion(-) create mode 100644 cpan/libnet/t/smtp_ssl.t diff --git a/MANIFEST b/MANIFEST index b649ddb..aa117d3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1456,6 +1456,7 @@ cpan/libnet/t/libnet_t.pl libnet cpan/libnet/t/netrc.t libnet cpan/libnet/t/nntp.t libnet cpan/libnet/t/require.t libnet +cpan/libnet/t/smtp_ssl.t libnet cpan/libnet/t/smtp.t libnet cpan/libnet/t/time.t libnet cpan/List-Util/Changes Util extension diff --git a/cpan/libnet/Net/SMTP.pm b/cpan/libnet/Net/SMTP.pm index 6143990..7dbf3df 100644 --- a/cpan/libnet/Net/SMTP.pm +++ b/cpan/libnet/Net/SMTP.pm @@ -70,6 +70,7 @@ sub new { return undef unless defined $obj; + ${*$obj}{'net_smtp_arg'} = \%arg; if ($arg{SSL}) { Net::SMTP::_SSLified->start_SSL($obj,SSL_verifycn_name => $host,%arg) or return; @@ -216,7 +217,10 @@ sub starttls { my $self = shift; $ssl_class or die $nossl_warn; $self->_STARTTLS or return; - Net::SMTP::_SSLified->start_SSL($self,@_) or return; + Net::SMTP::_SSLified->start_SSL($self, + %{ ${*$self}{'net_smtp_arg'} }, # (ssl) args given in new + @_ # more (ssl) args + ) or return; # another hello after starttls to read new ESMTP capabilities return $self->hello(${*$self}{net_smtp_hello_domain}); diff --git a/cpan/libnet/t/smtp_ssl.t b/cpan/libnet/t/smtp_ssl.t new file mode 100644 index 0000000..e817d00 --- /dev/null +++ b/cpan/libnet/t/smtp_ssl.t @@ -0,0 +1,120 @@ +use strict; +use warnings; +use Test::More; +use File::Temp 'tempfile'; +use Net::SMTP; + +my $debug = 0; # Net::SMTP Debug => .. + +plan skip_all => "no SSL support found in Net::SMTP" if ! Net::SMTP->can_ssl; + +plan skip_all => "fork not supported on this platform" + if grep { $^O =~m{$_} } qw(MacOS VOS vmesa riscos amigaos); + +plan skip_all => "incomplete or to old version of IO::Socket::SSL" if ! eval { + require IO::Socket::SSL + && require IO::Socket::SSL::Utils + && defined &IO::Socket::SSL::Utils::CERT_create; +}; + +my $srv = IO::Socket::INET->new( + LocalAddr => '127.0.0.1', + Listen => 10 +); +plan skip_all => "cannot create listener on localhost: $!" if ! $srv; +my $saddr = $srv->sockhost.':'.$srv->sockport; + +plan tests => 2; + +my ($ca,$key) = IO::Socket::SSL::Utils::CERT_create( CA => 1 ); +my ($fh,$cafile) = tempfile(); +print $fh IO::Socket::SSL::Utils::PEM_cert2string($ca); +close($fh); + +my $parent = $$; +END { unlink($cafile) if $$ == $parent } + +my ($cert) = IO::Socket::SSL::Utils::CERT_create( + subject => { CN => 'smtp.example.com' }, + issuer_cert => $ca, issuer_key => $key, + key => $key +); + +test(1); # direct ssl +test(0); # starttls + + +sub test { + my $ssl = shift; + defined( my $pid = fork()) or die "fork failed: $!"; + exit(smtp_server($ssl)) if ! $pid; + smtp_client($ssl); + wait; +} + + +sub smtp_client { + my $ssl = shift; + my %sslopt = ( + SSL_verifycn_name => 'smtp.example.com', + SSL_ca_file => $cafile + ); + $sslopt{SSL} = 1 if $ssl; + my $cl = Net::SMTP->new($saddr, %sslopt, Debug => $debug); + diag("created Net::SMTP object"); + if (!$cl) { + fail( ($ssl ? "SSL ":"" )."SMTP connect failed"); + } elsif ($ssl) { + $cl->quit; + pass("SSL SMTP connect success"); + } elsif ( ! $cl->starttls ) { + fail("starttls failed: $IO::Socket::SSL::SSL_ERROR"); + } else { + $cl->quit; + pass("starttls success"); + } +} + +sub smtp_server { + my $ssl = shift; + my $cl = $srv->accept or die "accept failed: $!"; + my %sslargs = ( + SSL_server => 1, + SSL_cert => $cert, + SSL_key => $key, + ); + if ( $ssl ) { + if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) { + diag("initial ssl handshake with client failed"); + return; + } + } + + print $cl "220 welcome\r\n"; + while (<$cl>) { + my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; + $cmd = uc($cmd); + if ($cmd eq 'QUIT' ) { + print $cl "250 bye\r\n"; + last; + } elsif ( $cmd eq 'HELO' ) { + print $cl "250 localhost\r\n"; + } elsif ( $cmd eq 'EHLO' ) { + print $cl "250-localhost\r\n". + ( $ssl ? "" : "250-STARTTLS\r\n" ). + "250 HELP\r\n"; + } elsif ( ! $ssl and $cmd eq 'STARTTLS' ) { + print $cl "250 starting ssl\r\n"; + if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) { + diag("initial ssl handshake with client failed"); + return; + } + $ssl = 1; + } else { + diag("received unknown command: $cmd"); + print "500 unknown cmd\r\n"; + } + } + + diag("SMTP dialog done"); +} -- 2.14.3