Update libnet to CPAN version 3.01
[perl.git] / cpan / libnet / t / pop3_ssl.t
1 #!perl
2
3 use 5.008001;
4
5 use strict;
6 use warnings;
7
8 use Config;
9 use File::Temp 'tempfile';
10 use Net::POP3;
11 use Test::More;
12
13 my $debug = 0; # Net::POP3 Debug => ..
14
15 my $parent = 0;
16
17 plan skip_all => "no SSL support found in Net::POP3" if ! Net::POP3->can_ssl;
18
19 plan 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
25 plan skip_all => "incomplete or to old version of IO::Socket::SSL" if ! eval {
26   require IO::Socket::SSL
27     && IO::Socket::SSL->VERSION(1.999)
28     && require IO::Socket::SSL::Utils
29     && defined &IO::Socket::SSL::Utils::CERT_create;
30 };
31
32 my $srv = IO::Socket::INET->new(
33   LocalAddr => '127.0.0.1',
34   Listen => 10
35 );
36 plan skip_all => "cannot create listener on localhost: $!" if ! $srv;
37 my $saddr = $srv->sockhost.':'.$srv->sockport;
38
39 plan tests => 2;
40
41 my ($ca,$key) = IO::Socket::SSL::Utils::CERT_create( CA => 1 );
42 my ($fh,$cafile) = tempfile();
43 print $fh IO::Socket::SSL::Utils::PEM_cert2string($ca);
44 close($fh);
45
46 $parent = $$;
47 END { unlink($cafile) if $$ == $parent }
48
49 my ($cert) = IO::Socket::SSL::Utils::CERT_create(
50   subject => { CN => 'pop3.example.com' },
51   issuer_cert => $ca, issuer_key => $key,
52   key => $key
53 );
54
55 test(1); # direct ssl
56 test(0); # starttls
57
58
59 sub test {
60   my $ssl = shift;
61   defined( my $pid = fork()) or die "fork failed: $!";
62   exit(pop3_server($ssl)) if ! $pid;
63   pop3_client($ssl);
64   wait;
65 }
66
67
68 sub pop3_client {
69   my $ssl = shift;
70   my %sslopt = (
71     SSL_verifycn_name => 'pop3.example.com',
72     SSL_ca_file => $cafile
73   );
74   $sslopt{SSL} = 1 if $ssl;
75   my $cl = Net::POP3->new($saddr, %sslopt, Debug => $debug);
76   diag("created Net::POP3 object");
77   if (!$cl) {
78     fail( ($ssl ? "SSL ":"" )."POP3 connect failed");
79   } elsif ($ssl) {
80     $cl->quit;
81     pass("SSL POP3 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
91 sub pop3_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 "+OK localhost ready\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 "+OK bye\r\n";
112       last;
113     } elsif ( $cmd eq 'CAPA' ) {
114       print $cl "+OK\r\n".
115         ( $ssl ? "" : "STLS\r\n" ).
116         ".\r\n";
117     } elsif ( ! $ssl and $cmd eq 'STLS' ) {
118       print $cl "+OK starting ssl\r\n";
119       if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) {
120         diag("initial ssl handshake with client failed");
121         return;
122       }
123       $ssl = 1;
124     } else {
125       diag("received unknown command: $cmd");
126       print "-ERR unknown cmd\r\n";
127     }
128   }
129
130   diag("POP3 dialog done");
131 }