#! /usr/bin/perl 
#
# Semiautomatic configuration script for Debian's diald package.
# Used after installation to configure a dial-on-demand system. It can
# be run at a later time, though --force may be needed.
#
# Copyright 1996 Giuseppe Vacanti <Giuseppe.Vacanti@DeSelby.xs4all.nl>
#

$version = '0.2 ALPHA';

$| = 1;

#
# Initialization.
#
$ip_re = '(\d{1,3}).(\d{1,3}).(\d{1,3}).(\d{1,3})';
$netmask_re = '(255|0).(255|0).(255|0).(255|0)';

$help_file = '/usr/doc/diald/config-help';
$diald_log = '/var/log/diald.log';

$chat = '/usr/sbin/chat';
$dip = '/usr/sbin/dip';
$expect = '/usr/bin/expect';

$slip_mod = "/lib/modules/$kernel/net/slip.o";
$ppp_mod = "/lib/modules/$kernel/net/ppp.o";
$pppd = '/usr/sbin/pppd';


###$diald_ops = '/etc/diald.options';
$diald_ops = 'diald.options';
###$diald_init = '/etc/init.d/diald';
$diald_init = 'init.d/diald';
###$ppp_ops = '/etc/ppp/options';
$ppp_ops = '/etc/ppp/options';

$pppd = '/usr/sbin/pppd';

format MESSAGE_FORMAT =
    ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    $message
~~  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    $message

.

format QUESTION_FORMAT =
       -----------------------------------------------------------

    Q: ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       $message
~~     ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
       $message
.

$~ = "MESSAGE_FORMAT";

system 'clear';

if ($ARGV[0] eq '--force') {$force = 1;} else {$force = 0;}


$message = "This is `dialdconfig', Debian diald's auto-configuration
script. This script can be run at any later time to change your
configuration. This script is ALPHA: please send your comments to the
maintainer of the Debian package"; 

write;

$message = "This script can help you configure a dial-on-demand daemon
(diald) on one port. If you require a more complex configuration
(several diald sessions running at the same time, for instance) this
script is not for you. Read the diald(8) man page and the
documentation found in /usr/doc/diald.";

write;

if (-e $diald_ops) {
    $have_diald_ops = 1;
    $message = "Found diald option file: $diald_ops";
    write;
} else {
    $have_diald_ops = 0;
}

if ($have_diald_ops) {
    if ($force) {
	$message = "Ignoring the pre-existing diald configuration.";
	write;
    }
    else {
	$message = "Your diald system is already configured.
I'll leave the existing configuration untouched. Use --force to ignore it."; 
        write;
        exit(1);
    }
}

$message = "You can enter `q' to quit, anything else to continue";

write;

print "Your choice: ";

$ans = <STDIN>;

if ($ans =~ /q/i) { exit(0);}

#
# Snoop around the system.
# 
system 'clear';

if (-e $slip_mod) {
    $have_slip_mod = 1;
} else {
    $have_slip_mod = 0;
}

if (-e $ppp_mod) {
    $have_ppp_mod = 1;
} else {
    $have_ppp_mod = 0;
}

if (-e $chat) {
    $have_chat = 1;
} else {
    $have_chat = 0;
}

if (-e $dip) {
    $have_dip = 1;
} else {
    $have_dip = 0;
}

if (-e $expect) {
    $have_expect = 1;
} else {
    $have_expect = 0;
}

if (-e $pppd) {
    $have_pppd = 1;
} else {
    $have_pppd = 0;
}

if (-e $ppp_ops) {
    $have_ppp_ops = 1;
    $message = "Found pppd option file: $ppp_ops";
    write;
} else {
    $have_ppp_ops = 0;
}


$message = "I'll be asking you questions in the hope of generating a
functioning diald installation. I have very little built-in
intelligence: let me know of your successes and failures.";

write;

if ($> != 0) {
  $message = "PS: you must have root privileges to run this script.";
  write;
}


$message = "You can enter `q' to quit, anything else to continue";

