#!/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 <sjg@quick.com.au>
#


$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:
#	sjg@quick.com.au
#

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;
  }
}