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