| 1 | #!./perl |
| 2 | |
| 3 | BEGIN { |
| 4 | chdir 't' if -d 't'; |
| 5 | @INC = '../lib'; |
| 6 | require Config; import Config; |
| 7 | if ($Config{'extensions'} !~ /\bSocket\b/ && |
| 8 | !(($^O eq 'VMS') && $Config{d_socket})) { |
| 9 | print "1..0\n"; |
| 10 | exit 0; |
| 11 | } |
| 12 | } |
| 13 | |
| 14 | use Socket; |
| 15 | |
| 16 | print "1..14\n"; |
| 17 | |
| 18 | if (socket(T,PF_INET,SOCK_STREAM,6)) { |
| 19 | print "ok 1\n"; |
| 20 | |
| 21 | if (connect(T,pack_sockaddr_in(7,inet_aton("localhost")))){ |
| 22 | print "ok 2\n"; |
| 23 | |
| 24 | print "# Connected to " . |
| 25 | inet_ntoa((unpack_sockaddr_in(getpeername(T)))[1])."\n"; |
| 26 | |
| 27 | syswrite(T,"hello",5); |
| 28 | $read = sysread(T,$buff,10); # Connection may be granted, then closed! |
| 29 | while ($read > 0 && length($buff) < 5) { |
| 30 | # adjust for fact that TCP doesn't guarantee size of reads/writes |
| 31 | $read = sysread(T,$buff,10,length($buff)); |
| 32 | } |
| 33 | print(($read == 0 || $buff eq "hello") ? "ok 3\n" : "not ok 3\n"); |
| 34 | } |
| 35 | else { |
| 36 | print "# You're allowed to fail tests 2 and 3 if\n"; |
| 37 | print "# the echo service has been disabled.\n"; |
| 38 | print "# $!\n"; |
| 39 | print "ok 2\n"; |
| 40 | print "ok 3\n"; |
| 41 | } |
| 42 | } |
| 43 | else { |
| 44 | print "# $!\n"; |
| 45 | print "not ok 1\n"; |
| 46 | } |
| 47 | |
| 48 | if( socket(S,PF_INET,SOCK_STREAM,6) ){ |
| 49 | print "ok 4\n"; |
| 50 | |
| 51 | if (connect(S,pack_sockaddr_in(7,INADDR_LOOPBACK))){ |
| 52 | print "ok 5\n"; |
| 53 | |
| 54 | print "# Connected to " . |
| 55 | inet_ntoa((unpack_sockaddr_in(getpeername(S)))[1])."\n"; |
| 56 | |
| 57 | syswrite(S,"olleh",5); |
| 58 | $read = sysread(S,$buff,10); # Connection may be granted, then closed! |
| 59 | while ($read > 0 && length($buff) < 5) { |
| 60 | # adjust for fact that TCP doesn't guarantee size of reads/writes |
| 61 | $read = sysread(S,$buff,10,length($buff)); |
| 62 | } |
| 63 | print(($read == 0 || $buff eq "olleh") ? "ok 6\n" : "not ok 6\n"); |
| 64 | } |
| 65 | else { |
| 66 | print "# You're allowed to fail tests 5 and 6 if\n"; |
| 67 | print "# the echo service has been disabled.\n"; |
| 68 | print "# $!\n"; |
| 69 | print "ok 5\n"; |
| 70 | print "ok 6\n"; |
| 71 | } |
| 72 | } |
| 73 | else { |
| 74 | print "# $!\n"; |
| 75 | print "not ok 4\n"; |
| 76 | } |
| 77 | |
| 78 | # warnings |
| 79 | $SIG{__WARN__} = sub { |
| 80 | ++ $w if $_[0] =~ /^6-ARG sockaddr_in call is deprecated/ ; |
| 81 | } ; |
| 82 | $w = 0 ; |
| 83 | sockaddr_in(1,2,3,4,5,6) ; |
| 84 | print ($w == 1 ? "not ok 7\n" : "ok 7\n") ; |
| 85 | use warnings 'Socket' ; |
| 86 | sockaddr_in(1,2,3,4,5,6) ; |
| 87 | print ($w == 1 ? "ok 8\n" : "not ok 8\n") ; |
| 88 | |
| 89 | # Thest that whatever we give into pack/unpack_sockaddr retains |
| 90 | # the value thru the entire chain. |
| 91 | if((inet_ntoa((unpack_sockaddr_in(pack_sockaddr_in(100,inet_aton("10.250.230.10"))))[1])) eq '10.250.230.10') { |
| 92 | print "ok 9\n"; |
| 93 | } else { |
| 94 | print "not ok 9\n"; |
| 95 | } |
| 96 | print ((inet_ntoa(inet_aton("10.20.30.40")) eq "10.20.30.40") ? "ok 10\n" : "not ok 10\n"); |
| 97 | print ((inet_ntoa(v10.20.30.40) eq "10.20.30.40") ? "ok 11\n" : "not ok 11\n"); |
| 98 | { |
| 99 | my ($port,$addr) = unpack_sockaddr_in(pack_sockaddr_in(100,v10.10.10.10)); |
| 100 | print (($port == 100) ? "ok 12\n" : "not ok 12\n"); |
| 101 | print ((inet_ntoa($addr) eq "10.10.10.10") ? "ok 13\n" : "not ok 13\n"); |
| 102 | } |
| 103 | |
| 104 | eval { inet_ntoa(v10.20.30.400) }; |
| 105 | print (($@ =~ /^Wide character in Socket::inet_ntoa at/) ? "ok 14\n" : "not ok 14\n"); |