diff options
author | Graham Barr <gbarr@pobox.com> | 1998-10-16 00:28:03 +0000 |
---|---|---|
committer | Graham Barr <gbarr@pobox.com> | 1998-10-16 00:28:03 +0000 |
commit | aab814f73e6a906df0d737fb0e649fe7470a8d29 (patch) | |
tree | 3294c2850864bbc2c9487af2ef9d8268028264c7 | |
parent | 07376c0fae6b0341fe8d9c76c34d1290b9f43679 (diff) | |
download | perl-libnet-aab814f73e6a906df0d737fb0e649fe7470a8d29.tar.gz |
Net::Config added
Configure, Makefile.PL - Canges to handle new Net::Config module
-rwxr-xr-x | Configure | 138 | ||||
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | Makefile.PL | 6 | ||||
-rw-r--r-- | Net/Config.pm | 205 |
4 files changed, 299 insertions, 51 deletions
@@ -16,7 +16,7 @@ use vars qw($opt_d $opt_o); my %cfg = (); my @cfg = (); -my($config_pm,$msg,$ans,$def,$have_old); +my($libnet_cfg,$msg,$ans,$def,$have_old); ## ## @@ -152,6 +152,48 @@ sub get_bool ($$) ## ## +sub get_netmask ($$) +{ + my($prompt,$def) = @_; + my @mask; + my $pat = join('\.',('([01]\d{0,2}|2[0-4]\d?|25[0-5]|[2-9]\d?)')x4) + . '/([012]\d?|3[01]|[0-9])'; + chomp($prompt); + + my %list; + @list{@$def} = (); + while(1) + { + my $bad = 0; + my $ans = Prompt($prompt) or last; + + $ans =~ s/(\A\s+|\s+\Z)//g; + + if($ans eq '*') + { + %list = (); + next; + } + my $del = $ans =~ s/^-\s*//; +##FIXME + @mask = split(/\s+/, $ans); + return undef unless @mask; + foreach (@mask) + { + next if /^($pat)$/o; + warn "Bad netmask '$_'\n"; + $bad++; + } + last unless $bad; + } + + \@mask; +} + +## +## +## + sub default_hostname { my $host; @@ -176,17 +218,21 @@ sub default_hostname getopts('do:'); -$config_pm = "libnet.cfg" - unless(defined($config_pm = $opt_o)); - -$have_old = -f $config_pm - ? require $config_pm - : eval { require Net::Config }; +$libnet_cfg = "libnet.cfg" + unless(defined($libnet_cfg = $opt_o)); my %oldcfg = (); -%oldcfg = %Net::Config::NetConfig - if $have_old; +$Net::Config::CONFIGURE = 1; # Suppress load of user overrides +if( -f $libnet_cfg ) + { + %oldcfg = ( %{ do $libnet_cfg } ); + } +elsif (eval { require Net::Config }) + { + $have_old = 1; + %oldcfg = %Net::Config::NetConfig; + } map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg; @@ -195,7 +241,7 @@ $oldcfg{'test_hosts'} = 1 unless exists $oldcfg{'test_hosts'}; #--------------------------------------------------------------------------- -if(!-f $config_pm && $have_old && !$opt_d) +if($have_old && !$opt_d) { $msg = <<EDQ; @@ -324,6 +370,33 @@ $cfg{'ftp_firewall'} = get_hostname($msg,$def); #--------------------------------------------------------------------------- +if (defined $cfg{'ftp_firewall'}) + { + print <<EDQ; + +Sometime a hostname lookup is sufficient to determine if a host is inside +a firewall, but this is not foolproof. To make this funtion more acurate +I need to know netmasks for your local network. + +EDQ +$def = []; +if(ref($oldcfg{'local_netmask'})) + { + $def = $oldcfg{'local_netmask'}; + print "Your current netmasks are :\n\n\t", + join("\n\t",@{$def}),"\n\n; + } + +print "Enter one netmask at each prompt, prefix with a - to remove +a netmask from the list` enter a '*' to clear the whole list +and an emty line to continue with Configure."; + + my $mask = get_netmask("netmask :",$def); + $cfg{'local_netmask'} = $mask if ref($mask) && @$mask; + } + +#--------------------------------------------------------------------------- + ###$msg =<<EDQ; ### ###SOCKS is a commonly used firewall protocol. If you use SOCKS firewalls @@ -407,32 +480,12 @@ print "\n"; #--------------------------------------------------------------------------- -my @old = (); - -if($have_old && exists $INC{$config_pm}) { - my $fh = IO::File->new($INC{$config_pm}, "r"); - @old = $fh->getlines; - while(@old) { - last if(shift(@old) =~ /^%NetConfig/); - } - while(@old) { - last if(pop(@old) =~ /^\s*\);/); - } - pop @old - while(@old && $old[-1] !~ /[^\w\n]/); - $old[-1] =~ s/,?\s*\n/,\n/ - if @old; - $fh->close; -} - -my $fh = IO::File->new($config_pm, "w") or - die "Cannot create `$config_pm': $!"; +my $fh = IO::File->new($libnet_cfg, "w") or + die "Cannot create `$libnet_cfg': $!"; -print "Writing $config_pm\n"; +print "Writing $libnet_cfg\n"; -$fh->print(<DATA>, - "\%NetConfig = (\n", - @old); +print $fh "{\n"; my $key; foreach $key (keys %cfg) { @@ -453,12 +506,12 @@ foreach $key (keys %cfg) { } else { $val =~ s/'/\'/sog; - $val = "'" . $val . "'"; + $val = "'" . $val . "'" if $val =~ /\D/; } - $fh->print("\t",$key," => ",$val,",\n"); + print $fh "\t'",$key,"' => ",$val,",\n"; } -$fh->print(");\n1;\n"); +print $fh "}\n"; $fh->close; @@ -466,14 +519,3 @@ $fh->close; ############################################################################ exit 0; - -__DATA__ -package Net::Config; - -require Exporter; -use vars qw(@ISA @EXPORT %NetConfig); -use strict; - -@EXPORT = qw(%NetConfig); -@ISA = qw(Exporter); - @@ -37,3 +37,4 @@ t/nntp.t t/ph.t t/require.t t/smtp.t +Net/Config.pm diff --git a/Makefile.PL b/Makefile.PL index b47067a..7d7f0a0 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -53,20 +53,20 @@ sub MY::post_initialize #--- Create Net::Config -my $config_pm = "Net/Config.pm"; +my $config_pm = "Net/libnet.cfg"; my $libnet_cfg = "libnet.cfg"; # Use %INC and ExtUtils::MakeMaker to determine how this machine # maps package names to path names foreach (keys %INC) { - last if ($config_pm = $_) =~ s/^ExtUtils(.)MakeMaker/Net${1}Config/; + last if ($config_pm = $_) =~ s/^ExtUtils(.)MakeMaker.pm/Net${1}libnet.cfg/; } system(($^O eq 'VMS' ? 'mcr ': ()),$^X, 'Configure') unless -f $libnet_cfg; - $self->{PM}->{$libnet_cfg} = $self->catfile('$(INST_ARCHLIBDIR)',$config_pm); + $self->{PM}->{$libnet_cfg} = $self->catfile('$(INST_LIBDIR)',$config_pm); ""; } diff --git a/Net/Config.pm b/Net/Config.pm new file mode 100644 index 0000000..4c1812c --- /dev/null +++ b/Net/Config.pm @@ -0,0 +1,205 @@ +package Net::Config; + +require Exporter; +use vars qw(@ISA @EXPORT %NetConfig $VERSION $CONFIGURE $LIBNET_CFG); +use strict; + +@EXPORT = qw(%NetConfig); +@ISA = qw(Net::LocalCfg Exporter); +$VERSION = "1.00"; + +eval { 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, +); + +my $file = __FILE__; +my $ref; +$file =~ s/Config.pm/libnet.cfg/; +if ( -f $file ) { + $ref = eval { do $file }; + if (ref($ref) eq 'HASH') { + %NetConfig = (%NetConfig, %{ $ref }); + $LIBNET_CFG = $file; + } +} +if ($< == $> and !$CONFIGURE) { + my $home = eval { (getpwuid($>))[7] } || $ENV{HOME}; + $file = $home . "/.libnetrc"; + $ref = eval { do $file } if -f $file; + %NetConfig = (%NetConfig, %{ $ref }) + if ref($ref) eq 'HASH'; +} +my ($k,$v); +while(($k,$v) = each %NetConfig) { + $v = [ $v ] + if($k =~ /_hosts$/ && !ref($v)); +} + +# Take a hostname and determine if it is inside te firewall +sub is_external { + 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(".",$host))); + + return 0 if (($addr & $mask) == ($quad & $mask)); + } + return 1; + } + + return 0; +} + +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 +distribuion. During installation you will be asked for these values. + +The configuration data is held globally in a file in the perl installation +tree, but a user may override any of these values by providing thier own. This +can be done by having a C<.libnetrc> file in thier home directory. This file +should return a reference to a HASH containing the keys described below. +For example + + # .libnetrc + { + nntp_hosts => [ "my_prefered_host" ], + ph_hosts => [ "my_ph_server" ], + } + __END__ + +=head1 METHODS + +C<Net::Config> defines the following methods. They are methods as they are +invoked as class methods. This is because C<Net::Config> inherits from +C<Net::LocalCfg> so you can override these methods if you want. + +=over 4 + +=item is_external HOST + +Attempts to determine if a given host is outside your firewall. Possible +return values are. + + -1 Cannot lookup hostname + 0 Host is inside firewall (or there is not ftp_firewall entry) + 1 Host is outside the firewall + +This is done by using hostanme lookup and the C<local_netmask> entry in +the configuration data. + +=back + +=head1 NetConfig VALUES + +=over 4 + +=item nntp_hosts + +=item snpp_hosts + +=item pop3_hosts + +=item smtp_hosts + +=item ph_hosts + +=item daytime_hosts + +=item time_hosts + +Each is a reference to an array of hostnames (in order of preference), +which should be used for the given protocol + +=item inet_domain + +Your internet domain name + +=item ftp_firewall + +If you have an FTP proxy firewall (B<NOT> a HTTP or SOCKS firewall) +then this value should be set to the firewall hostname. If your firewall +does not listen to port 21, then this value should be set to +C<"hostname:port"> (eg C<"hostname:99">) + +=item ftp_ext_passive + +=item ftp_int_pasive + +FTP servers normally work on a non-passive mode. That is when you want to +transfer data you have to tell the server the address and port to +connect to. + +With some firewalls this does not work as te server cannot +connect to your machine (because you are beind a firewall) and the firewall +does not re-write te command. In this case you should set C<ftp_ext_passive> +to a I<true> value. + +Some servers are configured to only work in passive mode. If you have +one of these you can force C<Net::FTP> to always transfer in passive +mode, when not going via a firewall, by cetting C<ftp_int_passive> to +a I<true> value. + +=item local_netmask + +A reference to a list of netmask strings in the form C<"134.99.4.0/24">. +These are used by the C<is_external> function to determine if a given +host is inside or outside your firewall. + +=back + +The following entries are used during installation & testing on the +libnet package + +=over 4 + +=item test_hosts + +If true them C<make test> may attempt to connect to hosts given in the +configuration. + +=item test_exists + +If true the C<Configure> will check each hostname given that it exists + +=back + +=cut |