11 if (!eval { require Socket }) {
12 plan skip_all => "no Socket";
14 elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) {
15 plan skip_all => "EBCDIC but no Convert::EBCDIC";
20 use File::Temp 'tempfile';
23 my $debug = 0; # Net::POP3 Debug => ..
27 plan skip_all => "no SSL support found in Net::POP3" if ! Net::POP3->can_ssl;
29 plan 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/);
35 my $srv = IO::Socket::INET->new(
36 LocalAddr => '127.0.0.1',
39 plan skip_all => "cannot create listener on localhost: $!" if ! $srv;
40 my $saddr = $srv->sockhost.':'.$srv->sockport;
44 require IO::Socket::SSL::Utils;
45 my ($ca,$key) = IO::Socket::SSL::Utils::CERT_create( CA => 1 );
46 my ($fh,$cafile) = tempfile();
47 print $fh IO::Socket::SSL::Utils::PEM_cert2string($ca);
51 END { unlink($cafile) if $$ == $parent }
53 my ($cert) = IO::Socket::SSL::Utils::CERT_create(
54 subject => { CN => 'pop3.example.com' },
55 issuer_cert => $ca, issuer_key => $key,
65 defined( my $pid = fork()) or die "fork failed: $!";
66 exit(pop3_server($ssl)) if ! $pid;
75 SSL_verifycn_name => 'pop3.example.com',
76 SSL_ca_file => $cafile
78 $sslopt{SSL} = 1 if $ssl;
79 my $cl = Net::POP3->new($saddr, %sslopt, Debug => $debug);
80 note("created Net::POP3 object");
82 fail( ($ssl ? "SSL ":"" )."POP3 connect failed");
85 pass("SSL POP3 connect success");
86 } elsif ( ! $cl->starttls ) {
88 fail("starttls failed: $IO::Socket::SSL::SSL_ERROR");
91 pass("starttls success");
97 my $cl = $srv->accept or die "accept failed: $!";
104 if ( ! IO::Socket::SSL->start_SSL($cl, %sslargs)) {
105 diag("initial ssl handshake with client failed");
110 print $cl "+OK localhost ready\r\n";
112 my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_;
114 if ($cmd eq 'QUIT' ) {
115 print $cl "+OK bye\r\n";
117 } elsif ( $cmd eq 'CAPA' ) {
119 ( $ssl ? "" : "STLS\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");
129 diag("received unknown command: $cmd");
130 print "-ERR unknown cmd\r\n";
134 note("POP3 dialog done");