1 2use strict; 3use IO::Socket::INET; 4use IO::Socket::SSL; 5 6if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) { 7 print "1..0 # Skipped: fork not implemented on this platform\n"; 8 exit 9} 10 11use vars qw( $SSL_SERVER_ADDR ); 12do "t/ssl_settings.req" || do "ssl_settings.req"; 13 14$|=1; 15my @tests = qw( start stop start close ); 16print "1..16\n"; 17 18my $server = IO::Socket::INET->new( 19 LocalAddr => $SSL_SERVER_ADDR, 20 Listen => 2, 21 ReuseAddr => 1, 22) || die "not ok #tcp listen failed: $!\n"; 23print "ok #listen\n"; 24my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname ); 25 26defined( my $pid = fork() ) || die $!; 27$pid ? server():client(); 28wait; 29exit(0); 30 31 32sub client { 33 close($server); 34 my $client = IO::Socket::INET->new( "$SSL_SERVER_ADDR:$SSL_SERVER_PORT" ) or 35 die "not ok #client connect: $!\n"; 36 $client->autoflush; 37 print "ok #client connect\n"; 38 39 for my $test (@tests) { 40 alarm(15); 41 #print STDERR "begin test $test\n"; 42 if ( $test eq 'start' ) { 43 print $client "start\n"; 44 sleep(1); # avoid race condition, if client calls start but server is not yet available 45 46 #print STDERR ">>$$(client) start\n"; 47 IO::Socket::SSL->start_SSL( $client ) 48 || die "not ok #client::start_SSL: $SSL_ERROR\n"; 49 #print STDERR "<<$$(client) start\n"; 50 print "ok # client::start_SSL\n"; 51 52 ref($client) eq "IO::Socket::SSL" or print "not "; 53 print "ok # client::class=".ref($client)."\n"; 54 55 } elsif ( $test eq 'stop' ) { 56 print $client "stop\n"; 57 $client->stop_SSL || die "not ok #client::stop_SSL\n"; 58 print "ok # client::stop_SSL\n"; 59 60 ref($client) eq "IO::Socket::INET" or print "not "; 61 print "ok # client::class=".ref($client)."\n"; 62 63 } elsif ( $test eq 'close' ) { 64 print $client "close\n"; 65 my $class = ref($client); 66 $client->close || die "not ok # client::close\n"; 67 print "ok # client::close\n"; 68 69 ref($client) eq $class or print "not "; 70 print "ok # client::class=".ref($client)."\n"; 71 last; 72 } 73 #print STDERR "cont test $test\n"; 74 75 defined( my $line = <$client> ) or return; 76 die "'$line'" if $line ne "OK\n"; 77 } 78} 79 80 81sub server { 82 my $client = $server->accept || die $!; 83 $client->autoflush; 84 while (1) { 85 alarm(15); 86 defined( my $line = <$client> ) or last; 87 chomp($line); 88 if ( $line eq 'start' ) { 89 #print STDERR ">>$$ start\n"; 90 IO::Socket::SSL->start_SSL( $client, 91 SSL_server => 1, 92 SSL_cert_file => "certs/client-cert.pem", 93 SSL_key_file => "certs/client-key.pem" 94 ) || die "not ok #server::start_SSL: $SSL_ERROR\n"; 95 #print STDERR "<<$$ start\n"; 96 97 ref($client) eq "IO::Socket::SSL" or print "not "; 98 print "ok # server::class=".ref($client)."\n"; 99 print $client "OK\n"; 100 101 } elsif ( $line eq 'stop' ) { 102 $client->stop_SSL || die "not ok #server::stop_SSL\n"; 103 print "ok #server::stop_SSL\n"; 104 105 ref($client) eq "IO::Socket::INET" or print "not "; 106 print "ok # class=".ref($client)."\n"; 107 print $client "OK\n"; 108 109 } elsif ( $line eq 'close' ) { 110 my $class = ref($client); 111 $client->close || die "not ok #server::close\n"; 112 print "ok #server::close\n"; 113 114 ref($client) eq $class or print "not "; 115 print "ok # class=".ref($client)."\n"; 116 last; 117 } 118 } 119} 120 121