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