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/dhe.t' 4 5use Net::SSLeay; 6use Socket; 7use IO::Socket::SSL; 8use strict; 9 10 11if ( grep { $^O =~m{$_} } qw( MacOS VOS vmesa riscos amigaos ) ) { 12 print "1..0 # Skipped: fork not implemented on this platform\n"; 13 exit 14} 15 16# check if we have loaded IO::Socket::IP, IO::Socket::SSL should do it by 17# itself if it is available 18unless( IO::Socket::SSL->CAN_IPV6 eq "IO::Socket::IP" ) { 19 # not available or IO::Socket::SSL forgot to load it 20 if ( ! eval { require IO::Socket::IP; IO::Socket::IP->VERSION(0.11) } ) { 21 print "1..0 # Skipped: no IO::Socket::IP 0.11 available\n"; 22 } else { 23 print "1..1\nnot ok # automatic use of IO::Socket::IP\n"; 24 } 25 exit 26} 27 28my $addr = '::1'; 29# check if we can use ::1, e.g if the computer has IPv6 enabled 30if ( ! IO::Socket::IP->new( 31 Listen => 10, 32 LocalAddr => $addr, 33)) { 34 print "1..0 # no IPv6 enabled on this computer\n"; 35 exit 36} 37 38$|=1; 39print "1..3\n"; 40 41# first create simple ssl-server 42my $ID = 'server'; 43my $server = IO::Socket::SSL->new( 44 LocalAddr => $addr, 45 Listen => 2, 46 SSL_cert_file => "certs/server-cert.pem", 47 SSL_key_file => "certs/server-key.pem", 48) || do { 49 notok($!); 50 exit 51}; 52ok("Server Initialization at $addr"); 53 54# add server port to addr 55$addr = "[$addr]:".$server->sockport; 56print "# server at $addr\n"; 57 58my $pid = fork(); 59if ( !defined $pid ) { 60 die $!; # fork failed 61 62} elsif ( !$pid ) { ###### Client 63 64 $ID = 'client'; 65 close($server); 66 my $to_server = IO::Socket::SSL->new( $addr ) || do { 67 notok( "connect failed: ".IO::Socket::SSL->errstr() ); 68 exit 69 }; 70 ok( "client connected" ); 71 72} else { ###### Server 73 74 my $to_client = $server->accept || do { 75 notok( "accept failed: ".$server->errstr() ); 76 kill(9,$pid); 77 exit; 78 }; 79 ok( "Server accepted" ); 80 wait; 81} 82 83sub ok { print "ok # [$ID] @_\n"; } 84sub notok { print "not ok # [$ID] @_\n"; } 85