utils/libnetcfg.PL

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