#!/usr/local/bin/perl
#
# NAME:
#       ppp.pl - setup PPP connection.
#
# SYNOPSIS:
#       ppp.pl [options]
#
# DESCRIPTION:
#       A bit more flexible than chat(1).
#       It picks up defaults from .${Myname}rc.pl so linking different
#       names to it is a handy way of picking a configuration.
#
#       Essentially, the script runs tip(1), and drives it to
#       establish an authenticated login.  This is all driven by
#       regexps in the %RE table.  For example:
#.nf
#
#       %RE = ('CONNECT', '',
#              'OK', "ATDT$opt_X$opt_P\\r",
#              'ogin:', "$opt_u\\r",
#              'sername:', "$opt_u\\r",
#              'word:', "$opt_p\\r",
#              'hallenge:', 'interact::Acce',
#              'PPP', 'sub:pppd:',
#              'Device Busy', 'sub:exit:1',
#              );
#.fi
#
#       The keys are strings received from the remote node, and the
#       values are either simple strings to respond with or actions to
#       perform - like calling pppd if PPP is seen.
#
#       The pppd routine, suspends tip(1), and runs pppd(8) in
#       background before returning to tip and terminating it.
#
#       Options:
#
#       -X "xtras"
#               Any extra magic needed for dialing.  Lets you set
#               $opt_P in a .rc file and use -X 0, for when a dial
#               prefix is needed to get past a PABX.
#
#       -P "phoneNo"
#               The "phoneNo" to call - should include pauses etc as
#               needed by your modem.
#
#       -u "user"
#               The user you need to authenticate as.
#
#       -p "password"
#               The "password" for "user".  If serious challenge
#               response is being used, this "password" is often
#               irrelevant.
#
#       -d "device"
#               The "device" that tip(1) will be told to use.
#               Default is 'modem'.
#
#       -f "tty"
#               The device that pppd(8) will be told to use.
#
#       -c "config"
#               Read more settings from "config" this is processed
#               _after_ both .rc file and command line options.
#               Can be useful for extending the %RE table.
#
#       -v      Be verbose.
#
#
# AUTHOR:
#       Simon J. Gerraty <[email protected]>
#


$RCSid = '$Id: ppp.pl,v 1.5 1999/01/22 13:06:42 sjg Exp $'; #' for emacs

#       @(#) Copyright (c) 1998 Simon J. Gerraty
#
#       This file is provided in the hope that it will
#       be of use.  There is absolutely NO WARRANTY.
#       Permission to copy, redistribute or otherwise
#       use this file is hereby granted provided that
#       the above copyright notice and this notice are
#       left intact.
#
#       Please send copies of changes and bug-fixes to:
#       [email protected]
#

if ($0 =~ m,^(.*)/([^/]+)$,) {
 $Mydir = $1;
 $Myname = $2;
} else {
 $Mydir = '.';
 $Myname = $0;
}
$Myname =~ s/\.pl//;

$rc = ".${Myname}rc.pl";

require 'getopts.pl';

push(@INC, '/usr/local/lib/perl');

require 'Comm.pl';

sub source {
 local($file,@dirs) = @_;
 local($d);

 @dirs = ('.', $Mydir, '/etc') if (scalar(@dirs) == 0);

 foreach $d (@dirs) {
   if (-s "$d/$file") {
     do "$d/$file";
     last;
   }
 }
}

$opt_f = '/dev/modem';

&source($rc);

$opt_d = 'modem';

&Getopts('P:f:u:p:c:d:vX:');

%RE = ('CONNECT', '',
      'OK', "ATDT$opt_X$opt_P\r",
      'ogin:', "$opt_u\r",
      'sername:', "$opt_u\r",
      'word:', "$opt_p\r",
      'hallenge:', 'interact::Acce',
      'PPP', 'sub:pppd:',
       'Device Busy', 'sub:exit:1',
      );

$cmd = "tip $opt_d";

# can update RE via $opt_c
do $opt_c if ( $opt_c ne '' && -s $opt_c );

&main;
exit 0;

sub main {
 &Comm'init(); #' comment just to please emacs
 ($pty,$tty,$pid) = &open_proc($cmd);
 if ($pid) {
   $timeout = 180;
   $err = '';
   print $pty "ATZ\r" if ($opt_d eq 'modem');
 LOOP1:
   while ($err eq '') {
     ( $match, $err, $before, $after ) =
       &expect( $pty, $timeout, 'EOF', 'TIMEOUT', keys(%RE));
     print STDERR "$before<$match>$after\n" if ($opt_v ne '');
     SWITCH : {
       last LOOP1 if ($err eq 'EOF');
       foreach $re (keys(%RE)) {
         if ($match =~ m/$re/) {
           if ($RE{$re} =~ m/interact:(.*):(.*)$/) {
             print "$before$match";
             ( $match, $err ) = &interact("$1", $pty, "$2");
             next SWITCH;
           } elsif ($RE{$re} =~ m/sub:(.*):(.*)$/) {
             $f = $1;
             @a = split(/,/, $2);
             &$f(@a);
           } else {
             print $pty "$RE{$re}" if ($RE{$re} ne '');
           }
           last SWITCH;
         }
       }
       &close_it($pty);
       print STDERR "before='$before',after='$after',err='$err'\n";
       exit 1;
     }
     $timeout = 60;
   }
   &close_it($pty);
 } else {
   push(@Errs, "do_Comm: could not run '$cmd'<p>");
   &fatal;
 }
}

sub pppd {
 if (system("pppd $opt_f") == 0) {
   if ($cmd =~ m/tip/) {
     print $pty "\r~.\r";
     sleep(1);
   }
   &close_it($pty);
   exit 0;
 }
}