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