Add ARM files

[dh-make-perl] / dev / arm / libio-socket-ssl-perl / libio-socket-ssl-perl-1.16 / t / sysread_write.t

diff --git a/dev/arm/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/sysread_write.t b/dev/arm/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/sysread_write.t
new file mode 100644 (file)
index 0000000..b6a55f1
--- /dev/null
+++ b/dev/arm/libio-socket-ssl-perl/libio-socket-ssl-perl-1.16/t/sysread_write.t
@@ -0,0 +1,153 @@
+#!perl -w
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl t/sysread_write.t'
+
+# This tests that sysread/syswrite behave different to read/write, e.g.
+# that the latter ones are blocking until they read/write everything while
+# the sys* function also can read/write partial data.
+
+use Net::SSLeay;
+use Socket;
+use IO::Socket::SSL;
+use strict;
+
+use vars qw( $SSL_SERVER_ADDR );
+do "t/ssl_settings.req" || do "ssl_settings.req";
+
+if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) {
+    print "1..0 # Skipped: fork not implemented on this platform\n";
+    exit
+}
+
+$|=1;
+print "1..9\n";
+
+#################################################################
+# create Server socket before forking client, so that it is
+# guaranteed to be listening
+#################################################################
+
+# first create simple ssl-server
+my $ID = 'server';
+my $server = IO::Socket::SSL->new(
+    LocalAddr => $SSL_SERVER_ADDR,
+    Listen => 2,
+    ReuseAddr => 1,
+    SSL_server => 1,
+    SSL_verify_mode => 0x00,
+    SSL_ca_file => "certs/test-ca.pem",
+    SSL_cert_file => "certs/client-cert.pem",
+    SSL_key_file => "certs/client-key.pem",
+);
+
+print "not ok: $!\n", exit if !$server; # Address in use?
+ok("Server Initialization");
+
+my ($SSL_SERVER_PORT) = unpack_sockaddr_in( $server->sockname );
+
+defined( my $pid = fork() ) || die $!;
+if ( $pid == 0 ) {
+
+    ############################################################
+    # CLIENT == child process
+    ############################################################
+
+    close($server);
+    $ID = 'client';
+
+    my $to_server = IO::Socket::SSL->new( 
+       PeerAddr => $SSL_SERVER_ADDR,
+       PeerPort => $SSL_SERVER_PORT,
+       SSL_verify_mode => 0x00,
+    ) || do {
+       print "not ok: connect failed: $!\n";
+       exit
+    };
+
+    ok( "client connected" );
+
+    # write 512 byte, server reads it in 66 byte chunks which
+    # should cause at least the last read to be less then 66 bytes
+    # (and not block).
+    alarm(10);
+    $SIG{ALRM} = sub {
+       print "not ok: timed out\n";
+       exit;
+    };
+    #DEBUG( "send 2x512 byte" );
+    unless ( syswrite( $to_server, 'x' x 512 ) == 512 
+       and syswrite( $to_server, 'x' x 512 ) == 512 ) {
+       print "not ok: write to small: $!\n";
+       exit;
+    }
+
+    sysread( $to_server,my $ack,1 ) || print "not ";
+    ok( "received ack" );
+
+    alarm(0);
+    ok( "send in time" );
+
+    # make a syswrite with a buffer length greater than the
+    # ssl message block size (16k for sslv3). It should send
+    # only a partial packet of 16k
+    my $n = syswrite( $to_server, 'x' x 18000 );
+    #DEBUG( "send $n bytes" );
+    print "not " if $n != 16384;
+    ok( "partial write in syswrite" );
+
+    # but write should send everything because it does ssl_write_all
+    $n = $to_server->write( 'x' x 18000 );
+    #DEBUG( "send $n bytes" );
+    print "not " if $n != 18000;
+    ok( "full write in write" );
+
+    exit;
+
+} else {
+
+    ############################################################
+    # SERVER == parent process
+    ############################################################
+
+    my $to_client = $server->accept || do {
+       print "not ok: accept failed: $!\n";
+       kill(9,$pid);
+       exit;
+    };
+    ok( "Server accepted" );
+
+    my $total = 1024;
+    my $partial;
+    while ( $total > 0 ) {
+       #DEBUG( "reading 66 of $total bytes pending=".$to_client->pending() );
+       my $n = sysread( $to_client, my $buf,66 );
+       #DEBUG( "read $n bytes" );
+       if ( !$n ) {
+           print "not ok: read failed: $!\n";
+           kill(9,$pid);
+           exit;
+       } elsif ( $n != 66 ) {
+           $partial++;
+       }
+       $total -= $n;
+    }
+    print "not " if !$partial;
+    ok( "partial read in sysread" );
+
+    # send ack back
+    print "not " if !syswrite( $to_client, 'x' );
+    ok( "send ack back" );
+
+    # just read so that the writes will not block
+    $to_client->read( my $buf,18000 ); 
+    $to_client->read( $buf,18000 ); 
+       
+
+    # wait until client exits
+    wait;
+}
+
+exit;
+
+
+sub ok { print "ok # [$ID] @_\n"; }