[p5sagit/p5-mst-13.2.git] / t / lib / io_sock.t

#!./perl

BEGIN {
    unless(grep /blib/, @INC) {
	chdir 't' if -d 't';
	@INC = '../lib';
    }
}

use Config;

BEGIN {
    if (-d "lib" && -f "TEST") {
	my $reason;
	if (! $Config{'d_fork'}) {
	    $reason = 'no fork';
	}
	elsif ($Config{'extensions'} !~ /\bSocket\b/) {
	    $reason = 'Socket extension unavailable';
	}
	elsif ($Config{'extensions'} !~ /\bIO\b/) {
	    $reason = 'IO extension unavailable';
	}
	undef $reason if $^O eq 'VMS' and $Config{d_socket};
	if ($reason) {
	    print "1..0 # Skip: $reason\n";
	    exit 0;
        }
    }
}

$| = 1;
print "1..20\n";

use IO::Socket;

$listen = IO::Socket::INET->new(Listen => 2,
				Proto => 'tcp',
				# some systems seem to need as much as 10,
				# so be generous with the timeout
				Timeout => 15,
			       ) or die "$!";

print "ok 1\n";

# Check if can fork with dynamic extensions (bug in CRT):
if ($^O eq 'os2' and
    system "$^X -I../lib -MOpcode -e 'defined fork or die'  > /dev/null 2>&1") {
    print "ok $_ # skipped: broken fork\n" for 2..5;
    exit 0;
}

$port = $listen->sockport;

if($pid = fork()) {

    $sock = $listen->accept() or die "accept failed: $!";
    print "ok 2\n";

    $sock->autoflush(1);
    print $sock->getline();

    print $sock "ok 4\n";

    $sock->close;

    waitpid($pid,0);

    print "ok 5\n";

} elsif(defined $pid) {

    $sock = IO::Socket::INET->new(PeerPort => $port,
				  Proto => 'tcp',
				  PeerAddr => 'localhost'
				 )
         || IO::Socket::INET->new(PeerPort => $port,
				  Proto => 'tcp',
				  PeerAddr => '127.0.0.1'
				 )
	or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";

    $sock->autoflush(1);

    print $sock "ok 3\n";

    print $sock->getline();

    $sock->close;

    exit;
} else {
 die;
}

# Test various other ways to create INET sockets that should
# also work.
$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
$port = $listen->sockport;

if($pid = fork()) {
  SERVER_LOOP:
    while (1) {
       last SERVER_LOOP unless $sock = $listen->accept;
       while (<$sock>) {
           last SERVER_LOOP if /^quit/;
           last if /^done/;
           print;
       }
       $sock = undef;
    }
    $listen->close;
} elsif (defined $pid) {
    # child, try various ways to connect
    $sock = IO::Socket::INET->new("localhost:$port")
         || IO::Socket::INET->new("127.0.0.1:$port");
    if ($sock) {
	print "not " unless $sock->connected;
	print "ok 6\n";
       $sock->print("ok 7\n");
       sleep(1);
       print "ok 8\n";
       $sock->print("ok 9\n");
       $sock->print("done\n");
       $sock->close;
    }
    else {
	print "# $@\n";
	print "not ok 6\n";
	print "not ok 7\n";
	print "not ok 8\n";
	print "not ok 9\n";
    }

    # some machines seem to suffer from a race condition here
    sleep(2);

    $sock = IO::Socket::INET->new("127.0.0.1:$port");
    if ($sock) {
       $sock->print("ok 10\n");
       $sock->print("done\n");
       $sock->close;
    }
    else {
	print "# $@\n";
	print "not ok 10\n";
    }

    # some machines seem to suffer from a race condition here
    sleep(1);

    $sock = IO::Socket->new(Domain => AF_INET,
                            PeerAddr => "localhost:$port")
         || IO::Socket->new(Domain => AF_INET,
                            PeerAddr => "127.0.0.1:$port");
    if ($sock) {
       $sock->print("ok 11\n");
       $sock->print("quit\n");
    } else {
       print "not ok 11\n";
    }
    $sock = undef;
    sleep(1);
    exit;
} else {
    die;
}

