[p5sagit/p5-mst-13.2.git] / utils / libnetcfg.PL

#!/usr/local/bin/perl

use Config;
use File::Basename qw(&basename &dirname);
use Cwd;

# List explicitly here the variables you want Configure to
# generate.  Metaconfig only looks for shell variables, so you
# have to mention them as if they were shell variables, not
# %Config entries.  Thus you write
#  $startperl
# to ensure Configure will look for $Config{startperl}.

# This forces PL files to create target in same directory as PL file.
# This is so that make depend always knows where to find PL derivatives.
my $origdir = cwd;
chdir dirname($0);
my $file = basename($0, '.PL');
$file .= '.com' if $^O eq 'VMS';

open OUT,">$file" or die "Can't create $file: $!";

print "Extracting $file (with variable substitutions)\n";

# In this section, perl variables will be expanded during extraction.
# You can use $Config{...} to use Configure variables.

print OUT <<"!GROK!THIS!";
$Config{startperl}
    eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
	if \$running_under_some_shell;
!GROK!THIS!

# In the following, perl variables are not expanded during extraction.

print OUT <<'!NO!SUBS!';

=head1 NAME

libnetcfg - configure libnet

=head1 DESCRIPTION

The libnetcfg utility can be used to configure the libnet.
Starting from perl 5.8 libnet is part of the standard Perl
distribution, but the libnetcfg can be used for any libnet
installation.

=head1 USAGE

Without arguments libnetcfg displays the current configuration.

    $ libnetcfg
    # old config ./libnet.cfg
    daytime_hosts        ntp1.none.such
    ftp_int_passive      0
    ftp_testhost         ftp.funet.fi
    inet_domain          none.such
    nntp_hosts           nntp.none.such
    ph_hosts             
    pop3_hosts           pop.none.such
    smtp_hosts           smtp.none.such
    snpp_hosts           
    test_exist           1
    test_hosts           1
    time_hosts           ntp.none.such
    # libnetcfg -h for help
    $ 

It tells where the old configuration file was found (if found).

The C<-h> option will show a usage message.

To change the configuration you will need to use either the C<-c> or
the C<-d> options.

The default name of the old configuration file is by default
"libnet.cfg", unless otherwise specified using the -i option,
C<-i oldfile>, and it is searched first from the current directory,
and the from your module path.

The default name of new configuration file is "libnet.cfg", and by
default it is written to the current directory, unless otherwise
specified using the -o option, C<-o newfile>.

=head1 SEE ALSO

L<Net::Config>, L<Net::libnetFAQ>

=head1 AUTHORS

Graham Barr, the original Configure script of libnet.

Jarkko Hietaniemi, conversion into libnet cfg for inclusion into Perl 5.8.

=cut

# $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 File::Spec;

use vars qw($opt_d $opt_c $opt_h $opt_o $opt_i);

##
##
##

my %cfg = ();
my @cfg = ();

my($libnet_cfg_in,$libnet_cfg_out,$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('dcho:i:');

$libnet_cfg_in = "libnet.cfg"
	unless(defined($libnet_cfg_in  = $opt_i));

$libnet_cfg_out = "libnet.cfg"
	unless(defined($libnet_cfg_out = $opt_o));

my %oldcfg = ();

$Net::Config::CONFIGURE = 1; # Suppress load of user overrides
if( -f $libnet_cfg_in )
 {
  %oldcfg = ( %{ do $libnet_cfg_in } );
 }
elsif (eval { require Net::Config }) 
 {
  $have_old = 1;
  %oldcfg = %Net::Config::NetConfig;
 }

map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg;

#---------------------------------------------------------------------------

if ($opt_h) {
 print <<EOU;
$0: Usage: $0 [-c] [-d] [-i oldconfigile] [-o newconfigfile] [-h]
Without options, the old configuration is shown.

   -c change the configuration
   -d use defaults from the old config (implies -c, non-interactive)
   -i use a specific file as the old config file
   -o use a specific file as the new config file
   -h show this help

The default name of the old configuration file is by default
"libnet.cfg", unless otherwise specified using the -i option,
C<-i oldfile>, and it is searched first from the current directory,
and the from your module path.

The default name of new configuration file is "libnet.cfg", and by
default it is written to the current directory, unless otherwise
specified using the -o option.

EOU
 exit(0);
}

#---------------------------------------------------------------------------

{
   my $oldcfgfile;
   my @inc;
   push @inc, $ENV{PERL5LIB} if exists $ENV{PERL5LIB};
   push @inc, $ENV{PERLLIB}  if exists $ENV{PERLLIB};
   push @inc, @INC;
   for (@inc) {
    my $trycfgfile = File::Spec->catfile($_, $libnet_cfg_in);
    if (-f $trycfgfile && -r $trycfgfile) {
     $oldcfgfile = $trycfgfile;
     last;
    }
   }
   print "# old config $oldcfgfile\n" if defined $oldcfgfile;
   for (sort keys %oldcfg) {
	printf "%-20s %s\n", $_,
               ref $oldcfg{$_} ? @{$oldcfg{$_}} : $oldcfg{$_};
   }
   unless ($opt_c || $opt_d) {
    print "# $0 -h for help\n";
    exit(0);
   }
}

#---------------------------------------------------------------------------

$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 user@remote.host
     PASS pass
2) -----------------------
     USER fwuser
     PASS fwpass
     USER user@remote.host
     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@fwuser@remote.site
     PASS pass@fwpass
