#!perl # # $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $ use 5.008001; use strict; use warnings; use ExtUtils::MakeMaker qw(prompt); use Getopt::Std; use IO::File; ## no critic (Subroutines::ProhibitSubroutinePrototypes) our($opt_d, $opt_o); ## ## ## 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 $err = 0; foreach my $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; foreach my $host (@_) { if(defined($host) && valid_host($host)) { return $host unless wantarray; push(@host,$host); } } return wantarray ? @host : undef; } ## ## ## getopts('do:'); $libnet_cfg = "libnet.cfg" unless(defined($libnet_cfg = $opt_o)); my %oldcfg = (); { no warnings 'once'; $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; no warnings 'once'; %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 = <. To accept the default, hit 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 = < 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 <new($libnet_cfg, "w") or die "Cannot create `$libnet_cfg': $!"; print "Writing $libnet_cfg\n"; print $fh "{\n"; foreach my $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;