# Then test UDP sockets
$server = IO::Socket->new(Domain => AF_INET,
                          Proto  => 'udp',
                          LocalAddr => 'localhost')
       || IO::Socket->new(Domain => AF_INET,
                          Proto  => 'udp',
                          LocalAddr => '127.0.0.1');
$port = $server->sockport;

if ($^O eq 'mpeix') {
    print("ok 12 # skipped\n")
} else {
    if ($pid = fork()) {
        my $buf;
        $server->recv($buf, 100);
        print $buf;
    } elsif (defined($pid)) {
        #child
        $sock = IO::Socket::INET->new(Proto => 'udp',
                                      PeerAddr => "localhost:$port")
             || IO::Socket::INET->new(Proto => 'udp',
                                      PeerAddr => "127.0.0.1:$port");
        $sock->send("ok 12\n");
        sleep(1);
        $sock->send("ok 12\n");  # send another one to be sure
        exit;
    } else {
        die;
    }
}

print "not " unless $server->blocking;
print "ok 13\n";

$server->blocking(0);
print "not " if $server->blocking;
print "ok 14\n";

### TEST 15
### Set up some data to be transfered between the server and
### the client. We'll use own source code ...
#
local @data;
if( !open( SRC, "< $0")) {
    print "not ok 15 - $!";
} else {
    @data = <SRC>;
    close( SRC);
}
print "ok 15\n";

### TEST 16
### Start the server
#
my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) ||
    print "not ";
print "ok 16\n";
die if( !defined( $listen));
my $serverport = $listen->sockport;

my $server_pid = fork();
if( $server_pid) {

    ### TEST 17 Client/Server establishment
    #
    print "ok 17\n";

    ### TEST 18
    ### Get data from the server using a single stream
    #
    $sock = IO::Socket::INET->new("localhost:$serverport")
         || IO::Socket::INET->new("127.0.0.1:$serverport");

    if ($sock) {
	$sock->print("send\n");

	my @array = ();
	while( <$sock>) {
	    push( @array, $_);
	}

	$sock->print("done\n");
	$sock->close;

	print "not " if( @array != @data);
    } else {
	print "not ";
    }
    print "ok 18\n";

    ### TEST 19
    ### Get data from the server using a stream, which is
    ### interrupted by eof calls.
    ### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
    ### did an getc followed by an ungetc in order to check for the streams
    ### end. getc(3) got replaced by the SOCKS funktion, which ended up in
    ### a recv(2) call on the socket, while ungetc(3) put back a character
    ### to an IO buffer, which never again was read.
    #
    $sock = IO::Socket::INET->new("localhost:$serverport")
         || IO::Socket::INET->new("127.0.0.1:$serverport");

    if ($sock) {
	$sock->print("send\n");

	my @array = ();
	while( !eof( $sock ) ){
	    while( <$sock>) {
		push( @array, $_);
		last;
	    }
	}

	$sock->print("done\n");
	$sock->close;

	print "not " if( @array != @data);
    } else {
	print "not ";
    }
    print "ok 19\n";

    ### TEST 20
    ### Stop the server
    #
    $sock = IO::Socket::INET->new("localhost:$serverport")
         || IO::Socket::INET->new("127.0.0.1:$serverport");

    if ($sock) {
	$sock->print("done\n");
	$sock->close;

	print "not " if( 1 != kill 0, $server_pid);
    } else {
	print "not ";
    }
    print "ok 20\n";

} elsif( defined( $server_pid)) {
   
    ### Child
    #
    SERVER_LOOP: while (1) {
	last SERVER_LOOP unless $sock = $listen->accept;
	while (<$sock>) {
	    last SERVER_LOOP if /^quit/;
	    last if /^done/;
	    if( /^send/) {
		print $sock @data;
		last;
	    }
	    print;
	}
	$sock = undef;
    }
    $listen->close;

} else {

    ### Fork failed
    #
    print "not ok 17\n";
    die;
}
Commit	Line	Data
61f2b451	1	#!./perl
	2
	3	BEGIN {
7a4c00b4	4	unless(grep /blib/, @INC) {
7a4c00b4	5	chdir 't' if -d 't';
20822f61	6	@INC = '../lib';
7a4c00b4	7	}
	8	}
	9
	10	use Config;
	11
	12	BEGIN {
774d564b	13	if (-d "lib" && -f "TEST") {
45c0de28	14	my $reason;
	15	if (! $Config{'d_fork'}) {
	16	$reason = 'no fork';
	17	}
	18	elsif ($Config{'extensions'} !~ /\bSocket\b/) {
	19	$reason = 'Socket extension unavailable';
	20	}
	21	elsif ($Config{'extensions'} !~ /\bIO\b/) {
	22	$reason = 'IO extension unavailable';
	23	}
	24	undef $reason if $^O eq 'VMS' and $Config{d_socket};
	25	if ($reason) {
	26	print "1..0 # Skip: $reason\n";
7a4c00b4	27	exit 0;
7a4c00b4	28	}
61f2b451	29	}
	30	}
	31
	32	$\| = 1;