6) -----------------------
     USER fwuser@remote.site
     PASS fwpass
     USER user
     PASS pass
7) -----------------------
     USER user@remote.host
     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";

#---------------------------------------------------------------------------

my $fh = IO::File->new($libnet_cfg_out, "w") or
	die "Cannot create `$libnet_cfg_out': $!";

print "Writing $libnet_cfg_out\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;
!NO!SUBS!

close OUT or die "Can't close $file: $!";
chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
chdir $origdir;
Commit	Line	Data
406c51ee	1	#!/usr/local/bin/perl
	2
	3	use Config;
	4	use File::Basename qw(&basename &dirname);
	5	use Cwd;
	6
	7	# List explicitly here the variables you want Configure to
	8	# generate. Metaconfig only looks for shell variables, so you
	9	# have to mention them as if they were shell variables, not
	10	# %Config entries. Thus you write
	11	# $startperl
	12	# to ensure Configure will look for $Config{startperl}.
	13
	14	# This forces PL files to create target in same directory as PL file.
	15	# This is so that make depend always knows where to find PL derivatives.
	16	my $origdir = cwd;
	17	chdir dirname($0);
	18	my $file = basename($0, '.PL');
	19	$file .= '.com' if $^O eq 'VMS';
	20
	21	open OUT,">$file" or die "Can't create $file: $!";
	22
	23	print "Extracting $file (with variable substitutions)\n";
	24
	25	# In this section, perl variables will be expanded during extraction.
	26	# You can use $Config{...} to use Configure variables.
	27
	28	print OUT <<"!GROK!THIS!";
	29	$Config{startperl}
	30	eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}'
	31	if \$running_under_some_shell;
	32	!GROK!THIS!
	33
	34	# In the following, perl variables are not expanded during extraction.
	35
	36	print OUT <<'!NO!SUBS!';
	37
a6fb92f1	38	=head1 NAME
	39
	40	libnetcfg - configure libnet
	41
	42	=head1 DESCRIPTION
	43
d1be9408	44	The libnetcfg utility can be used to configure the libnet.
a6fb92f1	45	Starting from perl 5.8 libnet is part of the standard Perl
d1be9408	46	distribution, but the libnetcfg can be used for any libnet
a6fb92f1	47	installation.
	48
	49	=head1 USAGE
	50
	51	Without arguments libnetcfg displays the current configuration.
	52
	53	$ libnetcfg
	54	# old config ./libnet.cfg
	55	daytime_hosts ntp1.none.such
	56	ftp_int_passive 0
	57	ftp_testhost ftp.funet.fi
	58	inet_domain none.such
	59	nntp_hosts nntp.none.such
	60	ph_hosts
	61	pop3_hosts pop.none.such
	62	smtp_hosts smtp.none.such
	63	snpp_hosts
	64	test_exist 1
	65	test_hosts 1
	66	time_hosts ntp.none.such
