1#!perl -w 2# Before `make install' is performed this script should be runnable with 3# `make test'. After `make install' it should work as `perl t/nonblock.t' 4 5 6use Net::SSLeay; 7use Socket; 8use IO::Socket::SSL; 9use IO::Select; 10use Errno qw(EAGAIN EINPROGRESS ); 11use strict; 12 13use vars qw( $SSL_SERVER_ADDR ); 14do "t/ssl_settings.req" || do "ssl_settings.req"; 15 16if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) { 17 print "1..0 # Skipped: fork not implemented on this platform\n"; 18 exit 19} 20 21$|=1; 22print "1..9\n"; 23 24 25my $server = IO::Socket::INET->new( 26 LocalAddr => $SSL_SERVER_ADDR, 27 Listen => 2, 28 ReuseAddr => 1, 29); 30print("not ok\n"),exit if !$server; 31ok("Server Initialization"); 32my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname ); 33 34 35defined( my $pid = fork() ) || die $!; 36if ( $pid == 0 ) { 37 client(); 38} else { 39 server(); 40 #kill(9,$pid); 41 wait; 42} 43 44 45sub client { 46 close($server); 47 my $client = IO::Socket::INET->new( "$SSL_SERVER_ADDR:$SSL_SERVER_PORT" ) 48 or return fail("client tcp connect"); 49 ok("client tcp connect"); 50 51 IO::Socket::SSL->start_SSL($client) and 52 return fail('start ssl should fail'); 53 ok("startssl client failed: $SSL_ERROR"); 54 55 UNIVERSAL::isa($client,'IO::Socket::INET') or 56 return fail('downgrade socket after error'); 57 ok('downgrade socket after error'); 58 59 print $client "foo\n" or return fail("send to server: $!"); 60 ok("send to server"); 61 my $l; 62 while (defined($l = <$client>)) { 63 if ( $l =~m{bar\n} ) { 64 return ok('client receive non-ssl data'); 65 } 66 #warn "XXXXXXXX $l"; 67 } 68 fail("receive non-ssl data"); 69} 70 71sub server { 72 my $csock = $server->accept or return fail('tcp accept'); 73 ok('tcp accept'); 74 print $csock "This is no SSL handshake\n"; 75 ok('send non-ssl data'); 76 77 alarm(10); 78 my $l; 79 while (defined( $l = <$csock>)) { 80 if ($l =~m{foo\n} ) { 81 print $csock "bar\n"; 82 return ok("received non-ssl data"); 83 } 84 #warn "XXXXXXXXX $l"; 85 } 86 fail('no data from client'.$!); 87} 88 89 90sub ok { print "ok #$_[0]\n"; return 1 } 91sub fail { print "not ok #$_[0]\n"; return } 92 93