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