Installer: Early check whether the installation directory is writable
[msysgit.git] / bin / libnetcfg
blobf54240ffc9d499ba1a9bd8813a91e6315cdaf6d9
1 #!/usr/bin/perl
2 eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
3 if $running_under_some_shell;
5 =head1 NAME
7 libnetcfg - configure libnet
9 =head1 DESCRIPTION
11 The libnetcfg utility can be used to configure the libnet.
12 Starting from perl 5.8 libnet is part of the standard Perl
13 distribution, but the libnetcfg can be used for any libnet
14 installation.
16 =head1 USAGE
18 Without arguments libnetcfg displays the current configuration.
20 $ libnetcfg
21 # old config ./libnet.cfg
22 daytime_hosts ntp1.none.such
23 ftp_int_passive 0
24 ftp_testhost ftp.funet.fi
25 inet_domain none.such
26 nntp_hosts nntp.none.such
27 ph_hosts
28 pop3_hosts pop.none.such
29 smtp_hosts smtp.none.such
30 snpp_hosts
31 test_exist 1
32 test_hosts 1
33 time_hosts ntp.none.such
34 # libnetcfg -h for help
37 It tells where the old configuration file was found (if found).
39 The C<-h> option will show a usage message.
41 To change the configuration you will need to use either the C<-c> or
42 the C<-d> options.
44 The default name of the old configuration file is by default
45 "libnet.cfg", unless otherwise specified using the -i option,
46 C<-i oldfile>, and it is searched first from the current directory,
47 and then from your module path.
49 The default name of the new configuration file is "libnet.cfg", and by
50 default it is written to the current directory, unless otherwise
51 specified using the -o option, C<-o newfile>.
53 =head1 SEE ALSO
55 L<Net::Config>, L<Net::libnetFAQ>
57 =head1 AUTHORS
59 Graham Barr, the original Configure script of libnet.
61 Jarkko Hietaniemi, conversion into libnetcfg for inclusion into Perl 5.8.
63 =cut
65 # $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $
67 use strict;
68 use IO::File;
69 use Getopt::Std;
70 use ExtUtils::MakeMaker qw(prompt);
71 use File::Spec;
73 use vars qw($opt_d $opt_c $opt_h $opt_o $opt_i);
79 my %cfg = ();
80 my @cfg = ();
82 my($libnet_cfg_in,$libnet_cfg_out,$msg,$ans,$def,$have_old);
88 sub valid_host
90 my $h = shift;
92 defined($h) && (($cfg{'test_exist'} == 0) || gethostbyname($h));
99 sub test_hostnames (\@)
101 my $hlist = shift;
102 my @h = ();
103 my $host;
104 my $err = 0;
106 foreach $host (@$hlist)
108 if(valid_host($host))
110 push(@h, $host);
111 next;
113 warn "Bad hostname: '$host'\n";
114 $err++;
116 @$hlist = @h;
117 $err ? join(" ",@h) : undef;
124 sub Prompt
126 my($prompt,$def) = @_;
128 $def = "" unless defined $def;
130 chomp($prompt);
132 if($opt_d)
134 print $prompt,," [",$def,"]\n";
135 return $def;
137 prompt($prompt,$def);
144 sub get_host_list
146 my($prompt,$def) = @_;
148 $def = join(" ",@$def) if ref($def);
150 my @hosts;
154 my $ans = Prompt($prompt,$def);
156 $ans =~ s/(\A\s+|\s+\Z)//g;
158 @hosts = split(/\s+/, $ans);
160 while(@hosts && defined($def = test_hostnames(@hosts)));
162 \@hosts;
169 sub get_hostname
171 my($prompt,$def) = @_;
173 my $host;
175 while(1)
177 my $ans = Prompt($prompt,$def);
178 $host = ($ans =~ /(\S*)/)[0];
179 last
180 if(!length($host) || valid_host($host));
182 $def =""
183 if $def eq $host;
185 print <<"EDQ";
187 *** ERROR:
188 Hostname `$host' does not seem to exist, please enter again
189 or a single space to clear any default
194 length $host
195 ? $host
196 : undef;
203 sub get_bool ($$)
205 my($prompt,$def) = @_;
207 chomp($prompt);
209 my $val = Prompt($prompt,$def ? "yes" : "no");
211 $val =~ /^y/i ? 1 : 0;
218 sub get_netmask ($$)
220 my($prompt,$def) = @_;
222 chomp($prompt);
224 my %list;
225 @list{@$def} = ();
227 MASK:
228 while(1) {
229 my $bad = 0;
230 my $ans = Prompt($prompt) or last;
232 if($ans eq '*') {
233 %list = ();
234 next;
237 if($ans eq '=') {
238 print "\n",( %list ? join("\n", sort keys %list) : 'none'),"\n\n";
239 next;
242 unless ($ans =~ m{^\s*(?:(-?\s*)(\d+(?:\.\d+){0,3})/(\d+))}) {
243 warn "Bad netmask '$ans'\n";
244 next;
247 my($remove,$bits,@ip) = ($1,$3,split(/\./, $2),0,0,0);
248 if ( $ip[0] < 1 || $bits < 1 || $bits > 32) {
249 warn "Bad netmask '$ans'\n";
250 next MASK;
252 foreach my $byte (@ip) {
253 if ( $byte > 255 ) {
254 warn "Bad netmask '$ans'\n";
255 next MASK;
259 my $mask = sprintf("%d.%d.%d.%d/%d",@ip[0..3],$bits);
261 if ($remove) {
262 delete $list{$mask};
264 else {
265 $list{$mask} = 1;
270 [ keys %list ];
277 sub default_hostname
279 my $host;
280 my @host;
282 foreach $host (@_)
284 if(defined($host) && valid_host($host))
286 return $host
287 unless wantarray;
288 push(@host,$host);
292 return wantarray ? @host : undef;
299 getopts('dcho:i:');
301 $libnet_cfg_in = "libnet.cfg"
302 unless(defined($libnet_cfg_in = $opt_i));
304 $libnet_cfg_out = "libnet.cfg"
305 unless(defined($libnet_cfg_out = $opt_o));
307 my %oldcfg = ();
309 $Net::Config::CONFIGURE = 1; # Suppress load of user overrides
310 if( -f $libnet_cfg_in )
312 %oldcfg = ( %{ do $libnet_cfg_in } );
314 elsif (eval { require Net::Config })
316 $have_old = 1;
317 %oldcfg = %Net::Config::NetConfig;
320 map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg;
322 #---------------------------------------------------------------------------
324 if ($opt_h) {
325 print <<EOU;
326 $0: Usage: $0 [-c] [-d] [-i oldconfigile] [-o newconfigfile] [-h]
327 Without options, the old configuration is shown.
329 -c change the configuration
330 -d use defaults from the old config (implies -c, non-interactive)
331 -i use a specific file as the old config file
332 -o use a specific file as the new config file
333 -h show this help
335 The default name of the old configuration file is by default
336 "libnet.cfg", unless otherwise specified using the -i option,
337 C<-i oldfile>, and it is searched first from the current directory,
338 and then from your module path.
340 The default name of the new configuration file is "libnet.cfg", and by
341 default it is written to the current directory, unless otherwise
342 specified using the -o option.
345 exit(0);
348 #---------------------------------------------------------------------------
351 my $oldcfgfile;
352 my @inc;
353 push @inc, $ENV{PERL5LIB} if exists $ENV{PERL5LIB};
354 push @inc, $ENV{PERLLIB} if exists $ENV{PERLLIB};
355 push @inc, @INC;
356 for (@inc) {
357 my $trycfgfile = File::Spec->catfile($_, $libnet_cfg_in);
358 if (-f $trycfgfile && -r $trycfgfile) {
359 $oldcfgfile = $trycfgfile;
360 last;
363 print "# old config $oldcfgfile\n" if defined $oldcfgfile;
364 for (sort keys %oldcfg) {
365 printf "%-20s %s\n", $_,
366 ref $oldcfg{$_} ? @{$oldcfg{$_}} : $oldcfg{$_};
368 unless ($opt_c || $opt_d) {
369 print "# $0 -h for help\n";
370 exit(0);
374 #---------------------------------------------------------------------------
376 $oldcfg{'test_exist'} = 1 unless exists $oldcfg{'test_exist'};
377 $oldcfg{'test_hosts'} = 1 unless exists $oldcfg{'test_hosts'};
379 #---------------------------------------------------------------------------
381 if($have_old && !$opt_d)
383 $msg = <<EDQ;
385 Ah, I see you already have installed libnet before.
387 Do you want to modify/update your configuration (y|n) ?
390 $opt_d = 1
391 unless get_bool($msg,0);
394 #---------------------------------------------------------------------------
396 $msg = <<EDQ;
398 This script will prompt you to enter hostnames that can be used as
399 defaults for some of the modules in the libnet distribution.
401 To ensure that you do not enter an invalid hostname, I can perform a
402 lookup on each hostname you enter. If your internet connection is via
403 a dialup line then you may not want me to perform these lookups, as
404 it will require you to be on-line.
406 Do you want me to perform hostname lookups (y|n) ?
409 $cfg{'test_exist'} = get_bool($msg, $oldcfg{'test_exist'});
411 print <<EDQ unless $cfg{'test_exist'};
413 *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
415 OK I will not check if the hostnames you give are valid
416 so be very cafeful
418 *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
422 #---------------------------------------------------------------------------
424 print <<EDQ;
426 The following questions all require a list of host names, separated
427 with spaces. If you do not have a host available for any of the
428 services, then enter a single space, followed by <CR>. To accept the
429 default, hit <CR>
433 $msg = 'Enter a list of available NNTP hosts :';
435 $def = $oldcfg{'nntp_hosts'} ||
436 [ default_hostname($ENV{NNTPSERVER},$ENV{NEWSHOST},'news') ];
438 $cfg{'nntp_hosts'} = get_host_list($msg,$def);
440 #---------------------------------------------------------------------------
442 $msg = 'Enter a list of available SMTP hosts :';
444 $def = $oldcfg{'smtp_hosts'} ||
445 [ default_hostname(split(/:/,$ENV{SMTPHOSTS} || ""), 'mailhost') ];
447 $cfg{'smtp_hosts'} = get_host_list($msg,$def);
449 #---------------------------------------------------------------------------
451 $msg = 'Enter a list of available POP3 hosts :';
453 $def = $oldcfg{'pop3_hosts'} || [];
455 $cfg{'pop3_hosts'} = get_host_list($msg,$def);
457 #---------------------------------------------------------------------------
459 $msg = 'Enter a list of available SNPP hosts :';
461 $def = $oldcfg{'snpp_hosts'} || [];
463 $cfg{'snpp_hosts'} = get_host_list($msg,$def);
465 #---------------------------------------------------------------------------
467 $msg = 'Enter a list of available PH Hosts :' ;
469 $def = $oldcfg{'ph_hosts'} ||
470 [ default_hostname('dirserv') ];
472 $cfg{'ph_hosts'} = get_host_list($msg,$def);
474 #---------------------------------------------------------------------------
476 $msg = 'Enter a list of available TIME Hosts :' ;
478 $def = $oldcfg{'time_hosts'} || [];
480 $cfg{'time_hosts'} = get_host_list($msg,$def);
482 #---------------------------------------------------------------------------
484 $msg = 'Enter a list of available DAYTIME Hosts :' ;
486 $def = $oldcfg{'daytime_hosts'} || $oldcfg{'time_hosts'};
488 $cfg{'daytime_hosts'} = get_host_list($msg,$def);
490 #---------------------------------------------------------------------------
492 $msg = <<EDQ;
494 Do you have a firewall/ftp proxy between your machine and the internet
496 If you use a SOCKS firewall answer no
498 (y|n) ?
501 if(get_bool($msg,0)) {
503 $msg = <<'EDQ';
504 What series of FTP commands do you need to send to your
505 firewall to connect to an external host.
507 user/pass => external user & password
508 fwuser/fwpass => firewall user & password
510 0) None
511 1) -----------------------
512 USER user@remote.host
513 PASS pass
514 2) -----------------------
515 USER fwuser
516 PASS fwpass
517 USER user@remote.host
518 PASS pass
519 3) -----------------------
520 USER fwuser
521 PASS fwpass
522 SITE remote.site
523 USER user
524 PASS pass
525 4) -----------------------
526 USER fwuser
527 PASS fwpass
528 OPEN remote.site
529 USER user
530 PASS pass
531 5) -----------------------
532 USER user@fwuser@remote.site
533 PASS pass@fwpass
534 6) -----------------------
535 USER fwuser@remote.site
536 PASS fwpass
537 USER user
538 PASS pass
539 7) -----------------------
540 USER user@remote.host
541 PASS pass
542 AUTH fwuser
543 RESP fwpass
545 Choice:
547 $def = exists $oldcfg{'ftp_firewall_type'} ? $oldcfg{'ftp_firewall_type'} : 1;
548 $ans = Prompt($msg,$def);
549 $cfg{'ftp_firewall_type'} = 0+$ans;
550 $def = $oldcfg{'ftp_firewall'} || $ENV{FTP_FIREWALL};
552 $cfg{'ftp_firewall'} = get_hostname("FTP proxy hostname :", $def);
554 else {
555 delete $cfg{'ftp_firewall'};
559 #---------------------------------------------------------------------------
561 if (defined $cfg{'ftp_firewall'})
563 print <<EDQ;
565 By default Net::FTP assumes that it only needs to use a firewall if it
566 cannot resolve the name of the host given. This only works if your DNS
567 system is setup to only resolve internal hostnames. If this is not the
568 case and your DNS will resolve external hostnames, then another method
569 is needed. Net::Config can do this if you provide the netmasks that
570 describe your internal network. Each netmask should be entered in the
571 form x.x.x.x/y, for example 127.0.0.0/8 or 214.8.16.32/24
574 $def = [];
575 if(ref($oldcfg{'local_netmask'}))
577 $def = $oldcfg{'local_netmask'};
578 print "Your current netmasks are :\n\n\t",
579 join("\n\t",@{$def}),"\n\n";
582 print "
583 Enter one netmask at each prompt, prefix with a - to remove a netmask
584 from the list, enter a '*' to clear the whole list, an '=' to show the
585 current list and an empty line to continue with Configure.
589 my $mask = get_netmask("netmask :",$def);
590 $cfg{'local_netmask'} = $mask if ref($mask) && @$mask;
593 #---------------------------------------------------------------------------
595 ###$msg =<<EDQ;
597 ###SOCKS is a commonly used firewall protocol. If you use SOCKS firewalls
598 ###then enter a list of hostames
600 ###Enter a list of available SOCKS hosts :
601 ###EDQ
603 ###$def = $cfg{'socks_hosts'} ||
604 ### [ default_hostname($ENV{SOCKS5_SERVER},
605 ### $ENV{SOCKS_SERVER},
606 ### $ENV{SOCKS4_SERVER}) ];
608 ###$cfg{'socks_hosts'} = get_host_list($msg,$def);
610 #---------------------------------------------------------------------------
612 print <<EDQ;
614 Normally when FTP needs a data connection the client tells the server
615 a port to connect to, and the server initiates a connection to the client.
617 Some setups, in particular firewall setups, can/do not work using this
618 protocol. In these situations the client must make the connection to the
619 server, this is called a passive transfer.
622 if (defined $cfg{'ftp_firewall'}) {
623 $msg = "\nShould all FTP connections via a firewall/proxy be passive (y|n) ?";
625 $def = $oldcfg{'ftp_ext_passive'} || 0;
627 $cfg{'ftp_ext_passive'} = get_bool($msg,$def);
629 $msg = "\nShould all other FTP connections be passive (y|n) ?";
632 else {
633 $msg = "\nShould all FTP connections be passive (y|n) ?";
636 $def = $oldcfg{'ftp_int_passive'} || 0;
638 $cfg{'ftp_int_passive'} = get_bool($msg,$def);
641 #---------------------------------------------------------------------------
643 $def = $oldcfg{'inet_domain'} || $ENV{LOCALDOMAIN};
645 $ans = Prompt("\nWhat is your local internet domain name :",$def);
647 $cfg{'inet_domain'} = ($ans =~ /(\S+)/)[0];
649 #---------------------------------------------------------------------------
651 $msg = <<EDQ;
653 If you specified some default hosts above, it is possible for me to
654 do some basic tests when you run `make test'
656 This will cause `make test' to be quite a bit slower and, if your
657 internet connection is via dialup, will require you to be on-line
658 unless the hosts are local.
660 Do you want me to run these tests (y|n) ?
663 $cfg{'test_hosts'} = get_bool($msg,$oldcfg{'test_hosts'});
665 #---------------------------------------------------------------------------
667 $msg = <<EDQ;
669 To allow Net::FTP to be tested I will need a hostname. This host
670 should allow anonymous access and have a /pub directory
672 What host can I use :
675 $cfg{'ftp_testhost'} = get_hostname($msg,$oldcfg{'ftp_testhost'})
676 if $cfg{'test_hosts'};
679 print "\n";
681 #---------------------------------------------------------------------------
683 my $fh = IO::File->new($libnet_cfg_out, "w") or
684 die "Cannot create `$libnet_cfg_out': $!";
686 print "Writing $libnet_cfg_out\n";
688 print $fh "{\n";
690 my $key;
691 foreach $key (keys %cfg) {
692 my $val = $cfg{$key};
693 if(!defined($val)) {
694 $val = "undef";
696 elsif(ref($val)) {
697 $val = '[' . join(",",
698 map {
699 my $v = "undef";
700 if(defined $_) {
701 ($v = $_) =~ s/'/\'/sog;
702 $v = "'" . $v . "'";
705 } @$val ) . ']';
707 else {
708 $val =~ s/'/\'/sog;
709 $val = "'" . $val . "'" if $val =~ /\D/;
711 print $fh "\t'",$key,"' => ",$val,",\n";
714 print $fh "}\n";
716 $fh->close;
718 ############################################################################
719 ############################################################################
721 exit 0;