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