cf829ab0	33	print "1..20\n";
61f2b451	34
	35	use IO::Socket;
	36
7a4c00b4	37	$listen = IO::Socket::INET->new(Listen => 2,
7a4c00b4	38	Proto => 'tcp',
862b0ad8	39	# some systems seem to need as much as 10,
	40	# so be generous with the timeout
	41	Timeout => 15,
7a4c00b4	42	) or die "$!";
61f2b451	43
7a4c00b4	44	print "ok 1\n";
61f2b451	45
a245ea2d	46	# Check if can fork with dynamic extensions (bug in CRT):
	47	if ($^O eq 'os2' and
	48	system "$^X -I../lib -MOpcode -e 'defined fork or die' > /dev/null 2>&1") {
	49	print "ok $_ # skipped: broken fork\n" for 2..5;
	50	exit 0;
	51	}
	52
7a4c00b4	53	$port = $listen->sockport;
61f2b451	54
7a4c00b4	55	if($pid = fork()) {
61f2b451	56
e197ebb9	57	$sock = $listen->accept() or die "accept failed: $!";
61f2b451	58	print "ok 2\n";
	59
	60	$sock->autoflush(1);
	61	print $sock->getline();
	62
	63	print $sock "ok 4\n";
	64
	65	$sock->close;
	66
	67	waitpid($pid,0);
	68
	69	print "ok 5\n";
61f2b451	70
7a4c00b4	71	} elsif(defined $pid) {
61f2b451	72
	73	$sock = IO::Socket::INET->new(PeerPort => $port,
	74	Proto => 'tcp',
	75	PeerAddr => 'localhost'
9b599b2a	76	)
6e806fe3	77	\|\| IO::Socket::INET->new(PeerPort => $port,
	78	Proto => 'tcp',
	79	PeerAddr => '127.0.0.1'
	80	)
	81	or die "$! (maybe your system does not have a localhost at all, 'localhost' or 127.0.0.1)";
61f2b451	82
61f2b451	83	$sock->autoflush(1);
7a4c00b4	84
61f2b451	85	print $sock "ok 3\n";
7a4c00b4	86
61f2b451	87	print $sock->getline();
7a4c00b4	88
61f2b451	89	$sock->close;
7a4c00b4	90
61f2b451	91	exit;
	92	} else {
	93	die;
	94	}
	95
