diff options
author | Steffen Ullrich <Steffen_Ullrich@genua.de> | 2014-06-26 21:33:28 +0200 |
---|---|---|
committer | Steffen Ullrich <Steffen_Ullrich@genua.de> | 2014-06-26 21:33:28 +0200 |
commit | 3a57ec7b3ea8b3b3dcf433bd2bcb6ecc93fc297b (patch) | |
tree | b88ea102b024a637f79d82fa779932e9759b25e1 /t | |
parent | ef6f54955527c2ad62c6944e459c61937c2aa768 (diff) | |
download | perl-libnet-3a57ec7b3ea8b3b3dcf433bd2bcb6ecc93fc297b.tar.gz |
IPv6 and SSL support for Net::NNTP
Diffstat (limited to 't')
-rw-r--r-- | t/nntp_ipv6.t | 62 | ||||
-rw-r--r-- | t/nntp_ssl.t | 127 |
2 files changed, 189 insertions, 0 deletions
diff --git a/t/nntp_ipv6.t b/t/nntp_ipv6.t new file mode 100644 index 0000000..62167b9 --- /dev/null +++ b/t/nntp_ipv6.t @@ -0,0 +1,62 @@ +#!perl + +use 5.008001; + +use strict; +use warnings; + +use File::Temp 'tempfile'; +use Net::NNTP; +use Test::More; + +my $debug = 0; # Net::NNTP->new( Debug => .. ) + +my $inet6class = Net::NNTP->can_inet6; +plan skip_all => "no IPv6 support found in Net::NNTP" 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 $host = $srv->sockhost; +my $port = $srv->sockport; +diag("server on $host port $port"); + +plan tests => 1; + +defined( my $pid = fork()) or die "fork failed: $!"; +exit(nntp_server()) if ! $pid; + +my $cl = Net::NNTP->new(Host => $host, Port => $port,, Debug => $debug); +diag("created Net::NNTP object"); +if (!$cl) { + fail("IPv6 NNTP connect failed"); +} else { + $cl->quit; + pass("IPv6 success"); +} +wait; + +sub nntp_server { + my $ssl = shift; + my $cl = $srv->accept or die "accept failed: $!"; + print $cl "200 nntp.example.com\r\n"; + while (<$cl>) { + my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; + $cmd = uc($cmd); + if ($cmd eq 'QUIT' ) { + print $cl "205 bye\r\n"; + last; + } elsif ( $cmd eq 'MODE' ) { + print $cl "201 Posting denied\r\n"; + } else { + diag("received unknown command: $cmd"); + print "500 unknown cmd\r\n"; + } + } + diag("NNTP dialog done"); +} diff --git a/t/nntp_ssl.t b/t/nntp_ssl.t new file mode 100644 index 0000000..e4b4bcb --- /dev/null +++ b/t/nntp_ssl.t @@ -0,0 +1,127 @@ +#!perl + +use 5.008001; + +use strict; +use warnings; + +use File::Temp 'tempfile'; +use Net::NNTP; +use Test::More; + +my $debug = 0; # Net::NNTP Debug => .. + +my $parent = 0; + +plan skip_all => "no SSL support found in Net::NNTP" if ! Net::NNTP->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 version of IO::Socket::SSL" + if ! eval { require IO::Socket::SSL::Utils }; + +my $srv = IO::Socket::INET->new( + LocalAddr => '127.0.0.1', + Listen => 10 +); +plan skip_all => "cannot create listener on localhost: $!" if ! $srv; +my $host = $srv->sockhost; +my $port = $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); + +$parent = $$; +END { unlink($cafile) if $$ == $parent } + +my ($cert) = IO::Socket::SSL::Utils::CERT_create( + subject => { CN => 'nntp.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(nntp_server($ssl)) if ! $pid; + nntp_client($ssl); + wait; +} + + +sub nntp_client { + my $ssl = shift; + my %sslopt = ( + SSL_verifycn_name => 'nntp.example.com', + SSL_ca_file => $cafile + ); + $sslopt{SSL} = 1 if $ssl; + my $cl = Net::NNTP->new( + Host => $host, + Port => $port, + Debug => $debug, + %sslopt, + ); + diag("created Net::NNTP object"); + if (!$cl) { + fail( ($ssl ? "SSL ":"" )."NNTP connect failed"); + } elsif ($ssl) { + $cl->quit; + pass("SSL NNTP connect success"); + } elsif ( ! $cl->starttls ) { + no warnings 'once'; + fail("starttls failed: $IO::Socket::SSL::SSL_ERROR"); + } else { + $cl->quit; + pass("starttls success"); + } +} + +sub nntp_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 "200 nntp.example.com\r\n"; + while (<$cl>) { + my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; + $cmd = uc($cmd); + if ($cmd eq 'QUIT' ) { + print $cl "205 bye\r\n"; + last; + } elsif ( $cmd eq 'MODE' ) { + print $cl "201 Posting denied\r\n"; + } elsif ( ! $ssl and $cmd eq 'STARTTLS' ) { + print $cl "382 Continue with TLS negotiation\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("NNTP dialog done"); +} |