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