cf7fe8a2	96	# Test various other ways to create INET sockets that should
cf7fe8a2	97	# also work.
862b0ad8	98	$listen = IO::Socket::INET->new(Listen => '', Timeout => 15) or die "$!";
cf7fe8a2	99	$port = $listen->sockport;
61f2b451	100
cf7fe8a2	101	if($pid = fork()) {
	102	SERVER_LOOP:
	103	while (1) {
	104	last SERVER_LOOP unless $sock = $listen->accept;
	105	while (<$sock>) {
	106	last SERVER_LOOP if /^quit/;
	107	last if /^done/;
	108	print;
	109	}
	110	$sock = undef;
	111	}
	112	$listen->close;
	113	} elsif (defined $pid) {
	114	# child, try various ways to connect
6e806fe3	115	$sock = IO::Socket::INET->new("localhost:$port")
6e806fe3	116	\|\| IO::Socket::INET->new("127.0.0.1:$port");
cf7fe8a2	117	if ($sock) {
	118	print "not " unless $sock->connected;
	119	print "ok 6\n";
	120	$sock->print("ok 7\n");
	121	sleep(1);
	122	print "ok 8\n";
	123	$sock->print("ok 9\n");
	124	$sock->print("done\n");
	125	$sock->close;
	126	}
	127	else {
	128	print "# $@\n";
	129	print "not ok 6\n";
	130	print "not ok 7\n";
	131	print "not ok 8\n";
	132	print "not ok 9\n";
	133	}
	134
	135	# some machines seem to suffer from a race condition here
d6a255e6	136	sleep(2);
cf7fe8a2	137
	138	$sock = IO::Socket::INET->new("127.0.0.1:$port");
	139	if ($sock) {
	140	$sock->print("ok 10\n");
	141	$sock->print("done\n");
	142	$sock->close;
	143	}
	144	else {
	145	print "# $@\n";
	146	print "not ok 10\n";
	147	}
61f2b451	148
cf7fe8a2	149	# some machines seem to suffer from a race condition here
e3e876cf	150	sleep(1);
61f2b451	151
cf7fe8a2	152	$sock = IO::Socket->new(Domain => AF_INET,
6e806fe3	153	PeerAddr => "localhost:$port")
	154	\|\| IO::Socket->new(Domain => AF_INET,
	155	PeerAddr => "127.0.0.1:$port");
cf7fe8a2	156	if ($sock) {
	157	$sock->print("ok 11\n");
	158	$sock->print("quit\n");
9d44748a	159	} else {
9d44748a	160	print "not ok 11\n";
cf7fe8a2	161	}
	162	$sock = undef;
	163	sleep(1);
	164	exit;
	165	} else {
	166	die;
	167	}
	168
	169	# Then test UDP sockets
	170	$server = IO::Socket->new(Domain => AF_INET,
	171	Proto => 'udp',
6e806fe3	172	LocalAddr => 'localhost')
	173	\|\| IO::Socket->new(Domain => AF_INET,
	174	Proto => 'udp',
	175	LocalAddr => '127.0.0.1');
cf7fe8a2	176	$port = $server->sockport;
cf7fe8a2	177
0994c4d0	178	if ($^O eq 'mpeix') {
0994c4d0	179	print("ok 12 # skipped\n")
cf7fe8a2	180	} else {
0994c4d0	181	if ($pid = fork()) {
	182	my $buf;
	183	$server->recv($buf, 100);
	184	print $buf;
	185	} elsif (defined($pid)) {
	186	#child
	187	$sock = IO::Socket::INET->new(Proto => 'udp',
6e806fe3	188	PeerAddr => "localhost:$port")
	189	\|\| IO::Socket::INET->new(Proto => 'udp',
	190	PeerAddr => "127.0.0.1:$port");
0994c4d0	191	$sock->send("ok 12\n");
	192	sleep(1);
	193	$sock->send("ok 12\n"); # send another one to be sure
	194	exit;
	195	} else {
	196	die;
	197	}
cf7fe8a2	198	}
61f2b451	199
cf7fe8a2	200	print "not " unless $server->blocking;
cf7fe8a2	201	print "ok 13\n";
61f2b451	202
cf7fe8a2	203	$server->blocking(0);
	204	print "not " if $server->blocking;
	205	print "ok 14\n";
