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