| 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 0; # ^ Run only under a 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 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 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 | # libnetcfg -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, |
| 79 | C<-i oldfile>, and it is searched first from the current directory, |
| 80 | and then from your module path. |
| 81 | |
| 82 | The default name of the new configuration file is "libnet.cfg", and by |
| 83 | default it is written to the current directory, unless otherwise |
| 84 | specified using the -o option, C<-o newfile>. |
| 85 | |
| 86 | =head1 SEE ALSO |
| 87 | |
| 88 | L<Net::Config>, L<libnetFAQ> |
| 89 | |
| 90 | =head1 AUTHORS |
| 91 | |
| 92 | Graham Barr, the original Configure script of libnet. |
| 93 | |
| 94 | Jarkko 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 | |
| 100 | BEGIN { pop @INC if $INC[-1] eq '.' } |
| 101 | use strict; |
| 102 | use IO::File; |
| 103 | use Getopt::Std; |
| 104 | use ExtUtils::MakeMaker qw(prompt); |
| 105 | use File::Spec; |
| 106 | |
| 107 | use vars qw($opt_d $opt_c $opt_h $opt_o $opt_i); |
| 108 | |
| 109 | ## |
| 110 | ## |
| 111 | ## |
| 112 | |
| 113 | my %cfg = (); |
| 114 | my @cfg = (); |
| 115 | |
| 116 | my($libnet_cfg_in,$libnet_cfg_out,$msg,$ans,$def,$have_old); |
| 117 | |
| 118 | ## |
| 119 | ## |
| 120 | ## |
| 121 | |
| 122 | sub valid_host |
| 123 | { |
| 124 | my $h = shift; |
| 125 | |
| 126 | defined($h) && (($cfg{'test_exist'} == 0) || gethostbyname($h)); |
| 127 | } |
| 128 | |
| 129 | ## |
| 130 | ## |
| 131 | ## |
| 132 | |
| 133 | sub 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 | |
| 158 | sub 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 | |
| 178 | sub 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 | |
| 203 | sub 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 | |
| 225 | EDQ |
| 226 | } |
| 227 | |
| 228 | length $host |
| 229 | ? $host |
| 230 | : undef; |
| 231 | } |
| 232 | |
| 233 | ## |
| 234 | ## |
| 235 | ## |
| 236 | |
| 237 | sub 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 | |
| 252 | sub get_netmask ($$) |
| 253 | { |
| 254 | my($prompt,$def) = @_; |
| 255 | |
| 256 | chomp($prompt); |
| 257 | |
| 258 | my %list; |
| 259 | @list{@$def} = (); |
| 260 | |
| 261 | MASK: |
| 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 | |
| 311 | sub 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 | |
| 333 | getopts('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 | |
| 341 | my %oldcfg = (); |
| 342 | |
| 343 | $Net::Config::CONFIGURE = 1; # Suppress load of user overrides |
| 344 | if( -f $libnet_cfg_in ) |
| 345 | { |
| 346 | %oldcfg = ( %{ local @INC = '.'; do $libnet_cfg_in } ); |
| 347 | } |
| 348 | elsif (eval { require Net::Config }) |
| 349 | { |
| 350 | $have_old = 1; |
| 351 | %oldcfg = %Net::Config::NetConfig; |
| 352 | } |
| 353 | |
| 354 | map { $cfg{lc $_} = $cfg{$_}; delete $cfg{$_} if /[A-Z]/ } keys %cfg; |
| 355 | |
| 356 | #--------------------------------------------------------------------------- |
| 357 | |
| 358 | if ($opt_h) { |
| 359 | print <<EOU; |
| 360 | $0: Usage: $0 [-c] [-d] [-i oldconfigile] [-o newconfigfile] [-h] |
| 361 | Without 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 | |
| 369 | The default name of the old configuration file is by default |
| 370 | "libnet.cfg", unless otherwise specified using the -i option, |
| 371 | C<-i oldfile>, and it is searched first from the current directory, |
| 372 | and then from your module path. |
| 373 | |
| 374 | The default name of the new configuration file is "libnet.cfg", and by |
| 375 | default it is written to the current directory, unless otherwise |
| 376 | specified using the -o option. |
| 377 | |
| 378 | EOU |
| 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 | |
| 415 | if($have_old && !$opt_d) |
| 416 | { |
| 417 | $msg = <<EDQ; |
| 418 | |
| 419 | Ah, I see you already have installed libnet before. |
| 420 | |
| 421 | Do you want to modify/update your configuration (y|n) ? |
| 422 | EDQ |
| 423 | |
| 424 | $opt_d = 1 |
| 425 | unless get_bool($msg,0); |
| 426 | } |
| 427 | |
| 428 | #--------------------------------------------------------------------------- |
| 429 | |
| 430 | $msg = <<EDQ; |
| 431 | |
| 432 | This script will prompt you to enter hostnames that can be used as |
| 433 | defaults for some of the modules in the libnet distribution. |
| 434 | |
| 435 | To ensure that you do not enter an invalid hostname, I can perform a |
| 436 | lookup on each hostname you enter. If your internet connection is via |
| 437 | a dialup line then you may not want me to perform these lookups, as |
| 438 | it will require you to be on-line. |
| 439 | |
| 440 | Do you want me to perform hostname lookups (y|n) ? |
| 441 | EDQ |
| 442 | |
| 443 | $cfg{'test_exist'} = get_bool($msg, $oldcfg{'test_exist'}); |
| 444 | |
| 445 | print <<EDQ unless $cfg{'test_exist'}; |
| 446 | |
| 447 | *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING *** |
| 448 | |
| 449 | OK I will not check if the hostnames you give are valid |
| 450 | so be very cafeful |
| 451 | |
| 452 | *** WARNING *** WARNING *** WARNING *** WARNING *** WARNING *** |
| 453 | EDQ |
| 454 | |
| 455 | |
| 456 | #--------------------------------------------------------------------------- |
| 457 | |
| 458 | print <<EDQ; |
| 459 | |
| 460 | The following questions all require a list of host names, separated |
| 461 | with spaces. If you do not have a host available for any of the |
| 462 | services, then enter a single space, followed by <CR>. To accept the |
| 463 | default, hit <CR> |
| 464 | |
| 465 | EDQ |
| 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 | |
| 528 | Do you have a firewall/ftp proxy between your machine and the internet |
| 529 | |
| 530 | If you use a SOCKS firewall answer no |
| 531 | |
| 532 | (y|n) ? |
| 533 | EDQ |
| 534 | |
| 535 | if(get_bool($msg,0)) { |
| 536 | |
| 537 | $msg = <<'EDQ'; |
| 538 | What series of FTP commands do you need to send to your |
| 539 | firewall to connect to an external host. |
| 540 | |
| 541 | user/pass => external user & password |
| 542 | fwuser/fwpass => firewall user & password |
| 543 | |
| 544 | 0) None |
| 545 | 1) ----------------------- |
| 546 | USER user@remote.host |
| 547 | PASS pass |
| 548 | 2) ----------------------- |
| 549 | USER fwuser |
| 550 | PASS fwpass |
| 551 | USER user@remote.host |
| 552 | PASS pass |
| 553 | 3) ----------------------- |
| 554 | USER fwuser |
| 555 | PASS fwpass |
| 556 | SITE remote.site |
| 557 | USER user |
| 558 | PASS pass |
| 559 | 4) ----------------------- |
| 560 | USER fwuser |
| 561 | PASS fwpass |
| 562 | OPEN remote.site |
| 563 | USER user |
| 564 | PASS pass |
| 565 | 5) ----------------------- |
| 566 | USER user@fwuser@remote.site |
| 567 | PASS pass@fwpass |
| 568 | 6) ----------------------- |
| 569 | USER fwuser@remote.site |
| 570 | PASS fwpass |
| 571 | USER user |
| 572 | PASS pass |
| 573 | 7) ----------------------- |
| 574 | USER user@remote.host |
| 575 | PASS pass |
| 576 | AUTH fwuser |
| 577 | RESP fwpass |
| 578 | |
| 579 | Choice: |
| 580 | EDQ |
| 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 | } |
| 588 | else { |
| 589 | delete $cfg{'ftp_firewall'}; |
| 590 | } |
| 591 | |
| 592 | |
| 593 | #--------------------------------------------------------------------------- |
| 594 | |
| 595 | if (defined $cfg{'ftp_firewall'}) |
| 596 | { |
| 597 | print <<EDQ; |
| 598 | |
| 599 | By default Net::FTP assumes that it only needs to use a firewall if it |
| 600 | cannot resolve the name of the host given. This only works if your DNS |
| 601 | system is setup to only resolve internal hostnames. If this is not the |
| 602 | case and your DNS will resolve external hostnames, then another method |
| 603 | is needed. Net::Config can do this if you provide the netmasks that |
| 604 | describe your internal network. Each netmask should be entered in the |
| 605 | form x.x.x.x/y, for example 127.0.0.0/8 or 214.8.16.32/24 |
| 606 | |
| 607 | EDQ |
| 608 | $def = []; |
| 609 | if(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 | |
| 616 | print " |
| 617 | Enter one netmask at each prompt, prefix with a - to remove a netmask |
| 618 | from the list, enter a '*' to clear the whole list, an '=' to show the |
| 619 | current 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 | |
| 646 | print <<EDQ; |
| 647 | |
| 648 | Normally when FTP needs a data connection the client tells the server |
| 649 | a port to connect to, and the server initiates a connection to the client. |
| 650 | |
| 651 | Some setups, in particular firewall setups, can/do not work using this |
| 652 | protocol. In these situations the client must make the connection to the |
| 653 | server, this is called a passive transfer. |
| 654 | EDQ |
| 655 | |
| 656 | if (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 | } |
| 666 | else { |
| 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 | |
| 687 | If you specified some default hosts above, it is possible for me to |
| 688 | do some basic tests when you run 'make test' |
| 689 | |
| 690 | This will cause 'make test' to be quite a bit slower and, if your |
| 691 | internet connection is via dialup, will require you to be on-line |
| 692 | unless the hosts are local. |
| 693 | |
| 694 | Do you want me to run these tests (y|n) ? |
| 695 | EDQ |
| 696 | |
| 697 | $cfg{'test_hosts'} = get_bool($msg,$oldcfg{'test_hosts'}); |
| 698 | |
| 699 | #--------------------------------------------------------------------------- |
| 700 | |
| 701 | $msg = <<EDQ; |
| 702 | |
| 703 | To allow Net::FTP to be tested I will need a hostname. This host |
| 704 | should allow anonymous access and have a /pub directory |
| 705 | |
| 706 | What host can I use : |
| 707 | EDQ |
| 708 | |
| 709 | $cfg{'ftp_testhost'} = get_hostname($msg,$oldcfg{'ftp_testhost'}) |
| 710 | if $cfg{'test_hosts'}; |
| 711 | |
| 712 | |
| 713 | print "\n"; |
| 714 | |
| 715 | #--------------------------------------------------------------------------- |
| 716 | |
| 717 | my $fh = IO::File->new($libnet_cfg_out, "w") or |
| 718 | die "Cannot create '$libnet_cfg_out': $!"; |
| 719 | |
| 720 | print "Writing $libnet_cfg_out\n"; |
| 721 | |
| 722 | print $fh "{\n"; |
| 723 | |
| 724 | my $key; |
| 725 | foreach $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 | |
| 748 | print $fh "}\n"; |
| 749 | |
| 750 | $fh->close; |
| 751 | |
| 752 | ############################################################################ |
| 753 | ############################################################################ |
| 754 | |
| 755 | exit 0; |
| 756 | !NO!SUBS! |
| 757 | |
| 758 | close OUT or die "Can't close $file: $!"; |
| 759 | chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; |
| 760 | exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; |
| 761 | chdir $origdir; |