cf829ab0	206
	207	### TEST 15
	208	### Set up some data to be transfered between the server and
	209	### the client. We'll use own source code ...
	210	#
	211	local @data;
	212	if( !open( SRC, "< $0")) {
	213	print "not ok 15 - $!";
	214	} else {
	215	@data = <SRC>;
	216	close( SRC);
	217	}
	218	print "ok 15\n";
	219
	220	### TEST 16
	221	### Start the server
	222	#
	223	my $listen = IO::Socket::INET->new( Listen => 2, Proto => 'tcp', Timeout => 15) \|\|
	224	print "not ";
	225	print "ok 16\n";
	226	die if( !defined( $listen));
	227	my $serverport = $listen->sockport;
	228
	229	my $server_pid = fork();
	230	if( $server_pid) {
	231
	232	### TEST 17 Client/Server establishment
	233	#
	234	print "ok 17\n";
	235
	236	### TEST 18
	237	### Get data from the server using a single stream
	238	#
	239	$sock = IO::Socket::INET->new("localhost:$serverport")
	240	\|\| IO::Socket::INET->new("127.0.0.1:$serverport");
	241
	242	if ($sock) {
	243	$sock->print("send\n");
	244
	245	my @array = ();
	246	while( <$sock>) {
	247	push( @array, $_);
	248	}
	249
	250	$sock->print("done\n");
	251	$sock->close;
	252
	253	print "not " if( @array != @data);
	254	} else {
	255	print "not ";
	256	}
	257	print "ok 18\n";
	258
	259	### TEST 19
	260	### Get data from the server using a stream, which is
	261	### interrupted by eof calls.
	262	### On perl-5.7.0@7673 this failed in a SOCKS environment, because eof
	263	### did an getc followed by an ungetc in order to check for the streams
	264	### end. getc(3) got replaced by the SOCKS funktion, which ended up in
	265	### a recv(2) call on the socket, while ungetc(3) put back a character
	266	### to an IO buffer, which never again was read.
	267	#
	268	$sock = IO::Socket::INET->new("localhost:$serverport")
	269	\|\| IO::Socket::INET->new("127.0.0.1:$serverport");
270
271	if ($sock) {
272	$sock->print("send\n");
273
274	my @array = ();
275	while( !eof( $sock ) ){
276	while( <$sock>) {
277	push( @array, $_);
278	last;
279	}
280	}
281
282	$sock->print("done\n");
283	$sock->close;
284
285	print "not " if( @array != @data);
286	} else {
287	print "not ";
288	}
289	print "ok 19\n";
290
291	### TEST 20
292	### Stop the server
293	#
294	$sock = IO::Socket::INET->new("localhost:$serverport")
295	\|\| IO::Socket::INET->new("127.0.0.1:$serverport");
296
297	if ($sock) {
298	$sock->print("done\n");
299	$sock->close;
300
301	print "not " if( 1 != kill 0, $server_pid);
302	} else {
303	print "not ";
304	}
305	print "ok 20\n";
306
307	} elsif( defined( $server_pid)) {
308
309	### Child
310	#
311	SERVER_LOOP: while (1) {
312	last SERVER_LOOP unless $sock = $listen->accept;
313	while (<$sock>) {
314	last SERVER_LOOP if /^quit/;
315	last if /^done/;
316	if( /^send/) {
317	print $sock @data;
318	last;
319	}
320	print;
321	}
322	$sock = undef;
323	}
324	$listen->close;
325
326	} else {
327
328	### Fork failed
329	#
330	print "not ok 17\n";
331	die;
332	}
333