Merge pull request #6 from noxxi/ipv6_nntp

IPv6 and SSL support for Net::NNTP

4 files changed, 265 insertions, 2 deletions

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<Net::NNTP> 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<PeerAddr> option in L<IO::Socket::INET>, or a reference to
 an array with hosts to try in turn. The L</host> method will return the value
 which was used to connect to the host.
 
+B<Port> - port to connect to.
+Default - 119 for plain NNTP and 563 for immediate SSL (nntps).
+
+B<SSL> - If the connection should be done from start with SSL, contrary to later
+upgrade with C<starttls>.
+You can use SSL arguments as documented in L<IO::Socket::SSL>, but it will
+usually use the right arguments already.
+
 B<Timeout> - 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<new> 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<Net::Cmd>
+L<IO::Socket::SSL>
 
 =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");
+}