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
13if ( grep { $^O =~m{$_}i } qw( MacOS VOS vmesa riscos amigaos mswin32) ) {
14    print "1..0 # Skipped: ps not implemented on this platform\n";
15    exit
16}
17
18if ( $^O =~m{aix}i ) {
19    print "1..0 # Skipped: might hang, see https://rt.cpan.org/Ticket/Display.html?id=72170\n";
20    exit
21}
22
23
24$|=1;
25use vars qw( $SSL_SERVER_ADDR );
26do "t/ssl_settings.req" || do "ssl_settings.req";
27
28if ( ! getsize($$) ) {
29	print "1..0 # Skipped: no usable ps\n";
30	exit;
31}
32
33my $server = IO::Socket::SSL->new(
34	LocalAddr => $SSL_SERVER_ADDR,
35	Listen => 200,
36	ReuseAddr => 1,
37);
38my $addr = $SSL_SERVER_ADDR.':'.$server->sockport;
39
40defined( my $pid = fork()) or do {
41	print "1..0 # Skipped: fork failed\n";
42	goto done;
43};
44
45if ( $pid == 0 ) {
46	# server
47	while (1) {
48		# socket accept, client handshake and client close 
49		$server->accept;
50	}
51	goto done;
52}
53
54
55close($server);
56# plain non-SSL connect and close w/o sending data
57for(1..100) {
58	IO::Socket::INET->new( $addr ) or next;
59}
60my $size100 = getsize($pid);
61if ( ! $size100 ) {
62	print "1..0 # Skipped: cannot get size of child process\n";
63	goto done;
64}
65
66for(100..200) {
67	IO::Socket::INET->new( $addr ) or next;
68}
69my $size200 = getsize($pid);
70
71for(200..300) {
72	IO::Socket::INET->new( $addr ) or next;
73}
74my $size300 = getsize($pid);
75if ($size100>$size200 or $size200<$size300) {;
76	print "1..0 # skipped  - do we measure the right thing?\n";
77	goto done;
78}
79
80print "1..1\n";
81print "not " if $size100 < $size200 and $size200 < $size300;
82print "ok # check memleak failed handshake ($size100,$size200,$size300)\n";
83
84done:
85kill(9,$pid);
86wait;
87exit;
88
89
90sub getsize {
91	my $pid = shift;
92	open( my $ps,'-|',"ps -o vsize -p $pid 2>/dev/null" ) or return;
93	$ps && <$ps> or return; # header
94	return int(<$ps>); # size
95}
96
97