write;

print "Your choice: ";

$ans = <STDIN>;

if ($ans =~ /q/i) { exit(0);}

#
# Time to boogey on down ...
#

LOG: {
    push(@options, "accounting-log ".$diald_log);
}

 PORT: {
     
     $port = &query("Through what port is the link to be established?",
		    'ttyS0', 'list', ('ttyS0', 'ttyS1', 'ttyS2', 'ttyS3'));
     $port = "/dev/".$port;
 }

 MODEM: {
     
     $ans = &query("Is the serial device a modem?", 'yes', 'list',
                   ('yes', 'no'));
     
     if ($ans eq 'yes') {
	 $modem = 1;
	 push(@options, "modem");
	 
	 $ans = &query("Does your modem support hardware handshaking?",
		       'yes', 'list', ('yes', 'no'));
	 if ($ans eq 'yes') {
	     push(@options, "crtscts");
	 }
     }
 }

 MODE: {
     
     if ($have_pppd) {
	 $df = 'ppp';
     } else {
	 $df = 'slip';
     }
     $mode = &query("What type of connection do you have?", $df, 'list',
		    ('ppp', 'slip', 'cslip', 'slip6', 'cslip6', 'aslip'));
     
     push(@options, "mode ".$mode);
     
     if ($mode eq 'ppp') {
	 $mode_ppp = 1;
     } else {
	 $mode_slip = 1;
     }
 }

 IP: {
     
     $ip_mode = &query("IP addressing mode?", 'dynamic', 'list',
		       ('dynamic', 'static'));
     
     push(@options, $ip_mode);
     
     if ($ip_mode eq 'dynamic') {
	 $dynamic = 1;
	 
	 push(@options, "# With dynamic IP local and remote are dummy.");
	 push(@options, "# They are required for diald to function.");
	 push(@options, "local 127.0.0.1");
	 push(@options, "remote 127.0.0.2");
	 
	 if ($mode_slip) {
	     $dslip_mode = &query("How should I interpret the IP addresses given by the SLIP server?", 'bootp', 'list', ('bootp', 'remote', 'local', 'remote-local', 'local-remote'));

	     push(@options, "dslip-mode $dslip_mode");
				 
	 }
      } else {
	 $static = 1;
	 push(@options, "static");

	 $local = &query("Your machine's IP address?", '', $ip_re);
	 $remote = &query("Your provider's IP address?", '', $ip_re);
	 push(@options, "local $local");
	 push(@options, "remote $remote");
     }
}

 MTU: {
     if ($mode_ppp) {
	 $mtu = &query("For PPP you should set the Maximum Transfer Unit rather high. 1500 is a good value.", '1500', '\d+');}
     elsif ($mode_slip) {
	 $mtu = &query("Enter the Maximum Transfer Unit as specified by your provider.", '1500', '\d+');
     }

     push(@options, "mtu $mtu");

 }

 NETMASK: {
     $net_mask = &query("Netmask to be used for the interface?",
			'255.255.255.0', $netmask_re);
     push(@options, "netmask $net_mask");

 }

ROUTE: {

    if ($dynamic) {
	$df = 'yes';
    } else {
	$df = 'no';
    }
    
    $ans = &query("Should diald set up a default route?",
		  $df, 'list', ('yes', 'no'));

    if ($ans eq 'yes') {
	push(@options, "defaultroute");
    } else {
	$addroute = &query("Name a script/executable to be called by diald once it has established the connection. This is used to add info to the kernel routing table. The script is passed four arguments: <iface> <netmask> <local-ip> <remote-ip>.", '/etc/addroute', '[a-zA-Z0-9_\-/]');
	push(@options, "addroute $addroute");
	
	$delroute = &query("Name a script/executable to be called by diald just before it removes the connection. The script is passed four arguments: <iface> <netmask> <local-ip> <remote-ip>.", '/etc/delroute', '[a-zA-Z0-9_\-/]');
	push(@options, "delroute $delroute");
    }
}

