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