From 1d3aa3540da1a751c047e84fbc5dca793e411b2e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
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 <Steffen_Ullrich@genua.de>
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ř <ppisar@redhat.com>
---
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