bin/libnetcfg

   1 #!/usr/bin/perl
   2     eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
   3         if $running_under_some_shell;
   4
   5 =head1 NAME
   6
   7 libnetcfg - configure libnet
   8
   9 =head1 DESCRIPTION
  10
  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.
  15
  16 =head1 USAGE
  17
  18 Without arguments libnetcfg displays the current configuration.
  19
  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
  35     $
  36
  37 It tells where the old configuration file was found (if found).
  38
  39 The C<-h> option will show a usage message.
  40
  41 To change the configuration you will need to use either the C<-c> or
  42 the C<-d> options.
  43
  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.
  48
  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>.
  52
  53 =head1 SEE ALSO
  54
  55 L<Net::Config>, L<Net::libnetFAQ>
  56
  57 =head1 AUTHORS
  58
  59 Graham Barr, the original Configure script of libnet.
  60
  61 Jarkko Hietaniemi, conversion into libnetcfg for inclusion into Perl 5.8.
  62
  63 =cut
  64
  65 # $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $
  66
  67 use strict;
  68 use IO::File;
  69 use Getopt::Std;
  70 use ExtUtils::MakeMaker qw(prompt);
  71 use File::Spec;
  72
  73 use vars qw($opt_d $opt_c $opt_h $opt_o $opt_i);
  74
  75 ##
  76 ##
  77 ##
  78
  79 my %cfg = ();
  80 my @cfg = ();
  81
  82 my($libnet_cfg_in,$libnet_cfg_out,$msg,$ans,$def,$have_old);
  83
  84 ##
  85 ##
  86 ##
  87
  88 sub valid_host
  89 {
  90  my $h = shift;
  91
  92  defined($h) && (($cfg{'test_exist'} == 0) || gethostbyname($h));
  93 }
  94
  95 ##
  96 ##
  97 ##
  98
  99 sub test_hostnames (\@)
 100 {
 101  my $hlist = shift;
 102  my @h = ();
 103  my $host;
 104  my $err = 0;
 105
 106  foreach $host (@$hlist)
 107   {
 108    if(valid_host($host))
 109     {
 110      push(@h, $host);
 111      next;
 112     }
 113    warn "Bad hostname: '$host'\n";
 114    $err++;
 115   }
 116  @$hlist = @h;
 117  $err ? join(" ",@h) : undef;
 118 }
 119
 120 ##
 121 ##
 122 ##
 123
 124 sub Prompt
 125 {
 126  my($prompt,$def) = @_;
 127
 128  $def = "" unless defined $def;
 129
 130  chomp($prompt);
 131
 132  if($opt_d)
 133   {
 134    print $prompt,," [",$def,"]\n";
 135    return $def;
 136   }
 137  prompt($prompt,$def);
 138 }
 139
 140 ##
 141 ##
 142 ##
 143
 144 sub get_host_list
 145 {
 146  my($prompt,$def) = @_;
 147
 148  $def = join(" ",@$def) if ref($def);
 149
 150  my @hosts;
 151
 152  do
 153   {
 154    my $ans = Prompt($prompt,$def);
 155
 156    $ans =~ s/(\A\s+|\s+\Z)//g;
 157
 158    @hosts = split(/\s+/, $ans);
 159   }
 160  while(@hosts && defined($def = test_hostnames(@hosts)));
 161
 162  \@hosts;
 163 }
 164
 165 ##
 166 ##
 167 ##
 168
 169 sub get_hostname
 170 {
 171  my($prompt,$def) = @_;
 172
 173  my $host;
 174
 175  while(1)
 176   {
 177    my $ans = Prompt($prompt,$def);
 178    $host = ($ans =~ /(\S*)/)[0];
 179    last
 180         if(!length($host) || valid_host($host));
 181
 182    $def =""
 183         if $def eq $host;
 184
 185    print <<"EDQ";
 186
 187 *** ERROR:
 188     Hostname `$host' does not seem to exist, please enter again
 189     or a single space to clear any default
 190
 191 EDQ
 192   }
 193
 194  length $host
 195         ? $host
 196         : undef;
 197 }
 198
 199 ##
 200 ##
 201 ##
 202
 203 sub get_bool ($$)
 204 {
 205  my($prompt,$def) = @_;
 206
 207  chomp($prompt);
 208
 209  my $val = Prompt($prompt,$def ? "yes" : "no");
 210
 211  $val =~ /^y/i ? 1 : 0;
 212 }
 213
 214 ##
 215 ##
 216 ##
 217
 218 sub get_netmask ($$)
 219 {
 220  my($prompt,$def) = @_;
 221
 222  chomp($prompt);
 223
 224  my %list;
 225  @list{@$def} = ();
 226
 227 MASK:
 228  while(1) {
 229    my $bad = 0;
 230    my $ans = Prompt($prompt) or last;
 231
 232    if($ans eq '*') {
 233      %list = ();
 234      next;
 235    }
 236
 237    if($ans eq '=') {
 238      print "\n",( %list ? join("\n", sort keys %list) : 'none'),"\n\n";
 239      next;
 240    }
 241
 242    unless ($ans =~ m{^\s*(?:(-?\s*)(\d+(?:\.\d+){0,3})/(\d+))}) {
 243      warn "Bad netmask '$ans'\n";
 244      next;
 245    }
 246
 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;
 251    }
 252    foreach my $byte (@ip) {
 253      if ( $byte > 255 ) {
 254        warn "Bad netmask '$ans'\n";
 255        next MASK;
 256      }
 257    }
 258
 259    my $mask = sprintf("%d.%d.%d.%d/%d",@ip[0..3],$bits);
 260
 261    if ($remove) {
 262      delete $list{$mask};
 263    }
 264    else {
 265      $list{$mask} = 1;
 266    }
 267
 268   }
 269
 270  [ keys %list ];
 271 }
 272
 273 ##
 274 ##
 275 ##
 276
 277 sub default_hostname
 278 {
 279  my $host;
 280  my @host;
 281
 282  foreach $host (@_)
 283   {
 284    if(defined($host) && valid_host($host))
 285     {
 286      return $host
 287         unless wantarray;
 288      push(@host,$host);
 289     }
 290   }
 291
 292  return wantarray ? @host : undef;
 293 }
 294
 295 ##
 296 ##
 297 ##
 298
 299 getopts('dcho:i:');
 300
 301 $libnet_cfg_in = "libnet.cfg"
 302         unless(defined($libnet_cfg_in  = $opt_i));
 303
 304 $libnet_cfg_out = "libnet.cfg"
 305         unless(defined($libnet_cfg_out = $opt_o));
 306
 307 my %oldcfg = ();
 308
 309 $Net::Config::CONFIGURE = 1; # Suppress load of user overrides
 310 if( -f $libnet_cfg_in )
 311  {
 312   %oldcfg = ( %{ do $libnet_cfg_in } );
 313  }
 314 elsif (eval { require Net::Config })
 315  {
 316   $have_old = 1;
 317   %oldcfg = %Net::Config::NetConfig;
 318  }
 319
 320 map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg;
 321
 322 #---------------------------------------------------------------------------
 323
 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.
 328
 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
 334
 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.
 339
 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.
 343
 344 EOU
 345  exit(0);
 346 }
 347
 348 #---------------------------------------------------------------------------
 349
 350 {
 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;
 361     }
 362    }
 363    print "# old config $oldcfgfile\n" if defined $oldcfgfile;
 364    for (sort keys %oldcfg) {
 365         printf "%-20s %s\n", $_,
 366                ref $oldcfg{$_} ? @{$oldcfg{$_}} : $oldcfg{$_};
 367    }
 368    unless ($opt_c || $opt_d) {
 369     print "# $0 -h for help\n";
 370     exit(0);
 371    }
 372 }
 373
 374 #---------------------------------------------------------------------------
 375
 376 $oldcfg{'test_exist'} = 1 unless exists $oldcfg{'test_exist'};
 377 $oldcfg{'test_hosts'} = 1 unless exists $oldcfg{'test_hosts'};
 378
 379 #---------------------------------------------------------------------------
 380
 381 if($have_old && !$opt_d)
 382  {
 383   $msg = <<EDQ;
 384
 385 Ah, I see you already have installed libnet before.
 386
 387 Do you want to modify/update your configuration (y|n) ?
 388 EDQ
 389
 390  $opt_d = 1
 391         unless get_bool($msg,0);
 392  }
 393
 394 #---------------------------------------------------------------------------
 395
 396 $msg = <<EDQ;
 397
 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.
 400
 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.
 405
 406 Do you want me to perform hostname lookups (y|n) ?
 407 EDQ
 408
 409 $cfg{'test_exist'} = get_bool($msg, $oldcfg{'test_exist'});
 410
 411 print <<EDQ unless $cfg{'test_exist'};
 412
 413 *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
 414
 415 OK I will not check if the hostnames you give are valid
 416 so be very cafeful
 417
 418 *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING ***
 419 EDQ
 420
 421
 422 #---------------------------------------------------------------------------
 423
 424 print <<EDQ;
 425
 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>
 430
 431 EDQ
 432
 433 $msg = 'Enter a list of available NNTP hosts :';
 434
 435 $def = $oldcfg{'nntp_hosts'} ||
 436         [ default_hostname($ENV{NNTPSERVER},$ENV{NEWSHOST},'news') ];
 437
 438 $cfg{'nntp_hosts'} = get_host_list($msg,$def);
 439
 440 #---------------------------------------------------------------------------
 441
 442 $msg = 'Enter a list of available SMTP hosts :';
 443
 444 $def = $oldcfg{'smtp_hosts'} ||
 445         [ default_hostname(split(/:/,$ENV{SMTPHOSTS} || ""), 'mailhost') ];
 446
 447 $cfg{'smtp_hosts'} = get_host_list($msg,$def);
 448
 449 #---------------------------------------------------------------------------
 450
 451 $msg = 'Enter a list of available POP3 hosts :';
 452
 453 $def = $oldcfg{'pop3_hosts'} || [];
 454
 455 $cfg{'pop3_hosts'} = get_host_list($msg,$def);
 456
 457 #---------------------------------------------------------------------------
 458
 459 $msg = 'Enter a list of available SNPP hosts :';
 460
 461 $def = $oldcfg{'snpp_hosts'} || [];
 462
 463 $cfg{'snpp_hosts'} = get_host_list($msg,$def);
 464
 465 #---------------------------------------------------------------------------
 466
 467 $msg = 'Enter a list of available PH Hosts   :'  ;
 468
 469 $def = $oldcfg{'ph_hosts'} ||
 470         [ default_hostname('dirserv') ];
 471
 472 $cfg{'ph_hosts'}   =  get_host_list($msg,$def);
 473
 474 #---------------------------------------------------------------------------
 475
 476 $msg = 'Enter a list of available TIME Hosts   :'  ;
 477
 478 $def = $oldcfg{'time_hosts'} || [];
 479
 480 $cfg{'time_hosts'} = get_host_list($msg,$def);
 481
 482 #---------------------------------------------------------------------------
 483
 484 $msg = 'Enter a list of available DAYTIME Hosts   :'  ;
 485
 486 $def = $oldcfg{'daytime_hosts'} || $oldcfg{'time_hosts'};
 487
 488 $cfg{'daytime_hosts'} = get_host_list($msg,$def);
 489
 490 #---------------------------------------------------------------------------
 491
 492 $msg = <<EDQ;
 493
 494 Do you have a firewall/ftp proxy  between your machine and the internet
 495
 496 If you use a SOCKS firewall answer no
 497
 498 (y|n) ?
 499 EDQ
 500
 501 if(get_bool($msg,0)) {
 502
 503   $msg = <<'EDQ';
 504 What series of FTP commands do you need to send to your
 505 firewall to connect to an external host.
 506
 507 user/pass     => external user & password
 508 fwuser/fwpass => firewall user & password
 509
 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
 544
 545 Choice:
 546 EDQ
 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};
 551
 552  $cfg{'ftp_firewall'} = get_hostname("FTP proxy hostname :", $def);
 553 }
 554 else {
 555  delete $cfg{'ftp_firewall'};
 556 }
 557
 558
 559 #---------------------------------------------------------------------------
 560
 561 if (defined $cfg{'ftp_firewall'})
 562  {
 563   print <<EDQ;
 564
 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
 572
 573 EDQ
 574 $def = [];
 575 if(ref($oldcfg{'local_netmask'}))
 576  {
 577   $def = $oldcfg{'local_netmask'};
 578    print "Your current netmasks are :\n\n\t",
 579         join("\n\t",@{$def}),"\n\n";
 580  }
 581
 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.
 586
 587 ";
 588
 589   my $mask = get_netmask("netmask :",$def);
 590   $cfg{'local_netmask'} = $mask if ref($mask) && @$mask;
 591  }
 592
 593 #---------------------------------------------------------------------------
 594
 595 ###$msg =<<EDQ;
 596 ###
 597 ###SOCKS is a commonly used firewall protocol. If you use SOCKS firewalls
 598 ###then enter a list of hostames
 599 ###
 600 ###Enter a list of available SOCKS hosts :
 601 ###EDQ
 602 ###
 603 ###$def = $cfg{'socks_hosts'} ||
 604 ###     [ default_hostname($ENV{SOCKS5_SERVER},
 605 ###                        $ENV{SOCKS_SERVER},
 606 ###                        $ENV{SOCKS4_SERVER}) ];
 607 ###
 608 ###$cfg{'socks_hosts'}   =  get_host_list($msg,$def);
 609
 610 #---------------------------------------------------------------------------
 611
 612 print <<EDQ;
 613
 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.
 616
 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.
 620 EDQ
 621
 622 if (defined $cfg{'ftp_firewall'}) {
 623   $msg = "\nShould all FTP connections via a firewall/proxy be passive (y|n) ?";
 624
 625   $def = $oldcfg{'ftp_ext_passive'} || 0;
 626
 627   $cfg{'ftp_ext_passive'} = get_bool($msg,$def);
 628
 629   $msg = "\nShould all other FTP connections be passive (y|n) ?";
 630
 631 }
 632 else {
 633   $msg = "\nShould all FTP connections be passive (y|n) ?";
 634 }
 635
 636 $def = $oldcfg{'ftp_int_passive'} || 0;
 637
 638 $cfg{'ftp_int_passive'} = get_bool($msg,$def);
 639
 640
 641 #---------------------------------------------------------------------------
 642
 643 $def = $oldcfg{'inet_domain'} || $ENV{LOCALDOMAIN};
 644
 645 $ans = Prompt("\nWhat is your local internet domain name :",$def);
 646
 647 $cfg{'inet_domain'} = ($ans =~ /(\S+)/)[0];
 648
 649 #---------------------------------------------------------------------------
 650
 651 $msg = <<EDQ;
 652
 653 If you specified some default hosts above, it is possible for me to
 654 do some basic tests when you run `make test'
 655
 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.
 659
 660 Do you want me to run these tests (y|n) ?
 661 EDQ
 662
 663 $cfg{'test_hosts'} = get_bool($msg,$oldcfg{'test_hosts'});
 664
 665 #---------------------------------------------------------------------------
 666
 667 $msg = <<EDQ;
 668
 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
 671
 672 What host can I use :
 673 EDQ
 674
 675 $cfg{'ftp_testhost'} = get_hostname($msg,$oldcfg{'ftp_testhost'})
 676         if $cfg{'test_hosts'};
 677
 678
 679 print "\n";
 680
 681 #---------------------------------------------------------------------------
 682
 683 my $fh = IO::File->new($libnet_cfg_out, "w") or
 684         die "Cannot create `$libnet_cfg_out': $!";
 685
 686 print "Writing $libnet_cfg_out\n";
 687
 688 print $fh "{\n";
 689
 690 my $key;
 691 foreach $key (keys %cfg) {
 692     my $val = $cfg{$key};
 693     if(!defined($val)) {
 694         $val = "undef";
 695     }
 696     elsif(ref($val)) {
 697         $val = '[' . join(",",
 698             map {
 699                 my $v = "undef";
 700                 if(defined $_) {
 701                     ($v = $_) =~ s/'/\'/sog;
 702                     $v = "'" . $v . "'";
 703                 }
 704                 $v;
 705             } @$val ) . ']';
 706     }
 707     else {
 708         $val =~ s/'/\'/sog;
 709         $val = "'" . $val . "'" if $val =~ /\D/;
 710     }
 711     print $fh "\t'",$key,"' => ",$val,",\n";
 712 }
 713
 714 print $fh "}\n";
 715
 716 $fh->close;
 717
 718 ############################################################################
 719 ############################################################################
 720
 721 exit 0;