about summary refs log tree commit
diff options
context:
space:
mode:
authorGraham Barr <gbarr@pobox.com>1998-10-16 00:28:03 +0000
committerGraham Barr <gbarr@pobox.com>1998-10-16 00:28:03 +0000
commitaab814f73e6a906df0d737fb0e649fe7470a8d29 (patch)
tree3294c2850864bbc2c9487af2ef9d8268028264c7
parent07376c0fae6b0341fe8d9c76c34d1290b9f43679 (diff)
downloadperl-libnet-aab814f73e6a906df0d737fb0e649fe7470a8d29.tar.gz
Net::Config added
Configure, Makefile.PL
- Canges to handle new Net::Config module

-rwxr-xr-xConfigure138
-rw-r--r--MANIFEST1
-rw-r--r--Makefile.PL6
-rw-r--r--Net/Config.pm205
4 files changed, 299 insertions, 51 deletions
diff --git a/Configure b/Configure
index 0a78a61..b2245e1 100755
--- a/Configure
+++ b/Configure
@@ -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);
-
diff --git a/MANIFEST b/MANIFEST
index 08ab9e6..953a5f8 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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