You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
604 lines
13 KiB
604 lines
13 KiB
#!perl
|
|
|
|
#
|
|
# $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $
|
|
|
|
use strict;
|
|
use IO::File;
|
|
use Getopt::Std;
|
|
use ExtUtils::MakeMaker qw(prompt);
|
|
|
|
use vars qw($opt_d $opt_o);
|
|
use Config;
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
my %cfg = ();
|
|
my @cfg = ();
|
|
|
|
my($libnet_cfg,$msg,$ans,$def,$have_old);
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
sub valid_host
|
|
{
|
|
my $h = shift;
|
|
|
|
defined($h) && (($cfg{'test_exist'} == 0) || gethostbyname($h));
|
|
}
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
sub test_hostnames (\@)
|
|
{
|
|
my $hlist = shift;
|
|
my @h = ();
|
|
my $host;
|
|
my $err = 0;
|
|
|
|
foreach $host (@$hlist)
|
|
{
|
|
if(valid_host($host))
|
|
{
|
|
push(@h, $host);
|
|
next;
|
|
}
|
|
warn "Bad hostname: '$host'\n";
|
|
$err++;
|
|
}
|
|
@$hlist = @h;
|
|
$err ? join(" ",@h) : undef;
|
|
}
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
sub Prompt
|
|
{
|
|
my($prompt,$def) = @_;
|
|
|
|
$def = "" unless defined $def;
|
|
|
|
chomp($prompt);
|
|
|
|
if($opt_d)
|
|
{
|
|
print $prompt,," [",$def,"]\n";
|
|
return $def;
|
|
}
|
|
prompt($prompt,$def);
|
|
}
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
sub get_host_list
|
|
{
|
|
my($prompt,$def) = @_;
|
|
|
|
$def = join(" ",@$def) if ref($def);
|
|
|
|
my @hosts;
|
|
|
|
do
|
|
{
|
|
my $ans = Prompt($prompt,$def);
|
|
|
|
$ans =~ s/(\A\s+|\s+\Z)//g;
|
|
|
|
@hosts = split(/\s+/, $ans);
|
|
}
|
|
while(@hosts && defined($def = test_hostnames(@hosts)));
|
|
|
|
\@hosts;
|
|
}
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
sub get_hostname
|
|
{
|
|
my($prompt,$def) = @_;
|
|
|
|
my $host;
|
|
|
|
while(1)
|
|
{
|
|
my $ans = Prompt($prompt,$def);
|
|
$host = ($ans =~ /(\S*)/)[0];
|
|
last
|
|
if(!length($host) || valid_host($host));
|
|
|
|
$def =""
|
|
if $def eq $host;
|
|
|
|
print <<"EDQ";
|
|
|
|
*** ERROR:
|
|
Hostname `$host' does not seem to exist, please enter again
|
|
or a single space to clear any default
|
|
|
|
EDQ
|
|
}
|
|
|
|
length $host
|
|
? $host
|
|
: undef;
|
|
}
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
sub get_bool ($$)
|
|
{
|
|
my($prompt,$def) = @_;
|
|
|
|
chomp($prompt);
|
|
|
|
my $val = Prompt($prompt,$def ? "yes" : "no");
|
|
|
|
$val =~ /^y/i ? 1 : 0;
|
|
}
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
sub get_netmask ($$)
|
|
{
|
|
my($prompt,$def) = @_;
|
|
|
|
chomp($prompt);
|
|
|
|
my %list;
|
|
@list{@$def} = ();
|
|
|
|
MASK:
|
|
while(1) {
|
|
my $bad = 0;
|
|
my $ans = Prompt($prompt) or last;
|
|
|
|
if($ans eq '*') {
|
|
%list = ();
|
|
next;
|
|
}
|
|
|
|
if($ans eq '=') {
|
|
print "\n",( %list ? join("\n", sort keys %list) : 'none'),"\n\n";
|
|
next;
|
|
}
|
|
|
|
unless ($ans =~ m{^\s*(?:(-?\s*)(\d+(?:\.\d+){0,3})/(\d+))}) {
|
|
warn "Bad netmask '$ans'\n";
|
|
next;
|
|
}
|
|
|
|
my($remove,$bits,@ip) = ($1,$3,split(/\./, $2),0,0,0);
|
|
if ( $ip[0] < 1 || $bits < 1 || $bits > 32) {
|
|
warn "Bad netmask '$ans'\n";
|
|
next MASK;
|
|
}
|
|
foreach my $byte (@ip) {
|
|
if ( $byte > 255 ) {
|
|
warn "Bad netmask '$ans'\n";
|
|
next MASK;
|
|
}
|
|
}
|
|
|
|
my $mask = sprintf("%d.%d.%d.%d/%d",@ip[0..3],$bits);
|
|
|
|
if ($remove) {
|
|
delete $list{$mask};
|
|
}
|
|
else {
|
|
$list{$mask} = 1;
|
|
}
|
|
|
|
}
|
|
|
|
[ keys %list ];
|
|
}
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
sub default_hostname
|
|
{
|
|
my $host;
|
|
my @host;
|
|
|
|
foreach $host (@_)
|
|
{
|
|
if(defined($host) && valid_host($host))
|
|
{
|
|
return $host
|
|
unless wantarray;
|
|
push(@host,$host);
|
|
}
|
|
}
|
|
|
|
return wantarray ? @host : undef;
|
|
}
|
|
|
|
##
|
|
##
|
|
##
|
|
|
|
getopts('do:');
|
|
|
|
$libnet_cfg = "$Config{installsitelib}/Net/libnet.cfg"
|
|
unless(defined($libnet_cfg = $opt_o));
|
|
|
|
my %oldcfg = ();
|
|
|
|
$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;
|
|
|
|
$oldcfg{'test_exist'} = 1 unless exists $oldcfg{'test_exist'};
|
|
$oldcfg{'test_hosts'} = 1 unless exists $oldcfg{'test_hosts'};
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
if($have_old && !$opt_d)
|
|
{
|
|
$msg = <<EDQ;
|
|
|
|
Ah, I see you already have installed libnet before.
|
|
|
|
Do you want to modify/update your configuration (y|n) ?
|
|
EDQ
|
|
|
|
$opt_d = 1
|
|
unless get_bool($msg,0);
|
|
}
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = <<EDQ;
|
|
|
|
This script will prompt you to enter hostnames that can be used as
|
|
defaults for some of the modules in the libnet distribution.
|
|
|
|
To ensure that you do not enter an invalid hostname, I can perform a
|
|
lookup on each hostname you enter. If your internet connection is via
|
|
a dialup line then you may not want me to perform these lookups, as
|
|
it will require you to be on-line.
|
|
|
|
Do you want me to perform hostname lookups (y|n) ?
|
|
EDQ
|
|
|
|
$cfg{'test_exist'} = get_bool($msg, $oldcfg{'test_exist'});
|
|
|
|
print <<EDQ unless $cfg{'test_exist'};
|
|
|
|
*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
|
|
|
|
OK I will not check if the hostnames you give are valid
|
|
so be very cafeful
|
|
|
|
*** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
|
|
EDQ
|
|
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
print <<EDQ;
|
|
|
|
The following questions all require a list of host names, separated
|
|
with spaces. If you do not have a host available for any of the
|
|
services, then enter a single space, followed by <CR>. To accept the
|
|
default, hit <CR>
|
|
|
|
EDQ
|
|
|
|
$msg = 'Enter a list of available NNTP hosts :';
|
|
|
|
$def = $oldcfg{'nntp_hosts'} ||
|
|
[ default_hostname($ENV{NNTPSERVER},$ENV{NEWSHOST},'news') ];
|
|
|
|
$cfg{'nntp_hosts'} = get_host_list($msg,$def);
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = 'Enter a list of available SMTP hosts :';
|
|
|
|
$def = $oldcfg{'smtp_hosts'} ||
|
|
[ default_hostname(split(/:/,$ENV{SMTPHOSTS} || ""), 'mailhost') ];
|
|
|
|
$cfg{'smtp_hosts'} = get_host_list($msg,$def);
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = 'Enter a list of available POP3 hosts :';
|
|
|
|
$def = $oldcfg{'pop3_hosts'} || [];
|
|
|
|
$cfg{'pop3_hosts'} = get_host_list($msg,$def);
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = 'Enter a list of available SNPP hosts :';
|
|
|
|
$def = $oldcfg{'snpp_hosts'} || [];
|
|
|
|
$cfg{'snpp_hosts'} = get_host_list($msg,$def);
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = 'Enter a list of available PH Hosts :' ;
|
|
|
|
$def = $oldcfg{'ph_hosts'} ||
|
|
[ default_hostname('dirserv') ];
|
|
|
|
$cfg{'ph_hosts'} = get_host_list($msg,$def);
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = 'Enter a list of available TIME Hosts :' ;
|
|
|
|
$def = $oldcfg{'time_hosts'} || [];
|
|
|
|
$cfg{'time_hosts'} = get_host_list($msg,$def);
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = 'Enter a list of available DAYTIME Hosts :' ;
|
|
|
|
$def = $oldcfg{'daytime_hosts'} || $oldcfg{'time_hosts'};
|
|
|
|
$cfg{'daytime_hosts'} = get_host_list($msg,$def);
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = <<EDQ;
|
|
|
|
Do you have a firewall/ftp proxy between your machine and the internet
|
|
|
|
If you use a SOCKS firewall answer no
|
|
|
|
(y|n) ?
|
|
EDQ
|
|
|
|
if(get_bool($msg,0)) {
|
|
|
|
$msg = <<'EDQ';
|
|
What series of FTP commands do you need to send to your
|
|
firewall to connect to an external host.
|
|
|
|
user/pass => external user & password
|
|
fwuser/fwpass => firewall user & password
|
|
|
|
0) None
|
|
1) -----------------------
|
|
USER [email protected]
|
|
PASS pass
|
|
2) -----------------------
|
|
USER fwuser
|
|
PASS fwpass
|
|
USER [email protected]
|
|
PASS pass
|
|
3) -----------------------
|
|
USER fwuser
|
|
PASS fwpass
|
|
SITE remote.site
|
|
USER user
|
|
PASS pass
|
|
4) -----------------------
|
|
USER fwuser
|
|
PASS fwpass
|
|
OPEN remote.site
|
|
USER user
|
|
PASS pass
|
|
5) -----------------------
|
|
USER user@[email protected]
|
|
PASS pass@fwpass
|
|
6) -----------------------
|
|
USER [email protected]
|
|
PASS fwpass
|
|
USER user
|
|
PASS pass
|
|
7) -----------------------
|
|
USER [email protected]
|
|
PASS pass
|
|
AUTH fwuser
|
|
RESP fwpass
|
|
|
|
Choice:
|
|
EDQ
|
|
$def = exists $oldcfg{'ftp_firewall_type'} ? $oldcfg{'ftp_firewall_type'} : 1;
|
|
$ans = Prompt($msg,$def);
|
|
$cfg{'ftp_firewall_type'} = 0+$ans;
|
|
$def = $oldcfg{'ftp_firewall'} || $ENV{FTP_FIREWALL};
|
|
|
|
$cfg{'ftp_firewall'} = get_hostname("FTP proxy hostname :", $def);
|
|
}
|
|
else {
|
|
delete $cfg{'ftp_firewall'};
|
|
}
|
|
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
if (defined $cfg{'ftp_firewall'})
|
|
{
|
|
print <<EDQ;
|
|
|
|
By default Net::FTP assumes that it only needs to use a firewall if it
|
|
cannot resolve the name of the host given. This only works if your DNS
|
|
system is setup to only resolve internal hostnames. If this is not the
|
|
case and your DNS will resolve external hostnames, then another method
|
|
is needed. Net::Config can do this if you provide the netmasks that
|
|
describe your internal network. Each netmask should be entered in the
|
|
form x.x.x.x/y, for example 127.0.0.0/8 or 214.8.16.32/24
|
|
|
|
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, an '=' to show the
|
|
current list and an empty 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
|
|
###then enter a list of hostames
|
|
###
|
|
###Enter a list of available SOCKS hosts :
|
|
###EDQ
|
|
###
|
|
###$def = $cfg{'socks_hosts'} ||
|
|
### [ default_hostname($ENV{SOCKS5_SERVER},
|
|
### $ENV{SOCKS_SERVER},
|
|
### $ENV{SOCKS4_SERVER}) ];
|
|
###
|
|
###$cfg{'socks_hosts'} = get_host_list($msg,$def);
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
print <<EDQ;
|
|
|
|
Normally when FTP needs a data connection the client tells the server
|
|
a port to connect to, and the server initiates a connection to the client.
|
|
|
|
Some setups, in particular firewall setups, can/do not work using this
|
|
protocol. In these situations the client must make the connection to the
|
|
server, this is called a passive transfer.
|
|
EDQ
|
|
|
|
if (defined $cfg{'ftp_firewall'}) {
|
|
$msg = "\nShould all FTP connections via a firewall/proxy be passive (y|n) ?";
|
|
|
|
$def = $oldcfg{'ftp_ext_passive'} || 0;
|
|
|
|
$cfg{'ftp_ext_passive'} = get_bool($msg,$def);
|
|
|
|
$msg = "\nShould all other FTP connections be passive (y|n) ?";
|
|
|
|
}
|
|
else {
|
|
$msg = "\nShould all FTP connections be passive (y|n) ?";
|
|
}
|
|
|
|
$def = $oldcfg{'ftp_int_passive'} || 0;
|
|
|
|
$cfg{'ftp_int_passive'} = get_bool($msg,$def);
|
|
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$def = $oldcfg{'inet_domain'} || $ENV{LOCALDOMAIN};
|
|
|
|
$ans = Prompt("\nWhat is your local internet domain name :",$def);
|
|
|
|
$cfg{'inet_domain'} = ($ans =~ /(\S+)/)[0];
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = <<EDQ;
|
|
|
|
If you specified some default hosts above, it is possible for me to
|
|
do some basic tests when you run `make test'
|
|
|
|
This will cause `make test' to be quite a bit slower and, if your
|
|
internet connection is via dialup, will require you to be on-line
|
|
unless the hosts are local.
|
|
|
|
Do you want me to run these tests (y|n) ?
|
|
EDQ
|
|
|
|
$cfg{'test_hosts'} = get_bool($msg,$oldcfg{'test_hosts'});
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
$msg = <<EDQ;
|
|
|
|
To allow Net::FTP to be tested I will need a hostname. This host
|
|
should allow anonymous access and have a /pub directory
|
|
|
|
What host can I use :
|
|
EDQ
|
|
|
|
$cfg{'ftp_testhost'} = get_hostname($msg,$oldcfg{'ftp_testhost'})
|
|
if $cfg{'test_hosts'};
|
|
|
|
|
|
print "\n";
|
|
|
|
#---------------------------------------------------------------------------
|
|
|
|
chmod(0644, $libnet_cfg);
|
|
my $fh = IO::File->new($libnet_cfg, "w") or
|
|
die "Cannot create `$libnet_cfg': $!";
|
|
|
|
print "Writing $libnet_cfg\n";
|
|
|
|
print $fh "{\n";
|
|
|
|
my $key;
|
|
foreach $key (keys %cfg) {
|
|
my $val = $cfg{$key};
|
|
if(!defined($val)) {
|
|
$val = "undef";
|
|
}
|
|
elsif(ref($val)) {
|
|
$val = '[' . join(",",
|
|
map {
|
|
my $v = "undef";
|
|
if(defined $_) {
|
|
($v = $_) =~ s/'/\'/sog;
|
|
$v = "'" . $v . "'";
|
|
}
|
|
$v;
|
|
} @$val ) . ']';
|
|
}
|
|
else {
|
|
$val =~ s/'/\'/sog;
|
|
$val = "'" . $val . "'" if $val =~ /\D/;
|
|
}
|
|
print $fh "\t'",$key,"' => ",$val,",\n";
|
|
}
|
|
|
|
print $fh "}\n";
|
|
|
|
$fh->close;
|
|
|
|
############################################################################
|
|
############################################################################
|
|
|
|
exit 0;
|