lib/Net/t/config.t

   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()' );