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/sysread_write.t' 4 5# This tests that sysread/syswrite behave different to read/write, e.g. 6# that the latter ones are blocking until they read/write everything while 7# the sys* function also can read/write partial data. 8 9use Net::SSLeay; 10use Socket; 11use IO::Socket::SSL; 12use strict; 13 14use vars qw( $SSL_SERVER_ADDR ); 15do "t/ssl_settings.req" || do "ssl_settings.req"; 16 17if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) { 18 print "1..0 # Skipped: fork not implemented on this platform\n"; 19 exit 20} 21 22$|=1; 23print "1..9\n"; 24 25################################################################# 26# create Server socket before forking client, so that it is 27# guaranteed to be listening 28################################################################# 29 30# first create simple ssl-server 31my $ID = 'server'; 32my $server = IO::Socket::SSL->new( 33 LocalAddr => $SSL_SERVER_ADDR, 34 Listen => 2, 35 ReuseAddr => 1, 36 SSL_server => 1, 37 SSL_verify_mode => 0x00, 38 SSL_ca_file => "certs/test-ca.pem", 39 SSL_cert_file => "certs/client-cert.pem", 40 SSL_key_file => "certs/client-key.pem", 41); 42 43print "not ok: $!\n", exit if !$server; # Address in use? 44ok("Server Initialization"); 45 46my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname ); 47 48defined( my $pid = fork() ) || die $!; 49if ( $pid == 0 ) { 50 51 ############################################################ 52 # CLIENT == child process 53 ############################################################ 54 55 close($server); 56 $ID = 'client'; 57 58 my $to_server = IO::Socket::SSL->new( 59 PeerAddr => $SSL_SERVER_ADDR, 60 PeerPort => $SSL_SERVER_PORT, 61 SSL_verify_mode => 0x00, 62 ) || do { 63 print "not ok: connect failed: $!\n"; 64 exit 65 }; 66 67 ok( "client connected" ); 68 69 # write 512 byte, server reads it in 66 byte chunks which 70 # should cause at least the last read to be less then 66 bytes 71 # (and not block). 72 alarm(10); 73 $SIG{ALRM} = sub { 74 print "not ok: timed out\n"; 75 exit; 76 }; 77 #DEBUG( "send 2x512 byte" ); 78 unless ( syswrite( $to_server, 'x' x 512 ) == 512 79 and syswrite( $to_server, 'x' x 512 ) == 512 ) { 80 print "not ok: write to small: $!\n"; 81 exit; 82 } 83 84 sysread( $to_server,my $ack,1 ) || print "not "; 85 ok( "received ack" ); 86 87 alarm(0); 88 ok( "send in time" ); 89 90 # make a syswrite with a buffer length greater than the 91 # ssl message block size (16k for sslv3). It should send 92 # only a partial packet of 16k 93 my $n = syswrite( $to_server, 'x' x 18000 ); 94 #DEBUG( "send $n bytes" ); 95 print "not " if $n != 16384; 96 ok( "partial write in syswrite" ); 97 98 # TODO does not work on Win32!!! 99 print "ok # TODO(win32): " if $^O=~m{mswin32}i; 100 # but write should send everything because it does ssl_write_all 101 $n = $to_server->write( 'x' x 18000 ); 102 #DEBUG( "send $n bytes" ); 103 print "not " if $n != 18000; 104 ok( "full write in write ($n)" ); 105 106 exit; 107 108} else { 109 110 ############################################################ 111 # SERVER == parent process 112 ############################################################ 113 114 my $to_client = $server->accept || do { 115 print "not ok: accept failed: $!\n"; 116 kill(9,$pid); 117 exit; 118 }; 119 ok( "Server accepted" ); 120 121 my $total = 1024; 122 my $partial; 123 while ( $total > 0 ) { 124 #DEBUG( "reading 66 of $total bytes pending=".$to_client->pending() ); 125 my $n = sysread( $to_client, my $buf,66 ); 126 #DEBUG( "read $n bytes" ); 127 if ( !$n ) { 128 print "not ok: read failed: $!\n"; 129 kill(9,$pid); 130 exit; 131 } elsif ( $n != 66 ) { 132 $partial++; 133 } 134 $total -= $n; 135 } 136 print "not " if !$partial; 137 ok( "partial read in sysread" ); 138 139 # send ack back 140 print "not " if !syswrite( $to_client, 'x' ); 141 ok( "send ack back" ); 142 143 # just read so that the writes will not block 144 $to_client->read( my $buf,18000 ); 145 $to_client->read( $buf,18000 ); 146 147 148 # wait until client exits 149 wait; 150} 151 152exit; 153 154 155sub ok { print "ok # [$ID] @_\n"; } 156