chop($now = `date`);

unlink $diald_ops ||
    die "I cannot delete the configuration file: $diald_ops\n";

open(OPS, ">$diald_ops") ||
    die "I cannot open the configuration file\n";

print OPS <<"OPS1";
# Debian diald option file.
#
# This file was generated semi-automatically by ``dialdconfig''.
#
# Created: $now
# 
# diald can be further tuned by adding options to this file.
# Read diald(8) to learn what else can be configured here.
# 
OPS1
    
while ($line = shift @options) {
    print OPS "$line\n";
}

close OPS;

$editor = &query("Enter the name of a text editor to edit the configuration file, or `none' to continue.", 'none', '[a-zA-Z0-9_\-/]', ('vi', 'ae', 'emacs', '<your favourite editor>'));

if ($editor ne 'none') {
   system "$editor $diald_ops";
}

$answer = &query("I can configure diald to start at boot time. This is probably how you should run it. Do you want diald to start at boot time?", 'yes',
                 'list', ('yes', 'no'));

$answer eq 'yes' ? &diald_init(1) : &diald_init(0);


&ppp_options if ($mode_ppp);

##########

sub ppp_options {

    local (@options, @forbidden, @actual, $line, $answer, $token);

    # These options must not appear in pppd's options file.
    @forbidden = ('crtscts', 'xonxoff', '-crtscts', 'defaultroute',
		  'lock', 'netmask', '-detach', 'modem', 'local',
		  'mtu', 'proxyarp');

    $fmt = $~;
    $~ = "QUESTION_FORMAT";

    if (open (PPP, "<$ppp_ops")) {
	while ((chop($line = <PPP>))) {
	    foreach $token (@forbidden) {
		push(@actual, grep (/^$token/, $line));
	    }
	    # And the tty device should not be specified as well.
	    push(@actual, grep (m#^/dev/.*#, $line));
			    }
		 close PPP;

		 if ($#actual >= 0) {
		     $message = "The following options in $ppp_ops should be removed
because they will interfere with the proper operation of diald:";
		     write;
		     print "\n";
		     foreach (@actual) {
			 print "       $_\n";
		     }
		     $answer = &query("Do you want me to comment these out?",
				      'yes', 'list', ('yes', 'no'));
		     if ($answer eq 'yes') {
			 $^I = ".bak";
			 @ARGV = ($ppp_ops);
			 while ($line = <>) {
			     chop($line);
			     if (grep(/^$line.*/, @actual)) {
				 print "##--diald--##$line\n";
			     } else {
				 print "$line\n";
			     }
			 }
		     }
		 }
		 undef $^I;
	     }
    $~ = $fmt;
}
	
	
sub diald_init {
    
    local($start) = @_;

    $^I = ".bak";
    @ARGV = ($diald_init);
    while (<>) {
	s/^# dialdconfig:.*/# dialdconfig: $now/;
	s/^START=.*/START=$start/;
	s/^PORT=.*/PORT=$port/;
	print;
    }
    undef $^I;
}
    

sub query {
    
    local($message, $msg, @keys, $default, $regexp, $key, $ans, $fmt);
    
    $ans = "";
    ($msg, $default, $regexp, @keys) = @_;
    
    $regexp = join("|", @keys) if ($regexp eq 'list');
	
    $fmt = $~;
    $~ = "QUESTION_FORMAT";

  Q: {
      $message = $msg;
      $ans = '';
#      system 'clear';
      print "\n";
      write;
      if ($#keys >= 0) {
	  print "\n       Choose one of:\n\n";
      }
      foreach $key (@keys) {
	  print "                     $key\n";
      }
      print "\n       Your choice [$default]: ";
      $_ = <STDIN>;

      s/^\s+//; s/\s+$//;

      if ($_ eq '') {
	  $ans = $default;
      } else {
	  $ans = $_;
      }

      redo Q if ($ans !~ /$regexp/);
  }
    $~ = $fmt;
$ans;    
}
