From 3a57ec7b3ea8b3b3dcf433bd2bcb6ecc93fc297b Mon Sep 17 00:00:00 2001 From: Steffen Ullrich Date: Thu, 26 Jun 2014 21:33:28 +0200 Subject: IPv6 and SSL support for Net::NNTP --- MANIFEST | 2 + lib/Net/NNTP.pm | 76 ++++++++++++++++++++++++++++++++- t/nntp_ipv6.t | 62 +++++++++++++++++++++++++++ t/nntp_ssl.t | 127 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 265 insertions(+), 2 deletions(-) create mode 100644 t/nntp_ipv6.t create mode 100644 t/nntp_ssl.t diff --git a/MANIFEST b/MANIFEST index ad83dcc..d5a9bcd 100644 --- a/MANIFEST +++ b/MANIFEST @@ -36,6 +36,8 @@ t/hostname.t t/libnet_t.pl t/netrc.t t/nntp.t +t/nntp_ssl.t +t/nntp_ipv6.t t/pod.t t/pod_coverage.t t/require.t diff --git a/lib/Net/NNTP.pm b/lib/Net/NNTP.pm index 790b6db..47c4456 100644 --- a/lib/Net/NNTP.pm +++ b/lib/Net/NNTP.pm @@ -21,7 +21,31 @@ use Net::Config; use Time::Local; our $VERSION = "2.27"; -our @ISA = qw(Net::Cmd IO::Socket::INET); + +# Code for detecting if we can use SSL +my $ssl_class = eval { + require IO::Socket::SSL; + # first version with default CA on most platforms + IO::Socket::SSL->VERSION(1.994); +} && 'IO::Socket::SSL'; + +my $nossl_warn = !$ssl_class && + 'To use SSL please install IO::Socket::SSL with version>=1.994'; + +# Code for detecting if we can use IPv6 +my $inet6_class = eval { + require IO::Socket::IP; + IO::Socket::IP->VERSION(0.20); +} && 'IO::Socket::IP' || eval { + require IO::Socket::INET6; + IO::Socket::INET6->VERSION(2.62); +} && 'IO::Socket::INET6'; + +sub can_ssl { $ssl_class }; +sub can_inet6 { $inet6_class }; + +our @ISA = ('Net::Cmd', $ssl_class || $inet6_class || 'IO::Socket::INET'); + sub new { my $self = shift; @@ -45,6 +69,21 @@ sub new { unless @{$hosts}; my %connect = ( Proto => 'tcp'); + + if ($ssl_class) { + $connect{SSL_verifycn_scheme} = 'nntp'; + $connect{$_} = $arg{$_} for(grep { m{^SSL_} } keys %arg); + if ($arg{SSL}) { + # SSL from start + $arg{Port} ||= 563; + } else { + # upgrade later with STARTTLS + $connect{SSL_startHandshake} = 0; + } + } elsif ($arg{SSL}) { + die $nossl_warn; + } + foreach my $o (qw(LocalAddr Timeout)) { $connect{$o} = $arg{$o} if exists $arg{$o}; } @@ -52,6 +91,7 @@ sub new { $connect{PeerPort} = $arg{Port} || 'nntp(119)'; foreach my $h (@{$hosts}) { $connect{PeerAddr} = $h; + $connect{SSL_verifycn_name} = $arg{SSL_verifycn_name} || $h if $ssl_class; $obj = $type->SUPER::new(%connect) and last; } @@ -122,6 +162,15 @@ sub postok { } +sub starttls { + my $self = shift; + $ssl_class or die $nossl_warn; + $self->is_SSL and croak("NNTP connection is already in SSL mode"); + $self->_STARTTLS or return; + $self->connect_SSL; +} + + sub article { @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )'; my $nntp = shift; @@ -675,6 +724,7 @@ sub _NEXT { shift->command('NEXT')->response == CMD_OK } sub _POST { shift->command('POST', @_)->response == CMD_MORE } sub _QUIT { shift->command('QUIT', @_)->response == CMD_OK } sub _SLAVE { shift->command('SLAVE', @_)->response == CMD_OK } +sub _STARTTLS { shift->command("STARTTLS")->response() == CMD_MORE } sub _STAT { shift->command('STAT', @_)->response == CMD_OK } sub _MODE { shift->command('MODE', @_)->response == CMD_OK } sub _XGTITLE { shift->command('XGTITLE', @_)->response == CMD_OK } @@ -713,10 +763,18 @@ Net::NNTP - NNTP Client class $nntp = Net::NNTP->new("some.host.name"); $nntp->quit; + # start with SSL, e.g. nntps + $nntp = Net::NNTP->new("some.host.name", SSL => 1); + + # start with plain and upgrade to SSL + $nntp = Net::NNTP->new("some.host.name"); + $nntp->starttls; + + =head1 DESCRIPTION C is a class implementing a simple NNTP client in Perl as described -in RFC977. +in RFC977 and RFC4642. The Net::NNTP class is a subclass of Net::Cmd and IO::Socket::INET. @@ -741,6 +799,14 @@ the C option in L, or a reference to an array with hosts to try in turn. The L method will return the value which was used to connect to the host. +B - port to connect to. +Default - 119 for plain NNTP and 563 for immediate SSL (nntps). + +B - If the connection should be done from start with SSL, contrary to later +upgrade with C. +You can use SSL arguments as documented in L, but it will +usually use the right arguments already. + B - Maximum time, in seconds, to wait for a response from the NNTP server, a value of zero will cause all IO operations to block. (default: 120) @@ -778,6 +844,11 @@ documented here. Returns the value used by the constructor, and passed to IO::Socket::INET, to connect to the host. +=item starttls () + +Upgrade existing plain connection to SSL. +Any arguments necessary for SSL must be given in C already. + =item article ( [ MSGID|MSGNUM ], [FH] ) Retrieve the header, a blank line, then the body (text) of the @@ -1164,6 +1235,7 @@ with a and ends with d. =head1 SEE ALSO L +L =head1 AUTHOR 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"); +} -- cgit v1.2.3-24-ge0c7