| 1 | #!./perl -w
|
|---|
| 2 |
|
|---|
| 3 | BEGIN {
|
|---|
| 4 | if ($ENV{PERL_CORE}) {
|
|---|
| 5 | chdir 't' if -d 't';
|
|---|
| 6 | @INC = '../lib';
|
|---|
| 7 | }
|
|---|
| 8 | if (!eval "require Socket") {
|
|---|
| 9 | print "1..0 # no Socket\n"; exit 0;
|
|---|
| 10 | }
|
|---|
| 11 | undef *{Socket::inet_aton};
|
|---|
| 12 | undef *{Socket::inet_ntoa};
|
|---|
| 13 | if (ord('A') == 193 && !eval "require Convert::EBCDIC") {
|
|---|
| 14 | print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0;
|
|---|
| 15 | }
|
|---|
| 16 | $INC{'Socket.pm'} = 1;
|
|---|
| 17 | }
|
|---|
| 18 |
|
|---|
| 19 | package Socket;
|
|---|
| 20 |
|
|---|
| 21 | sub import {
|
|---|
| 22 | my $pkg = caller();
|
|---|
| 23 | no strict 'refs';
|
|---|
| 24 | *{ $pkg . '::inet_aton' } = \&inet_aton;
|
|---|
| 25 | *{ $pkg . '::inet_ntoa' } = \&inet_ntoa;
|
|---|
| 26 | }
|
|---|
| 27 |
|
|---|
| 28 | my $fail = 0;
|
|---|
| 29 | my %names;
|
|---|
| 30 |
|
|---|
| 31 | sub set_fail {
|
|---|
| 32 | $fail = shift;
|
|---|
| 33 | }
|
|---|
| 34 |
|
|---|
| 35 | sub inet_aton {
|
|---|
| 36 | return if $fail;
|
|---|
| 37 | my $num = unpack('N', pack('C*', split(/\./, $_[0])));
|
|---|
| 38 | $names{$num} = $_[0];
|
|---|
| 39 | return $num;
|
|---|
| 40 | }
|
|---|
| 41 |
|
|---|
| 42 | sub inet_ntoa {
|
|---|
| 43 | return if $fail;
|
|---|
| 44 | return $names{$_[0]};
|
|---|
| 45 | }
|
|---|
| 46 |
|
|---|
| 47 | package main;
|
|---|
| 48 |
|
|---|
| 49 |
|
|---|
| 50 | (my $libnet_t = __FILE__) =~ s/config.t/libnet_t.pl/;
|
|---|
| 51 | require $libnet_t;
|
|---|
| 52 |
|
|---|
| 53 | print "1..10\n";
|
|---|
| 54 |
|
|---|
| 55 | use Net::Config;
|
|---|
| 56 | ok( exists $INC{'Net/Config.pm'}, 'Net::Config should have been used' );
|
|---|
| 57 | ok( keys %NetConfig, '%NetConfig should be imported' );
|
|---|
| 58 |
|
|---|
| 59 | Socket::set_fail(1);
|
|---|
| 60 | undef $NetConfig{'ftp_firewall'};
|
|---|
| 61 | is( Net::Config->requires_firewall(), 0,
|
|---|
| 62 | 'requires_firewall() should return 0 without ftp_firewall defined' );
|
|---|
| 63 |
|
|---|
| 64 | $NetConfig{'ftp_firewall'} = 1;
|
|---|
| 65 | is( Net::Config->requires_firewall('a.host.not.there'), -1,
|
|---|
| 66 | '... should return -1 without a valid hostname' );
|
|---|
| 67 |
|
|---|
| 68 | Socket::set_fail(0);
|
|---|
| 69 | delete $NetConfig{'local_netmask'};
|
|---|
| 70 | is( Net::Config->requires_firewall('127.0.0.1'), 0,
|
|---|
| 71 | '... should return 0 without local_netmask defined' );
|
|---|
| 72 |
|
|---|
| 73 | $NetConfig{'local_netmask'} = '127.0.0.1/24';
|
|---|
| 74 | is( Net::Config->requires_firewall('127.0.0.1'), 0,
|
|---|
| 75 | '... should return false if host is within netmask' );
|
|---|
| 76 | is( Net::Config->requires_firewall('192.168.10.0'), 1,
|
|---|
| 77 | '... should return true if host is outside netmask' );
|
|---|
| 78 |
|
|---|
| 79 | # now try more netmasks
|
|---|
| 80 | $NetConfig{'local_netmask'} = [ '127.0.0.1/24', '10.0.0.0/8' ];
|
|---|
| 81 | is( Net::Config->requires_firewall('10.10.255.254'), 0,
|
|---|
| 82 | '... should find success with mutiple local netmasks' );
|
|---|
| 83 | is( Net::Config->requires_firewall('192.168.10.0'), 1,
|
|---|
| 84 | '... should handle failure with multiple local netmasks' );
|
|---|
| 85 |
|
|---|
| 86 | is( \&Net::Config::is_external, \&Net::Config::requires_firewall,
|
|---|
| 87 | 'is_external() should be an alias for requires_firewall()' );
|
|---|