3e9bebd5	67	# libnetcfg -h for help
a6fb92f1	68	$
	69
	70	It tells where the old configuration file was found (if found).
	71
	72	The C<-h> option will show a usage message.
	73
	74	To change the configuration you will need to use either the C<-c> or
	75	the C<-d> options.
	76
	77	The default name of the old configuration file is by default
4f4a06fc	78	"libnet.cfg", unless otherwise specified using the -i option,
	79	C<-i oldfile>, and it is searched first from the current directory,
	80	and the from your module path.
a6fb92f1	81
	82	The default name of new configuration file is "libnet.cfg", and by
	83	default it is written to the current directory, unless otherwise
	84	specified using the -o option, C<-o newfile>.
	85
	86	=head1 SEE ALSO
	87
	88	L<Net::Config>, L<Net::libnetFAQ>
	89
	90	=head1 AUTHORS
	91
	92	Graham Barr, the original Configure script of libnet.
	93
	94	Jarkko Hietaniemi, conversion into libnet cfg for inclusion into Perl 5.8.
	95
	96	=cut
	97
406c51ee	98	# $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $
	99
	100	use strict;
	101	use IO::File;
	102	use Getopt::Std;
	103	use ExtUtils::MakeMaker qw(prompt);
a6fb92f1	104	use File::Spec;
406c51ee	105
a6fb92f1	106	use vars qw($opt_d $opt_c $opt_h $opt_o $opt_i);
406c51ee	107
	108	##
	109	##
	110	##
	111
	112	my %cfg = ();
	113	my @cfg = ();
	114
