Blame t/Socket.t

Packit Service 098c73
#!./perl
Packit Service 098c73
Packit Service 098c73
BEGIN {
Packit Service 098c73
    require Config; import Config;
Packit Service 098c73
    if ($Config{'extensions'} !~ /\bSocket\b/ && 
Packit Service 098c73
        !(($^O eq 'VMS') && $Config{d_socket})) {
Packit Service 098c73
	print "1..0\n";
Packit Service 098c73
	exit 0;
Packit Service 098c73
    }
Packit Service 098c73
    $has_alarm = $Config{d_alarm};
Packit Service 098c73
}
Packit Service 098c73
	
Packit Service 098c73
use Socket qw(:all);
Packit Service 098c73
use Test::More tests => 6;
Packit Service 098c73
Packit Service 098c73
$has_echo = $^O ne 'MSWin32';
Packit Service 098c73
$alarmed = 0;
Packit Service 098c73
sub arm      { $alarmed = 0; alarm(shift) if $has_alarm }
Packit Service 098c73
sub alarmed  { $alarmed = 1 }
Packit Service 098c73
$SIG{ALRM} = 'alarmed'                    if $has_alarm;
Packit Service 098c73
Packit Service 098c73
SKIP: {
Packit Service 098c73
    unless(socket(T, PF_INET, SOCK_STREAM, IPPROTO_TCP)) {
Packit Service 098c73
	skip "No PF_INET", 3;
Packit Service 098c73
    }
Packit Service 098c73
Packit Service 098c73
    pass "socket(PF_INET)";
Packit Service 098c73
Packit Service 098c73
    arm(5);
Packit Service 098c73
    my $host = $^O eq 'MacOS' || ($^O eq 'irix' && $Config{osvers} == 5) ?
Packit Service 098c73
			 	 '127.0.0.1' : 'localhost';
Packit Service 098c73
    my $localhost = inet_aton($host);
Packit Service 098c73
Packit Service 098c73
    SKIP: {
Packit Service 098c73
	unless($has_echo && defined $localhost && connect(T,pack_sockaddr_in(7,$localhost))) {
Packit Service 098c73
	    skip "Unable to connect to localhost:7", 2;
Packit Service 098c73
	}
Packit Service 098c73
Packit Service 098c73
	arm(0);
Packit Service 098c73
Packit Service 098c73
	pass "PF_INET echo localhost connected";
Packit Service 098c73
Packit Service 098c73
	diag "Connected to " .
Packit Service 098c73
		inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1])."\n";
Packit Service 098c73
Packit Service 098c73
	arm(5);
Packit Service 098c73
	syswrite(T,"hello",5);
Packit Service 098c73
	arm(0);
Packit Service 098c73
Packit Service 098c73
	arm(5);
Packit Service 098c73
	$read = sysread(T,$buff,10);	# Connection may be granted, then closed!
Packit Service 098c73
	arm(0);
Packit Service 098c73
Packit Service 098c73
	while ($read > 0 && length($buff) < 5) {
Packit Service 098c73
	    # adjust for fact that TCP doesn't guarantee size of reads/writes
Packit Service 098c73
	    arm(5);
Packit Service 098c73
	    $read = sysread(T,$buff,10,length($buff));
Packit Service 098c73
	    arm(0);
Packit Service 098c73
	}
Packit Service 098c73
Packit Service 098c73
	ok(($read == 0 || $buff eq "hello"), "PF_INET echo localhost reply");
Packit Service 098c73
    }
Packit Service 098c73
}
Packit Service 098c73
Packit Service 098c73
SKIP: {
Packit Service 098c73
    unless(socket(S, PF_INET, SOCK_STREAM, IPPROTO_TCP)) {
Packit Service 098c73
	skip "No PF_INET", 3;
Packit Service 098c73
    }
Packit Service 098c73
Packit Service 098c73
    pass "socket(PF_INET)";
Packit Service 098c73
Packit Service 098c73
    SKIP: {
Packit Service 098c73
	arm(5);
Packit Service 098c73
	unless($has_echo && connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))) {
Packit Service 098c73
	    skip "Unable to connect to localhost:7", 2;
Packit Service 098c73
	}
Packit Service 098c73
Packit Service 098c73
        arm(0);
Packit Service 098c73
Packit Service 098c73
	pass "PF_INET echo INADDR_LOOPBACK connected";
Packit Service 098c73
Packit Service 098c73
	diag "Connected to " .
Packit Service 098c73
		inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1])."\n";
Packit Service 098c73
Packit Service 098c73
	arm(5);
Packit Service 098c73
	syswrite(S,"olleh",5);
Packit Service 098c73
	arm(0);
Packit Service 098c73
Packit Service 098c73
	arm(5);
Packit Service 098c73
	$read = sysread(S,$buff,10);	# Connection may be granted, then closed!
Packit Service 098c73
	arm(0);
Packit Service 098c73
Packit Service 098c73
	while ($read > 0 && length($buff) < 5) {
Packit Service 098c73
	    # adjust for fact that TCP doesn't guarantee size of reads/writes
Packit Service 098c73
	    arm(5);
Packit Service 098c73
	    $read = sysread(S,$buff,10,length($buff));
Packit Service 098c73
	    arm(0);
Packit Service 098c73
	}
Packit Service 098c73
Packit Service 098c73
	ok(($read == 0 || $buff eq "olleh"), "PF_INET echo INADDR_LOOPBACK reply");
Packit Service 098c73
    }
Packit Service 098c73
}