File Coverage

blib/lib/Net/Config.pm
Criterion Covered Total %
statement 30 30 100.0
branch 11 12 91.6
condition n/a
subroutine 6 6 100.0
pod 1 1 100.0
total 48 49 97.9


line stmt bran cond sub pod time code
1             # Net::Config.pm
2             #
3             # Copyright (C) 2000 Graham Barr. All rights reserved.
4             # Copyright (C) 2013-2014, 2016, 2020 Steve Hay. All rights reserved.
5             # This module is free software; you can redistribute it and/or modify it under
6             # the same terms as Perl itself, i.e. under the terms of either the GNU General
7             # Public License or the Artistic License, as specified in the F file.
8              
9             package Net::Config;
10              
11 19     19   89425 use 5.008001;
  19         102  
12              
13 19     19   101 use strict;
  19         36  
  19         447  
14 19     19   95 use warnings;
  19         39  
  19         2287  
15              
16 19     19   97 use Exporter;
  19         34  
  19         2476  
17 19     19   106 use Socket qw(inet_aton inet_ntoa);
  19         87  
  19         18359  
18              
19             our @EXPORT = qw(%NetConfig);
20             our @ISA = qw(Net::LocalCfg Exporter);
21             our $VERSION = "3.15";
22              
23             our($CONFIGURE, $LIBNET_CFG);
24              
25             eval {
26             local @INC = @INC;
27             pop @INC if $INC[-1] eq '.';
28             local $SIG{__DIE__};
29             require Net::LocalCfg;
30             };
31              
32             our %NetConfig = (
33             nntp_hosts => [],
34             snpp_hosts => [],
35             pop3_hosts => [],
36             smtp_hosts => [],
37             ph_hosts => [],
38             daytime_hosts => [],
39             time_hosts => [],
40             inet_domain => undef,
41             ftp_firewall => undef,
42             ftp_ext_passive => 1,
43             ftp_int_passive => 1,
44             test_hosts => 1,
45             test_exist => 1,
46             );
47              
48             #
49             # Try to get as much configuration info as possible from InternetConfig
50             #
51             {
52             ## no critic (BuiltinFunctions::ProhibitStringyEval)
53             $^O eq 'MacOS' and eval <
54             use Mac::InternetConfig;
55              
56             {
57             my %nc = (
58             nntp_hosts => [ \$InternetConfig{ kICNNTPHost() } ],
59             pop3_hosts => [ \$InternetConfig{ kICMailAccount() } =~ /\@(.*)/ ],
60             smtp_hosts => [ \$InternetConfig{ kICSMTPHost() } ],
61             ftp_testhost => \$InternetConfig{ kICFTPHost() } ? \$InternetConfig{ kICFTPHost()} : undef,
62             ph_hosts => [ \$InternetConfig{ kICPhHost() } ],
63             ftp_ext_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0,
64             ftp_int_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0,
65             socks_hosts =>
66             \$InternetConfig{ kICUseSocks() } ? [ \$InternetConfig{ kICSocksHost() } ] : [],
67             ftp_firewall =>
68             \$InternetConfig{ kICUseFTPProxy() } ? [ \$InternetConfig{ kICFTPProxyHost() } ] : [],
69             );
70             \@NetConfig{keys %nc} = values %nc;
71             }
72             TRY_INTERNET_CONFIG
73             }
74              
75             my $file = __FILE__;
76             my $ref;
77             $file =~ s/Config.pm/libnet.cfg/;
78             if (-f $file) {
79             $ref = eval { local $SIG{__DIE__}; do $file };
80             if (ref($ref) eq 'HASH') {
81             %NetConfig = (%NetConfig, %{$ref});
82             $LIBNET_CFG = $file;
83             }
84             }
85             if ($< == $> and !$CONFIGURE) {
86             my $home = eval { local $SIG{__DIE__}; (getpwuid($>))[7] } || $ENV{HOME};
87             $home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH} || '') if defined $ENV{HOMEDRIVE};
88             if (defined $home) {
89             $file = $home . "/.libnetrc";
90             $ref = eval { local $SIG{__DIE__}; do $file } if -f $file;
91             %NetConfig = (%NetConfig, %{$ref})
92             if ref($ref) eq 'HASH';
93             }
94             }
95             my ($k, $v);
96             while (($k, $v) = each %NetConfig) {
97             $NetConfig{$k} = [$v]
98             if ($k =~ /_hosts$/ and $k ne "test_hosts" and defined($v) and !ref($v));
99             }
100              
101             # Take a hostname and determine if it is inside the firewall
102              
103              
104             sub requires_firewall {
105 7     7 1 807 shift; # ignore package
106 7         11 my $host = shift;
107              
108 7 100       21 return 0 unless defined $NetConfig{'ftp_firewall'};
109              
110 6 100       13 $host = inet_aton($host) or return -1;
111 5         76 $host = inet_ntoa($host);
112              
113 5 100       28 if (exists $NetConfig{'local_netmask'}) {
114 4         17 my $quad = unpack("N", pack("C*", split(/\./, $host)));
115 4         8 my $list = $NetConfig{'local_netmask'};
116 4 100       12 $list = [$list] unless ref($list);
117 4         8 foreach (@$list) {
118 6 50       42 my ($net, $bits) = (m#^(\d+\.\d+\.\d+\.\d+)/(\d+)$#) or next;
119 6         14 my $mask = ~0 << (32 - $bits);
120 6         23 my $addr = unpack("N", pack("C*", split(/\./, $net)));
121              
122 6 100       25 return 0 if (($addr & $mask) == ($quad & $mask));
123             }
124 2         10 return 1;
125             }
126              
127 1         4 return 0;
128             }
129              
130             *is_external = \&requires_firewall;
131              
132             1;
133              
134             __END__