a6fb92f1	115	my($libnet_cfg_in,$libnet_cfg_out,$msg,$ans,$def,$have_old);
406c51ee	116
	117	##
	118	##
	119	##
	120
	121	sub valid_host
	122	{
	123	my $h = shift;
	124
	125	defined($h) && (($cfg{'test_exist'} == 0) \|\| gethostbyname($h));
	126	}
	127
	128	##
	129	##
	130	##
	131
	132	sub test_hostnames (\@)
	133	{
	134	my $hlist = shift;
	135	my @h = ();
	136	my $host;
	137	my $err = 0;
	138
	139	foreach $host (@$hlist)
	140	{
	141	if(valid_host($host))
	142	{
	143	push(@h, $host);
	144	next;
	145	}
	146	warn "Bad hostname: '$host'\n";
	147	$err++;
	148	}
	149	@$hlist = @h;
	150	$err ? join(" ",@h) : undef;
	151	}
	152
	153	##
	154	##
	155	##
	156
	157	sub Prompt
	158	{
	159	my($prompt,$def) = @_;
	160
	161	$def = "" unless defined $def;
	162
	163	chomp($prompt);
	164
	165	if($opt_d)
	166	{
	167	print $prompt,," [",$def,"]\n";
	168	return $def;
	169	}
	170	prompt($prompt,$def);
	171	}
	172
	173	##
	174	##
	175	##
	176
	177	sub get_host_list
	178	{
	179	my($prompt,$def) = @_;
180
181	$def = join(" ",@$def) if ref($def);
182
183	my @hosts;
184
185	do
186	{
187	my $ans = Prompt($prompt,$def);
188
189	$ans =~ s/(\A\s+\|\s+\Z)//g;
190
191	@hosts = split(/\s+/, $ans);
192	}
193	while(@hosts && defined($def = test_hostnames(@hosts)));
194
195	\@hosts;
196	}
197
198	##
199	##
200	##
201
202	sub get_hostname
203	{
204	my($prompt,$def) = @_;
205
206	my $host;
207
208	while(1)
209	{
210	my $ans = Prompt($prompt,$def);
211	$host = ($ans =~ /(\S*)/)[0];
212	last
213	if(!length($host) \|\| valid_host($host));
214
215	$def =""
216	if $def eq $host;
217
218	print <<"EDQ";
219
220	*** ERROR:
221	Hostname `$host' does not seem to exist, please enter again
222	or a single space to clear any default
223
224	EDQ
225	}
226
227	length $host
228	? $host
229	: undef;
230	}
231
232	##
233	##
234	##
235
236	sub get_bool ($$)
237	{
238	my($prompt,$def) = @_;
239
240	chomp($prompt);
241
242	my $val = Prompt($prompt,$def ? "yes" : "no");
243
244	$val =~ /^y/i ? 1 : 0;
245	}
246
247	##
248	##
249	##
250
251	sub get_netmask ($$)
252	{
253	my($prompt,$def) = @_;
254
255	chomp($prompt);
256
257	my %list;
258	@list{@$def} = ();
259
260	MASK:
261	while(1) {
262	my $bad = 0;
263	my $ans = Prompt($prompt) or last;
264
265	if($ans eq '*') {
266	%list = ();
267	next;
268	}
269
270	if($ans eq '=') {
271	print "\n",( %list ? join("\n", sort keys %list) : 'none'),"\n\n";
272	next;
273	}
274
275	unless ($ans =~ m{^\s(?:(-?\s)(\d+(?:\.\d+){0,3})/(\d+))}) {
276	warn "Bad netmask '$ans'\n";
277	next;
278	}
279
280	my($remove,$bits,@ip) = ($1,$3,split(/\./, $2),0,0,0);
281	if ( $ip[0] < 1 \|\| $bits < 1 \|\| $bits > 32) {
282	warn "Bad netmask '$ans'\n";
283	next MASK;
284	}
285	foreach my $byte (@ip) {
286	if ( $byte > 255 ) {
287	warn "Bad netmask '$ans'\n";
288	next MASK;
289	}
290	}
291
292	my $mask = sprintf("%d.%d.%d.%d/%d",@ip[0..3],$bits);
293
294	if ($remove) {
295	delete $list{$mask};
296	}
297	else {
298	$list{$mask} = 1;
299	}
300
301	}
302
303	[ keys %list ];
304	}
305
306	##
307	##
308	##
309
310	sub default_hostname
311	{
312	my $host;
313	my @host;
314
315	foreach $host (@_)
316	{
317	if(defined($host) && valid_host($host))
318	{
319	return $host
320	unless wantarray;
321	push(@host,$host);
322	}
323	}
324
325	return wantarray ? @host : undef;
326	}
327
328	##
329	##
330	##
331
a6fb92f1	332	getopts('dcho:i:');
	333
	334	$libnet_cfg_in = "libnet.cfg"
	335	unless(defined($libnet_cfg_in = $opt_i));
406c51ee	336
a6fb92f1	337	$libnet_cfg_out = "libnet.cfg"
a6fb92f1	338	unless(defined($libnet_cfg_out = $opt_o));
406c51ee	339
	340	my %oldcfg = ();
	341
	342	$Net::Config::CONFIGURE = 1; # Suppress load of user overrides
a6fb92f1	343	if( -f $libnet_cfg_in )
406c51ee	344	{
a6fb92f1	345	%oldcfg = ( %{ do $libnet_cfg_in } );
406c51ee	346	}
	347	elsif (eval { require Net::Config })
	348	{
	349	$have_old = 1;
	350	%oldcfg = %Net::Config::NetConfig;
	351	}
	352
	353	map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg;
	354
a6fb92f1	355	#---------------------------------------------------------------------------
	356
	357	if ($opt_h) {
	358	print <<EOU;
	359	$0: Usage: $0 [-c] [-d] [-i oldconfigile] [-o newconfigfile] [-h]
	360	Without options, the old configuration is shown.
	361
	362	-c change the configuration
	363	-d use defaults from the old config (implies -c, non-interactive)
	364	-i use a specific file as the old config file
	365	-o use a specific file as the new config file
	366	-h show this help
	367
	368	The default name of the old configuration file is by default
4f4a06fc	369	"libnet.cfg", unless otherwise specified using the -i option,
	370	C<-i oldfile>, and it is searched first from the current directory,
	371	and the from your module path.
a6fb92f1	372
	373	The default name of new configuration file is "libnet.cfg", and by
	374	default it is written to the current directory, unless otherwise
	375	specified using the -o option.
	376
	377	EOU
	378	exit(0);
	379	}
	380
	381	#---------------------------------------------------------------------------
	382
	383	{
	384	my $oldcfgfile;
	385	my @inc;
	386	push @inc, $ENV{PERL5LIB} if exists $ENV{PERL5LIB};
	387	push @inc, $ENV{PERLLIB} if exists $ENV{PERLLIB};
	388	push @inc, @INC;
	389	for (@inc) {
	390	my $trycfgfile = File::Spec->catfile($_, $libnet_cfg_in);
	391	if (-f $trycfgfile && -r $trycfgfile) {
	392	$oldcfgfile = $trycfgfile;
	393	last;
	394	}
	395	}
	396	print "# old config $oldcfgfile\n" if defined $oldcfgfile;
	397	for (sort keys %oldcfg) {
	398	printf "%-20s %s\n", $_,
	399	ref $oldcfg{$_} ? @{$oldcfg{$_}} : $oldcfg{$_};
	400	}
	401	unless ($opt_c \|\| $opt_d) {
	402	print "# $0 -h for help\n";
	403	exit(0);
	404	}
	405	}
	406
	407	#---------------------------------------------------------------------------
	408
406c51ee	409	$oldcfg{'test_exist'} = 1 unless exists $oldcfg{'test_exist'};
	410	$oldcfg{'test_hosts'} = 1 unless exists $oldcfg{'test_hosts'};
	411
	412	#---------------------------------------------------------------------------
	413
	414	if($have_old && !$opt_d)
	415	{
	416	$msg = <<EDQ;
	417
	418	Ah, I see you already have installed libnet before.
	419
	420	Do you want to modify/update your configuration (y\|n) ?
	421	EDQ
	422
	423	$opt_d = 1
	424	unless get_bool($msg,0);
	425	}
	426
	427	#---------------------------------------------------------------------------
	428
	429	$msg = <<EDQ;
	430
	431	This script will prompt you to enter hostnames that can be used as
	432	defaults for some of the modules in the libnet distribution.
	433
	434	To ensure that you do not enter an invalid hostname, I can perform a
	435	lookup on each hostname you enter. If your internet connection is via
	436	a dialup line then you may not want me to perform these lookups, as
	437	it will require you to be on-line.
	438
	439	Do you want me to perform hostname lookups (y\|n) ?
	440	EDQ
	441
	442	$cfg{'test_exist'} = get_bool($msg, $oldcfg{'test_exist'});
	443
	444	print <<EDQ unless $cfg{'test_exist'};
	445
	446	* WARNING * WARNING * WARNING * WARNING * WARNING *
	447
	448	OK I will not check if the hostnames you give are valid
	449	so be very cafeful
	450
	451	* WARNING * WARNING * WARNING * WARNING * WARNING *
	452	EDQ
	453
	454
	455	#---------------------------------------------------------------------------
	456
	457	print <<EDQ;
	458
	459	The following questions all require a list of host names, separated
	460	with spaces. If you do not have a host available for any of the
	461	services, then enter a single space, followed by <CR>. To accept the
	462	default, hit <CR>
	463
	464	EDQ
	465
	466	$msg = 'Enter a list of available NNTP hosts :';
	467
	468	$def = $oldcfg{'nntp_hosts'} \|\|
	469	[ default_hostname($ENV{NNTPSERVER},$ENV{NEWSHOST},'news') ];
	470
	471	$cfg{'nntp_hosts'} = get_host_list($msg,$def);
	472
473	#---------------------------------------------------------------------------
474
475	$msg = 'Enter a list of available SMTP hosts :';
476
477	$def = $oldcfg{'smtp_hosts'} \|\|
478	[ default_hostname(split(/:/,$ENV{SMTPHOSTS} \|\| ""), 'mailhost') ];
479
480	$cfg{'smtp_hosts'} = get_host_list($msg,$def);
481
482	#---------------------------------------------------------------------------
483
484	$msg = 'Enter a list of available POP3 hosts :';
485
486	$def = $oldcfg{'pop3_hosts'} \|\| [];
487
488	$cfg{'pop3_hosts'} = get_host_list($msg,$def);
489
490	#---------------------------------------------------------------------------
491
492	$msg = 'Enter a list of available SNPP hosts :';
493
494	$def = $oldcfg{'snpp_hosts'} \|\| [];
495
496	$cfg{'snpp_hosts'} = get_host_list($msg,$def);
497
498	#---------------------------------------------------------------------------
499
500	$msg = 'Enter a list of available PH Hosts :' ;
501
502	$def = $oldcfg{'ph_hosts'} \|\|
503	[ default_hostname('dirserv') ];
504
505	$cfg{'ph_hosts'} = get_host_list($msg,$def);
506
507	#---------------------------------------------------------------------------
508
509	$msg = 'Enter a list of available TIME Hosts :' ;
510
511	$def = $oldcfg{'time_hosts'} \|\| [];
512
513	$cfg{'time_hosts'} = get_host_list($msg,$def);
514
515	#---------------------------------------------------------------------------
516
517	$msg = 'Enter a list of available DAYTIME Hosts :' ;
518
519	$def = $oldcfg{'daytime_hosts'} \|\| $oldcfg{'time_hosts'};
520
521	$cfg{'daytime_hosts'} = get_host_list($msg,$def);
522
523	#---------------------------------------------------------------------------
524
525	$msg = <<EDQ;
526
527	Do you have a firewall/ftp proxy between your machine and the internet
528
529	If you use a SOCKS firewall answer no
530
531	(y\|n) ?
532	EDQ
533
534	if(get_bool($msg,0)) {
535
536	$msg = <<'EDQ';
537	What series of FTP commands do you need to send to your
538	firewall to connect to an external host.
539
540	user/pass => external user & password
541	fwuser/fwpass => firewall user & password
542
543	0) None
544	1) -----------------------
545	USER user@remote.host
546	PASS pass
547	2) -----------------------
548	USER fwuser
549	PASS fwpass
550	USER user@remote.host
551	PASS pass
552	3) -----------------------
553	USER fwuser
554	PASS fwpass
555	SITE remote.site
556	USER user
557	PASS pass
558	4) -----------------------
559	USER fwuser
560	PASS fwpass
561	OPEN remote.site
562	USER user
563	PASS pass
564	5) -----------------------
565	USER user@fwuser@remote.site
566	PASS pass@fwpass
567	6) -----------------------
568	USER fwuser@remote.site
569	PASS fwpass
570	USER user
571	PASS pass
572	7) -----------------------
573	USER user@remote.host
574	PASS pass
575	AUTH fwuser
576	RESP fwpass
577
578	Choice:
579	EDQ
580	$def = exists $oldcfg{'ftp_firewall_type'} ? $oldcfg{'ftp_firewall_type'} : 1;
581	$ans = Prompt($msg,$def);
582	$cfg{'ftp_firewall_type'} = 0+$ans;
583	$def = $oldcfg{'ftp_firewall'} \|\| $ENV{FTP_FIREWALL};
584
585	$cfg{'ftp_firewall'} = get_hostname("FTP proxy hostname :", $def);
586	}
587	else {
588	delete $cfg{'ftp_firewall'};
589	}
590
591
592	#---------------------------------------------------------------------------
593
594	if (defined $cfg{'ftp_firewall'})
595	{
596	print <<EDQ;
597
598	By default Net::FTP assumes that it only needs to use a firewall if it
599	cannot resolve the name of the host given. This only works if your DNS
600	system is setup to only resolve internal hostnames. If this is not the
601	case and your DNS will resolve external hostnames, then another method
602	is needed. Net::Config can do this if you provide the netmasks that
603	describe your internal network. Each netmask should be entered in the
604	form x.x.x.x/y, for example 127.0.0.0/8 or 214.8.16.32/24
605
606	EDQ
607	$def = [];
608	if(ref($oldcfg{'local_netmask'}))
609	{
610	$def = $oldcfg{'local_netmask'};
611	print "Your current netmasks are :\n\n\t",
612	join("\n\t",@{$def}),"\n\n";
613	}
614
615	print "
616	Enter one netmask at each prompt, prefix with a - to remove a netmask
617	from the list, enter a '*' to clear the whole list, an '=' to show the
618	current list and an empty line to continue with Configure.
619
620	";
621
622	my $mask = get_netmask("netmask :",$def);
623	$cfg{'local_netmask'} = $mask if ref($mask) && @$mask;
624	}
625
626	#---------------------------------------------------------------------------
627
628	###$msg =<<EDQ;
629	###
630	###SOCKS is a commonly used firewall protocol. If you use SOCKS firewalls
631	###then enter a list of hostames
632	###
633	###Enter a list of available SOCKS hosts :
634	###EDQ
635	###
636	###$def = $cfg{'socks_hosts'} \|\|
637	### [ default_hostname($ENV{SOCKS5_SERVER},
638	### $ENV{SOCKS_SERVER},
639	### $ENV{SOCKS4_SERVER}) ];
640	###
641	###$cfg{'socks_hosts'} = get_host_list($msg,$def);
642
643	#---------------------------------------------------------------------------
644
645	print <<EDQ;
646
647	Normally when FTP needs a data connection the client tells the server
648	a port to connect to, and the server initiates a connection to the client.
649
650	Some setups, in particular firewall setups, can/do not work using this
651	protocol. In these situations the client must make the connection to the
652	server, this is called a passive transfer.
653	EDQ
654
655	if (defined $cfg{'ftp_firewall'}) {
656	$msg = "\nShould all FTP connections via a firewall/proxy be passive (y\|n) ?";
657
658	$def = $oldcfg{'ftp_ext_passive'} \|\| 0;
659
660	$cfg{'ftp_ext_passive'} = get_bool($msg,$def);
661
662	$msg = "\nShould all other FTP connections be passive (y\|n) ?";
663
664	}
665	else {
666	$msg = "\nShould all FTP connections be passive (y\|n) ?";
667	}
668
669	$def = $oldcfg{'ftp_int_passive'} \|\| 0;
670
671	$cfg{'ftp_int_passive'} = get_bool($msg,$def);
672
673
674	#---------------------------------------------------------------------------
675
676	$def = $oldcfg{'inet_domain'} \|\| $ENV{LOCALDOMAIN};
677
678	$ans = Prompt("\nWhat is your local internet domain name :",$def);
679
680	$cfg{'inet_domain'} = ($ans =~ /(\S+)/)[0];
681
682	#---------------------------------------------------------------------------
683
684	$msg = <<EDQ;
685
686	If you specified some default hosts above, it is possible for me to
687	do some basic tests when you run `make test'
688
689	This will cause `make test' to be quite a bit slower and, if your
690	internet connection is via dialup, will require you to be on-line
691	unless the hosts are local.
692
693	Do you want me to run these tests (y\|n) ?
694	EDQ
695
696	$cfg{'test_hosts'} = get_bool($msg,$oldcfg{'test_hosts'});
697
698	#---------------------------------------------------------------------------
699
700	$msg = <<EDQ;
701
702	To allow Net::FTP to be tested I will need a hostname. This host
703	should allow anonymous access and have a /pub directory
704
705	What host can I use :
706	EDQ
707
708	$cfg{'ftp_testhost'} = get_hostname($msg,$oldcfg{'ftp_testhost'})
709	if $cfg{'test_hosts'};
710
711
712	print "\n";
713
714	#---------------------------------------------------------------------------
715
a6fb92f1	716	my $fh = IO::File->new($libnet_cfg_out, "w") or
a6fb92f1	717	die "Cannot create `$libnet_cfg_out': $!";
406c51ee	718
a6fb92f1	719	print "Writing $libnet_cfg_out\n";
406c51ee	720
	721	print $fh "{\n";
	722
	723	my $key;
	724	foreach $key (keys %cfg) {
	725	my $val = $cfg{$key};
	726	if(!defined($val)) {
	727	$val = "undef";
	728	}
	729	elsif(ref($val)) {
	730	$val = '[' . join(",",
	731	map {
	732	my $v = "undef";
	733	if(defined $_) {
	734	($v = $_) =~ s/'/\'/sog;
	735	$v = "'" . $v . "'";
	736	}
	737	$v;
	738	} @$val ) . ']';
	739	}
	740	else {
	741	$val =~ s/'/\'/sog;
	742	$val = "'" . $val . "'" if $val =~ /\D/;
	743	}
	744	print $fh "\t'",$key,"' => ",$val,",\n";
	745	}
	746
	747	print $fh "}\n";
	748
	749	$fh->close;
	750
	751	############################################################################
	752	############################################################################
	753
	754	exit 0;
	755	!NO!SUBS!
	756
	757	close OUT or die "Can't close $file: $!";
	758	chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
	759	exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
	760	chdir $origdir;