nntp_ssl.t revision 1.2 
1#!perl
2
3use 5.008001;
4
5use strict;
6use warnings;
7
8use Test::More;
9
10BEGIN {
11    if (!eval { require Socket }) {
12        plan skip_all => "no Socket";
13    }
14    elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) {
15        plan skip_all => "EBCDIC but no Convert::EBCDIC";
16    }
17}
18
19use Config;
20use File::Temp 'tempfile';
21use Net::NNTP;
22
23my $debug = 0; # Net::NNTP Debug => ..
24
25my $parent = 0;
26
27plan skip_all => "no SSL support found in Net::NNTP" if ! Net::NNTP->can_ssl;
28
29plan skip_all => "fork not supported on this platform"
30  unless $Config::Config{d_fork} || $Config::Config{d_pseudofork} ||
31    (($^O eq 'MSWin32' || $^O eq 'NetWare') and
32     $Config::Config{useithreads} and
33     $Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
34
35my $srv = IO::Socket::INET->new(
36  LocalAddr => '127.0.0.1',
37  Listen => 10
38);
39plan skip_all => "cannot create listener on localhost: $!" if ! $srv;
40my $host = $srv->sockhost;
41my $port = $srv->sockport;
42
43plan tests => 2;
44
45require IO::Socket::SSL::Utils;
46my ($ca,$key) = IO::Socket::SSL::Utils::CERT_create( CA => 1 );
47my ($fh,$cafile) = tempfile();
48print $fh IO::Socket::SSL::Utils::PEM_cert2string($ca);
49close($fh);
50
51$parent = $$;
52END { unlink($cafile) if $$ == $parent }
53
54my ($cert) = IO::Socket::SSL::Utils::CERT_create(
55  subject => { CN => 'nntp.example.com' },
56  issuer_cert => $ca, issuer_key => $key,
57  key => $key
58);
59
60test(1); # direct ssl
61test(0); # starttls
62
63
64sub test {
65  my $ssl = shift;
66  defined( my $pid = fork()) or die "fork failed: $!";
67  exit(nntp_server($ssl)) if ! $pid;
68  nntp_client($ssl);
69  wait;
70}
71
72
73sub nntp_client {
74  my $ssl = shift;
75  my %sslopt = (
76    SSL_verifycn_name => 'nntp.example.com',
77    SSL_ca_file => $cafile
78  );
79  $sslopt{SSL} = 1 if $ssl;
80  my $cl = Net::NNTP->new(
81    Host => $host,
82    Port => $port,
83    Debug => $debug,
84    %sslopt,
85  );
86  note("created Net::NNTP object");
87  if (!$cl) {
88    fail( ($ssl ? "SSL ":"" )."NNTP connect failed");
89  } elsif ($ssl) {
90    $cl->quit;
91    pass("SSL NNTP connect success");
92  } elsif ( ! $cl->starttls ) {
93    no warnings 'once';
94    fail("starttls failed: $IO::Socket::SSL::SSL_ERROR");
95  } else {
96    $cl->quit;
97    pass("starttls success");
98  }
99}
100
101sub nntp_server {
102  my $ssl = shift;
103  my $cl = $srv->accept or die "accept failed: $!";
104  my %sslargs = (
105    SSL_server => 1,
106    SSL_cert => $cert,
107    SSL_key => $key,
108  );
109  if ( $ssl ) {
110    if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) {
111      diag("initial ssl handshake with client failed");
112      return;
113    }
114  }
115
116  print $cl "200 nntp.example.com\r\n";
117  while (<$cl>) {
118    my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_;
119    $cmd = uc($cmd);
120    if ($cmd eq 'QUIT' ) {
121      print $cl "205 bye\r\n";
122      last;
123    } elsif ( $cmd eq 'MODE' ) {
124      print $cl "201 Posting denied\r\n";
125    } elsif ( ! $ssl and $cmd eq 'STARTTLS' ) {
126      print $cl "382 Continue with TLS negotiation\r\n";
127      if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) {
128        diag("initial ssl handshake with client failed");
129        return;
130      }
131      $ssl = 1;
132    } else {
133      diag("received unknown command: $cmd");
134      print "500 unknown cmd\r\n";
135    }
136  }
137
138  note("NNTP dialog done");
139}
140