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::POP3; 22 23my $debug = 0; # Net::POP3 Debug => .. 24 25my $parent = 0; 26 27plan skip_all => "no SSL support found in Net::POP3" if ! Net::POP3->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 $saddr = $srv->sockhost.':'.$srv->sockport; 41 42plan tests => 2; 43 44require IO::Socket::SSL::Utils; 45my ($ca,$key) = IO::Socket::SSL::Utils::CERT_create( CA => 1 ); 46my ($fh,$cafile) = tempfile(); 47print $fh IO::Socket::SSL::Utils::PEM_cert2string($ca); 48close($fh); 49 50$parent = $$; 51END { unlink($cafile) if $$ == $parent } 52 53my ($cert) = IO::Socket::SSL::Utils::CERT_create( 54 subject => { CN => 'pop3.example.com' }, 55 issuer_cert => $ca, issuer_key => $key, 56 key => $key 57); 58 59test(1); # direct ssl 60test(0); # starttls 61 62 63sub test { 64 my $ssl = shift; 65 defined( my $pid = fork()) or die "fork failed: $!"; 66 exit(pop3_server($ssl)) if ! $pid; 67 pop3_client($ssl); 68 wait; 69} 70 71 72sub pop3_client { 73 my $ssl = shift; 74 my %sslopt = ( 75 SSL_verifycn_name => 'pop3.example.com', 76 SSL_ca_file => $cafile 77 ); 78 $sslopt{SSL} = 1 if $ssl; 79 my $cl = Net::POP3->new($saddr, %sslopt, Debug => $debug); 80 note("created Net::POP3 object"); 81 if (!$cl) { 82 fail( ($ssl ? "SSL ":"" )."POP3 connect failed"); 83 } elsif ($ssl) { 84 $cl->quit; 85 pass("SSL POP3 connect success"); 86 } elsif ( ! $cl->starttls ) { 87 no warnings 'once'; 88 fail("starttls failed: $IO::Socket::SSL::SSL_ERROR"); 89 } else { 90 $cl->quit; 91 pass("starttls success"); 92 } 93} 94 95sub pop3_server { 96 my $ssl = shift; 97 my $cl = $srv->accept or die "accept failed: $!"; 98 my %sslargs = ( 99 SSL_server => 1, 100 SSL_cert => $cert, 101 SSL_key => $key, 102 ); 103 if ( $ssl ) { 104 if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) { 105 diag("initial ssl handshake with client failed"); 106 return; 107 } 108 } 109 110 print $cl "+OK localhost ready\r\n"; 111 while (<$cl>) { 112 my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_; 113 $cmd = uc($cmd); 114 if ($cmd eq 'QUIT' ) { 115 print $cl "+OK bye\r\n"; 116 last; 117 } elsif ( $cmd eq 'CAPA' ) { 118 print $cl "+OK\r\n". 119 ( $ssl ? "" : "STLS\r\n" ). 120 ".\r\n"; 121 } elsif ( ! $ssl and $cmd eq 'STLS' ) { 122 print $cl "+OK starting ssl\r\n"; 123 if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) { 124 diag("initial ssl handshake with client failed"); 125 return; 126 } 127 $ssl = 1; 128 } else { 129 diag("received unknown command: $cmd"); 130 print "-ERR unknown cmd\r\n"; 131 } 132 } 133 134 note("POP3 dialog done"); 135} 136