1#!./perl 2 3BEGIN { 4 require Config; import Config; 5 if ($Config{'extensions'} !~ /\bSocket\b/ && 6 !(($^O eq 'VMS') && $Config{d_socket})) { 7 print "1..0\n"; 8 exit 0; 9 } 10 $has_alarm = $Config{d_alarm}; 11} 12 13use Socket qw(:all); 14use Test::More tests => 6; 15 16$has_echo = $^O ne 'MSWin32'; 17$alarmed = 0; 18sub arm { $alarmed = 0; alarm(shift) if $has_alarm } 19sub alarmed { $alarmed = 1 } 20$SIG{ALRM} = 'alarmed' if $has_alarm; 21 22SKIP: { 23 unless(socket(T, PF_INET, SOCK_STREAM, IPPROTO_TCP)) { 24 skip "No PF_INET", 3; 25 } 26 27 pass "socket(PF_INET)"; 28 29 arm(5); 30 my $host = $^O eq 'MacOS' || ($^O eq 'irix' && $Config{osvers} == 5) ? 31 '127.0.0.1' : 'localhost'; 32 my $localhost = inet_aton($host); 33 34 SKIP: { 35 unless($has_echo && defined $localhost && connect(T,pack_sockaddr_in(7,$localhost))) { 36 skip "Unable to connect to localhost:7", 2; 37 } 38 39 arm(0); 40 41 pass "PF_INET echo localhost connected"; 42 43 diag "Connected to " . 44 inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1])."\n"; 45 46 arm(5); 47 syswrite(T,"hello",5); 48 arm(0); 49 50 arm(5); 51 $read = sysread(T,$buff,10); # Connection may be granted, then closed! 52 arm(0); 53 54 while ($read > 0 && length($buff) < 5) { 55 # adjust for fact that TCP doesn't guarantee size of reads/writes 56 arm(5); 57 $read = sysread(T,$buff,10,length($buff)); 58 arm(0); 59 } 60 61 ok(($read == 0 || $buff eq "hello"), "PF_INET echo localhost reply"); 62 } 63} 64 65SKIP: { 66 unless(socket(S, PF_INET, SOCK_STREAM, IPPROTO_TCP)) { 67 skip "No PF_INET", 3; 68 } 69 70 pass "socket(PF_INET)"; 71 72 SKIP: { 73 arm(5); 74 unless($has_echo && connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))) { 75 skip "Unable to connect to localhost:7", 2; 76 } 77 78 arm(0); 79 80 pass "PF_INET echo INADDR_LOOPBACK connected"; 81 82 diag "Connected to " . 83 inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1])."\n"; 84 85 arm(5); 86 syswrite(S,"olleh",5); 87 arm(0); 88 89 arm(5); 90 $read = sysread(S,$buff,10); # Connection may be granted, then closed! 91 arm(0); 92 93 while ($read > 0 && length($buff) < 5) { 94 # adjust for fact that TCP doesn't guarantee size of reads/writes 95 arm(5); 96 $read = sysread(S,$buff,10,length($buff)); 97 arm(0); 98 } 99 100 ok(($read == 0 || $buff eq "olleh"), "PF_INET echo INADDR_LOOPBACK reply"); 101 } 102} 103