xref: /openbsd/gnu/usr.bin/perl/cpan/libnet/t/pop3_ssl.t (revision 09467b48) 
1#!perl
2
3use 5.008001;
4
5use strict;
6use warnings;
7
8use Config;
9use File::Temp 'tempfile';
10use Net::POP3;
11use Test::More;
12
13my $debug = 0; # Net::POP3 Debug => ..
14
15my $parent = 0;
16
17plan skip_all => "no SSL support found in Net::POP3" if ! Net::POP3->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 $saddr = $srv->sockhost.':'.$srv->sockport;
31
32plan tests => 2;
33
34require IO::Socket::SSL::Utils;
35my ($ca,$key) = IO::Socket::SSL::Utils::CERT_create( CA => 1 );
36my ($fh,$cafile) = tempfile();
37print $fh IO::Socket::SSL::Utils::PEM_cert2string($ca);
38close($fh);
39
40$parent = $$;
41END { unlink($cafile) if $$ == $parent }
42
43my ($cert) = IO::Socket::SSL::Utils::CERT_create(
44  subject => { CN => 'pop3.example.com' },
45  issuer_cert => $ca, issuer_key => $key,
46  key => $key
47);
48
49test(1); # direct ssl
50test(0); # starttls
51
52
53sub test {
54  my $ssl = shift;
55  defined( my $pid = fork()) or die "fork failed: $!";
56  exit(pop3_server($ssl)) if ! $pid;
57  pop3_client($ssl);
58  wait;
59}
60
61
62sub pop3_client {
63  my $ssl = shift;
64  my %sslopt = (
65    SSL_verifycn_name => 'pop3.example.com',
66    SSL_ca_file => $cafile
67  );
68  $sslopt{SSL} = 1 if $ssl;
69  my $cl = Net::POP3->new($saddr, %sslopt, Debug => $debug);
70  note("created Net::POP3 object");
71  if (!$cl) {
72    fail( ($ssl ? "SSL ":"" )."POP3 connect failed");
73  } elsif ($ssl) {
74    $cl->quit;
75    pass("SSL POP3 connect success");
76  } elsif ( ! $cl->starttls ) {
77    no warnings 'once';
78    fail("starttls failed: $IO::Socket::SSL::SSL_ERROR");
79  } else {
80    $cl->quit;
81    pass("starttls success");
82  }
83}
84
85sub pop3_server {
86  my $ssl = shift;
87  my $cl = $srv->accept or die "accept failed: $!";
88  my %sslargs = (
89    SSL_server => 1,
90    SSL_cert => $cert,
91    SSL_key => $key,
92  );
93  if ( $ssl ) {
94    if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) {
95      diag("initial ssl handshake with client failed");
96      return;
97    }
98  }
99
100  print $cl "+OK localhost ready\r\n";
101  while (<$cl>) {
102    my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_;
103    $cmd = uc($cmd);
104    if ($cmd eq 'QUIT' ) {
105      print $cl "+OK bye\r\n";
106      last;
107    } elsif ( $cmd eq 'CAPA' ) {
108      print $cl "+OK\r\n".
109        ( $ssl ? "" : "STLS\r\n" ).
110        ".\r\n";
111    } elsif ( ! $ssl and $cmd eq 'STLS' ) {
112      print $cl "+OK starting ssl\r\n";
113      if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) {
114        diag("initial ssl handshake with client failed");
115        return;
116      }
117      $ssl = 1;
118    } else {
119      diag("received unknown command: $cmd");
120      print "-ERR unknown cmd\r\n";
121    }
122  }
123
124  note("POP3 dialog done");
125}
126