perl_mlb
view release on metacpan or search on metacpan
Net/Config.pm view on Meta::CPAN
use Socket qw(inet_aton inet_ntoa);
use strict;
@EXPORT = qw(%NetConfig);
@ISA = qw(Net::LocalCfg Exporter);
$VERSION = "1.10"; # $Id: //depot/libnet/Net/Config.pm#17 $
eval { local $SIG{__DIE__}; require Net::LocalCfg };
%NetConfig = (
nntp_hosts => [],
snpp_hosts => [],
pop3_hosts => [],
smtp_hosts => [],
ph_hosts => [],
daytime_hosts => [],
time_hosts => [],
inet_domain => undef,
ftp_firewall => undef,
ftp_ext_passive => 0,
ftp_int_passive => 0,
test_hosts => 1,
test_exist => 1,
);
#
# Try to get as much configuration info as possible from InternetConfig
#
$^O eq 'MacOS' and eval <<TRY_INTERNET_CONFIG;
use Mac::InternetConfig;
{
my %nc = (
nntp_hosts => [ \$InternetConfig{ kICNNTPHost() } ],
pop3_hosts => [ \$InternetConfig{ kICMailAccount() } =~ /\@(.*)/ ],
smtp_hosts => [ \$InternetConfig{ kICSMTPHost() } ],
ftp_testhost => \$InternetConfig{ kICFTPHost() } ? \$InternetConfig{ kICFTPHost()} : undef,
ph_hosts => [ \$InternetConfig{ kICPhHost() } ],
ftp_ext_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0,
ftp_int_passive => \$InternetConfig{"646F676F\xA5UsePassiveMode"} || 0,
socks_hosts =>
\$InternetConfig{ kICUseSocks() } ? [ \$InternetConfig{ kICSocksHost() } ] : [],
ftp_firewall =>
\$InternetConfig{ kICUseFTPProxy() } ? [ \$InternetConfig{ kICFTPProxyHost() } ] : [],
);
\@NetConfig{keys %nc} = values %nc;
}
TRY_INTERNET_CONFIG
my $file = __FILE__;
my $ref;
$file =~ s/Config.pm/libnet.cfg/;
if ( -f $file ) {
$ref = eval { local $SIG{__DIE__}; do $file };
if (ref($ref) eq 'HASH') {
%NetConfig = (%NetConfig, %{ $ref });
$LIBNET_CFG = $file;
}
}
if ($< == $> and !$CONFIGURE) {
my $home = eval { local $SIG{__DIE__}; (getpwuid($>))[7] } || $ENV{HOME};
$home ||= $ENV{HOMEDRIVE} . ($ENV{HOMEPATH}||'') if defined $ENV{HOMEDRIVE};
if (defined $home) {
$file = $home . "/.libnetrc";
$ref = eval { local $SIG{__DIE__}; do $file } if -f $file;
%NetConfig = (%NetConfig, %{ $ref })
if ref($ref) eq 'HASH';
}
}
my ($k,$v);
while(($k,$v) = each %NetConfig) {
$NetConfig{$k} = [ $v ]
if($k =~ /_hosts$/ and $k ne "test_hosts" and defined($v) and !ref($v));
}
# Take a hostname and determine if it is inside the firewall
sub requires_firewall {
shift; # ignore package
my $host = shift;
return 0 unless defined $NetConfig{'ftp_firewall'};
$host = inet_aton($host) or return -1;
$host = inet_ntoa($host);
if(exists $NetConfig{'local_netmask'}) {
my $quad = unpack("N",pack("C*",split(/\./,$host)));
my $list = $NetConfig{'local_netmask'};
$list = [$list] unless ref($list);
foreach (@$list) {
my($net,$bits) = (m#^(\d+\.\d+\.\d+\.\d+)/(\d+)$#) or next;
my $mask = ~0 << (32 - $bits);
my $addr = unpack("N",pack("C*",split(/\./,$net)));
return 0 if (($addr & $mask) == ($quad & $mask));
}
return 1;
}
return 0;
}
use vars qw(*is_external);
*is_external = \&requires_firewall;
1;
__END__
=head1 NAME
Net::Config - Local configuration data for libnet
=head1 SYNOPSYS
use Net::Config qw(%NetConfig);
=head1 DESCRIPTION
C<Net::Config> holds configuration data for the modules in the libnet
( run in 0.542 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )