Merge branch 'ipv6_ssl' of https://github.com/noxxi/perl-libnet into noxxi-ipv6_ssl

6 files changed, 457 insertions, 0 deletions

diff --git a/t/external/pop3-ssl.t b/t/external/pop3-ssl.t
new file mode 100644
index 0000000..585890c
--- /dev/null
+++ b/t/external/pop3-ssl.t
@@ -0,0 +1,51 @@
+
+use strict;
+use warnings;
+use Net::POP3;
+use Test::More;
+
+my $host = 'pop.gmx.net';
+my $debug = 0;
+
+plan skip_all => "no SSL support" if ! Net::POP3->can_ssl;
+plan skip_all => "no verified SSL connection to $host:995 - $@" if ! eval {
+  IO::Socket::SSL->new(PeerAddr => "$host:995", Timeout => 10)
+    || die($IO::Socket::SSL::SSL_ERROR||$!);
+};
+
+plan tests => 2;
+
+SKIP: {
+  diag( "connect inet to $host:110" );
+  skip "no inet connect to $host:110",1 
+    if ! IO::Socket::INET->new(PeerAddr => "$host:110", Timeout => 10);
+  my $pop3 = Net::POP3->new($host, Debug => $debug, Timeout => 10)
+    or skip "normal POP3 failed: $@",1;
+  skip "no STARTTLS support",1 if $pop3->message !~/STARTTLS/;
+
+  if (!$pop3->starttls) {
+    fail("starttls failed: ".$pop3->code." $@")
+  } else {
+    # we now should have access to SSL stuff
+    my $cipher = eval { $pop3->get_cipher };
+    if (!$cipher) {
+      fail("after starttls: not an SSL object");
+    } elsif ( $pop3->quit ) {
+      pass("starttls + quit ok, cipher=$cipher");
+    } else {
+      fail("quit after starttls failed: ".$pop3->code);
+    }
+  }
+}
+
+
+my $pop3 = Net::POP3->new($host, SSL => 1, Timeout => 10, Debug => $debug);
+# we now should have access to SSL stuff
+my $cipher = eval { $pop3->get_cipher };
+if (!$cipher) {
+  fail("after ssl connect: not an SSL object");
+} elsif ( $pop3->quit ) {
+  pass("ssl connect ok, cipher=$cipher");
+} else {
+  fail("quit after direct ssl failed: ".$pop3->code);
+}
diff --git a/t/external/smtp-ssl.t b/t/external/smtp-ssl.t
new file mode 100644
index 0000000..94753ab
--- /dev/null
+++ b/t/external/smtp-ssl.t
@@ -0,0 +1,50 @@
+
+use strict;
+use warnings;
+use Net::SMTP;
+use Test::More;
+
+my $host = 'mail.gmx.net';
+my $debug = 0;
+
+plan skip_all => "no SSL support" if ! Net::SMTP->can_ssl;
+plan skip_all => "no verified SSL connection to $host:465 - $@" if ! eval {
+  IO::Socket::SSL->new("$host:465")
+    || die($IO::Socket::SSL::SSL_ERROR||$!);
+};
+
+plan tests => 2;
+
+SKIP: {
+  diag( "connect inet to $host:25" );
+  skip "no inet connect to $host:25",1 if ! IO::Socket::INET->new("$host:25");
+  my $smtp = Net::SMTP->new($host, Debug => $debug)
+    or skip "normal SMTP failed: $@",1;
+  skip "no STARTTLS support",1 if $smtp->message !~/STARTTLS/;
+
+  if (!$smtp->starttls) {
+    fail("starttls failed: ".$smtp->code." $@")
+  } else {
+    # we now should have access to SSL stuff
+    my $cipher = eval { $smtp->get_cipher };
+    if (!$cipher) {
+      fail("after starttls: not an SSL object");
+    } elsif ( $smtp->quit ) {
+      pass("starttls + quit ok, cipher=$cipher");
+    } else {
+      fail("quit after starttls failed: ".$smtp->code);
+    }
+  }
+}
+
+
+my $smtp = Net::SMTP->new($host, SSL => 1, Debug => $debug);
+# we now should have access to SSL stuff
+my $cipher = eval { $smtp->get_cipher };
+if (!$cipher) {
+  fail("after ssl connect: not an SSL object");
+} elsif ( $smtp->quit ) {
+  pass("ssl connect ok, cipher=$cipher");
+} else {
+  fail("quit after direct ssl failed: ".$smtp->code);
+}
diff --git a/t/pop3_ipv6.pl b/t/pop3_ipv6.pl
new file mode 100644
index 0000000..2f073ab
--- /dev/null
+++ b/t/pop3_ipv6.pl
@@ -0,0 +1,57 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Temp 'tempfile';
+use Net::POP3;
+
+my $debug = 0; # Net::POP3->new( Debug => .. )
+
+my $inet6class = Net::POP3->can_inet6;
+plan skip_all => "no IPv6 support found in Net::POP3" if ! $inet6class;
+
+plan skip_all => "fork not supported on this platform"
+  if grep { $^O =~m{$_} } qw(MacOS VOS vmesa riscos amigaos);
+
+my $srv = $inet6class->new(
+  LocalAddr => '::1',
+  Listen => 10
+);
+plan skip_all => "cannot create listener on ::1: $!" if ! $srv;
+my $saddr = "[".$srv->sockhost."]".':'.$srv->sockport;
+diag("server on $saddr");
+
+plan tests => 1;
+
+defined( my $pid = fork()) or die "fork failed: $!";
+exit(pop3_server()) if ! $pid;
+
+my $cl = Net::POP3->new($saddr, Debug => $debug);
+diag("created Net::POP3 object");
+if (!$cl) {
+  fail("IPv6 POP3 connect failed");
+} else {
+  $cl->quit;
+  pass("IPv6 success");
+}
+wait;
+
+sub pop3_server {
+  my $cl = $srv->accept or die "accept failed: $!";
+  print $cl "+OK localhost ready\r\n";
+  while (<$cl>) {
+    my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_;
+    $cmd = uc($cmd);
+    if ($cmd eq 'QUIT' ) {
+      print $cl "+OK bye\r\n";
+      last;
+    } elsif ( $cmd eq 'CAPA' ) {
+      print $cl "+OK\r\n".
+        ".\r\n";
+    } else {
+      diag("received unknown command: $cmd");
+      print "-ERR unknown cmd\r\n";
+    }
+  }
+
+  diag("POP3 dialog done");
+}
diff --git a/t/pop3_ssl.t b/t/pop3_ssl.t
new file mode 100644
index 0000000..f1090af
--- /dev/null
+++ b/t/pop3_ssl.t
@@ -0,0 +1,119 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Temp 'tempfile';
+use Net::POP3;
+
+my $debug = 0; # Net::POP3 Debug => ..
+
+plan skip_all => "no SSL support found in Net::POP3" if ! Net::POP3->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
+    && IO::Socket::SSL->VERSION(1.968)
+    && 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 => 'pop3.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(pop3_server($ssl)) if ! $pid;
+  pop3_client($ssl);
+  wait;
+}
+
+
+sub pop3_client {
+  my $ssl = shift;
+  my %sslopt = (
+    SSL_verifycn_name => 'pop3.example.com',
+    SSL_ca_file => $cafile
+  );
+  $sslopt{SSL} = 1 if $ssl;
+  my $cl = Net::POP3->new($saddr, %sslopt, Debug => $debug);
+  diag("created Net::POP3 object");
+  if (!$cl) {
+    fail( ($ssl ? "SSL ":"" )."POP3 connect failed");
+  } elsif ($ssl) {
+    $cl->quit;
+    pass("SSL POP3 connect success");
+  } elsif ( ! $cl->starttls ) {
+    fail("starttls failed: $IO::Socket::SSL::SSL_ERROR");
+  } else {
+    $cl->quit;
+    pass("starttls success");
+  }
+}
+
+sub pop3_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 "+OK localhost ready\r\n";
+  while (<$cl>) {
+    my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_;
+    $cmd = uc($cmd);
+    if ($cmd eq 'QUIT' ) {
+      print $cl "+OK bye\r\n";
+      last;
+    } elsif ( $cmd eq 'CAPA' ) {
+      print $cl "+OK\r\n".
+        ( $ssl ? "" : "STLS\r\n" ).
+        ".\r\n";
+    } elsif ( ! $ssl and $cmd eq 'STLS' ) {
+      print $cl "+OK 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 "-ERR unknown cmd\r\n";
+    }
+  }
+
+  diag("POP3 dialog done");
+}
diff --git a/t/smtp_ipv6.pl b/t/smtp_ipv6.pl
new file mode 100644
index 0000000..6a01520
--- /dev/null
+++ b/t/smtp_ipv6.pl
@@ -0,0 +1,59 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Temp 'tempfile';
+use Net::SMTP;
+
+my $debug = 0; # Net::SMTP->new( Debug => .. )
+
+my $inet6class = Net::SMTP->can_inet6;
+plan skip_all => "no IPv6 support found in Net::SMTP" if ! $inet6class;
+
+plan skip_all => "fork not supported on this platform"
+  if grep { $^O =~m{$_} } qw(MacOS VOS vmesa riscos amigaos);
+
+my $srv = $inet6class->new(
+  LocalAddr => '::1',
+  Listen => 10
+);
+plan skip_all => "cannot create listener on ::1: $!" if ! $srv;
+my $saddr = "[".$srv->sockhost."]".':'.$srv->sockport;
+diag("server on $saddr");
+
+plan tests => 1;
+
+defined( my $pid = fork()) or die "fork failed: $!";
+exit(smtp_server()) if ! $pid;
+
+my $cl = Net::SMTP->new($saddr, Debug => $debug);
+diag("created Net::SMTP object");
+if (!$cl) {
+  fail("IPv6 SMTP connect failed");
+} else {
+  $cl->quit;
+  pass("IPv6 success");
+}
+wait;
+
+sub smtp_server {
+  my $cl = $srv->accept or die "accept failed: $!";
+  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".
+        "250 HELP\r\n";
+    } else {
+      diag("received unknown command: $cmd");
+      print "500 unknown cmd\r\n";
+    }
+  }
+
+  diag("SMTP dialog done");
+}
diff --git a/t/smtp_ssl.t b/t/smtp_ssl.t
new file mode 100644
index 0000000..afb7bee
--- /dev/null
+++ b/t/smtp_ssl.t
@@ -0,0 +1,121 @@
+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
+    && IO::Socket::SSL->VERSION(1.968)
+    && 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");
+}