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