1 | #!./perl -w
|
---|
2 |
|
---|
3 | BEGIN {
|
---|
4 | chdir 't' if -d 't';
|
---|
5 | @INC = '../lib';
|
---|
6 | }
|
---|
7 |
|
---|
8 | use Test::More;
|
---|
9 |
|
---|
10 | BEGIN {
|
---|
11 | require Config; import Config;
|
---|
12 | if ($Config{'extensions'} !~ /\bSocket\b/ &&
|
---|
13 | !(($^O eq 'VMS') && $Config{d_socket}))
|
---|
14 | {
|
---|
15 | plan skip_all => "Test uses Socket, Socket not built";
|
---|
16 | }
|
---|
17 | if ($^O eq 'MacOS' || ($^O eq 'irix' && $Config{osvers} == 5)) {
|
---|
18 | plan skip_all => "Test relies on resolution of localhost, fails on $^O ($Config{osvers})";
|
---|
19 | }
|
---|
20 | }
|
---|
21 |
|
---|
22 | use Test::More tests => 7;
|
---|
23 |
|
---|
24 | BEGIN { use_ok 'Net::hostent' }
|
---|
25 |
|
---|
26 | # Remind me to add this to Test::More.
|
---|
27 | sub DIE {
|
---|
28 | print "# @_\n";
|
---|
29 | exit 1;
|
---|
30 | }
|
---|
31 |
|
---|
32 | # test basic resolution of localhost <-> 127.0.0.1
|
---|
33 | use Socket;
|
---|
34 |
|
---|
35 | my $h = gethost('localhost');
|
---|
36 | ok(defined $h, "gethost('localhost')") ||
|
---|
37 | DIE("Can't continue without working gethost: $!");
|
---|
38 |
|
---|
39 | is( inet_ntoa($h->addr), "127.0.0.1", 'addr from gethost' );
|
---|
40 |
|
---|
41 | my $i = gethostbyaddr(inet_aton("127.0.0.1"));
|
---|
42 | ok(defined $i, "gethostbyaddr('127.0.0.1')") ||
|
---|
43 | DIE("Can't continue without working gethostbyaddr: $!");
|
---|
44 |
|
---|
45 | is( inet_ntoa($i->addr), "127.0.0.1", 'addr from gethostbyaddr' );
|
---|
46 |
|
---|
47 | # need to skip the name comparisons on Win32 because windows will
|
---|
48 | # return the name of the machine instead of "localhost" when resolving
|
---|
49 | # 127.0.0.1 or even "localhost"
|
---|
50 |
|
---|
51 | # - VMS returns "LOCALHOST" under tcp/ip services V4.1 ECO 2, possibly others
|
---|
52 | # - OS/390 returns localhost.YADDA.YADDA
|
---|
53 |
|
---|
54 | SKIP: {
|
---|
55 | skip "Windows will return the machine name instead of 'localhost'", 2
|
---|
56 | if $^O eq 'MSWin32' or $^O eq 'NetWare' or $^O eq 'cygwin';
|
---|
57 |
|
---|
58 | print "# name = " . $h->name . ", aliases = " . join (",", @{$h->aliases}) . "\n";
|
---|
59 |
|
---|
60 | my $in_alias;
|
---|
61 | unless ($h->name =~ /^localhost(?:\..+)?$/i) {
|
---|
62 | foreach (@{$h->aliases}) {
|
---|
63 | if (/^localhost(?:\..+)?$/i) {
|
---|
64 | $in_alias = 1;
|
---|
65 | last;
|
---|
66 | }
|
---|
67 | }
|
---|
68 | ok( $in_alias );
|
---|
69 | } else {
|
---|
70 | ok( 1 );
|
---|
71 | }
|
---|
72 |
|
---|
73 | if ($in_alias) {
|
---|
74 | # If we found it in the aliases before, expect to find it there again.
|
---|
75 | foreach (@{$h->aliases}) {
|
---|
76 | if (/^localhost(?:\..+)?$/i) {
|
---|
77 | # This time, clear the flag if we see "localhost"
|
---|
78 | undef $in_alias;
|
---|
79 | last;
|
---|
80 | }
|
---|
81 | }
|
---|
82 | }
|
---|
83 |
|
---|
84 | if( $in_alias ) {
|
---|
85 | like( $i->name, qr/^localhost(?:\..+)?$/i );
|
---|
86 | }
|
---|
87 | else {
|
---|
88 | ok( !$in_alias );
|
---|
89 | print "# " . $h->name . " " . join (",", @{$h->aliases}) . "\n";
|
---|
90 | }
|
---|
91 | }
|
---|