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