summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/bin/libnetcfg.bat
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/bin/libnetcfg.bat')
-rwxr-xr-xMaster/tlpkg/tlperl/bin/libnetcfg.bat737
1 files changed, 0 insertions, 737 deletions
diff --git a/Master/tlpkg/tlperl/bin/libnetcfg.bat b/Master/tlpkg/tlperl/bin/libnetcfg.bat
deleted file mode 100755
index aacd5fe7490..00000000000
--- a/Master/tlpkg/tlperl/bin/libnetcfg.bat
+++ /dev/null
@@ -1,737 +0,0 @@
-@rem = '--*-Perl-*--
-@echo off
-if "%OS%" == "Windows_NT" goto WinNT
-perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
-goto endofperl
-:WinNT
-perl -x -S %0 %*
-if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
-if %errorlevel% == 9009 echo You do not have Perl in your PATH.
-if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
-goto endofperl
-@rem ';
-#!perl
-#line 15
- eval 'exec C:\strawberry\perl\bin\perl.exe -S $0 ${1+"$@"}'
- if $running_under_some_shell;
-
-=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 then from your module path.
-
-The default name of the 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 libnetcfg 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 then from your module path.
-
-The default name of the 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;
-
-__END__
-:endofperl