Article 5489 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:5489
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.ecn.bgu.edu!usenet.ins.cwru.edu!howland.reston.ans.net!europa.eng.gtefsd.com!uunet!olivea!pagesat!news.cerf.net!netlabs!lwall
From: lwall@netlabs.com (Larry Wall)
Subject: Re: slip script (long) & question
Message-ID: <1993Aug30.190248.26531@netlabs.com>
Sender: news@netlabs.com
Nntp-Posting-Host: scalpel.netlabs.com
Organization: NetLabs, Inc.
References: <25sq07$dto@sylvester.cc.utexas.edu>
Date: Mon, 30 Aug 1993 19:02:48 GMT
Lines: 384

In article <25sq07$dto@sylvester.cc.utexas.edu> vax@sylvester.cc.utexas.edu (Vax) writes:
: I'm wondering why this script doesn't seem to set the proper settings on
: the modem (esp rts/cts hw flow control).  Tnx.
: I got this file off a Japanese FTP site somewhere, it's called "slipup".
: I modified it a bit, due to peculiarities of our TeleSys slip server.

Can't say offhand, but here's my original slipup for comparison purposes.
It seems to me that the BSD folks had to modify it somehow, but I don't
recall how.

Larry

#!/bin/sh
: make a subdirectory, cd to it, and run this through sh.
echo 'If this kit is complete, "End of kit" will echo at the end'
echo Extracting slipup
sed >slipup <<'!STUFFY!FUNK!' -e 's/X//'
X#!/usr/bin/perl
X#
X# configuration variables
X#
X$tty = "cua0";
X$debug = 0;
X$timeout = 60;
X$delay = 2;
X$verbose = 0;
X$phone = "95554321";
X$login = "MYLOGIN";
X$passwd = "MYPASSWORD";
X$network = "128.145";
X$idletime = 600;
X$threshold = 20;
X$busysleep = 10;
X$busyretries = 5;
X$LCKDIR = '/var/spool/locks';
X
X$ENV{PATH} = '/usr/bin:/etc:/usr/etc';
X
X# initialization
X
X$network =~ s/\./\\./g;
X$user = (getpwuid($<))[0];
X
Xrequire "sys/ttold.ph";
Xrequire "getopts.pl";
Xrequire "syslog.pl";
X&openlog("slipup $user", 'pid,cons,ndelay', 'daemon');
X
X#
X# process arguments
X#
X&Getopts('dvr:s:k:');
X$debug = 1 if defined $opt_d;
X$verbose = 1 if defined $opt_v;
X$busyretries = $opt_r if defined $opt_r;
X$busysleep = $opt_s if defined $opt_s;
X$KEEPTILL = time + $opt_k * 3600 if defined $opt_k;
X
Xeval '&main';
X&CLEANUP($@);
Xexit 1;
X
Xsub CLEANUP {
X    local($arg) = @_;
X
X    if ($arg) {
X	$0 = "slipup ($arg)";
X	warn "\n".$arg;
X	&syslog(WARNING, $arg);
X    }
X    else {
X	$0 = "slipup (shutting down normally)";
X    }
X    if ($sequencenumber) {
X	$sequencenumber = 0;
X	$SIG{ALRM} = CLEANUP;
X	alarm(15);
X	shutdown(ECHO,2);
X	close ECHO;
X	alarm(0);
X    }
X    kill 'TERM', $pid if $pid;
X    if ($ttyopen) {
X	system "stty 0";
X	close STDIN;
X	close STDOUT;
X	system "/bin/stty 0 >/dev/$tty";
X    }
X    unlink "$LCKDIR/LCK..$$";
X    if ($locked) {
X	system("/usr/etc/route -f") && warn "route flush failed\n";
X	unlink "$LCKDIR/LCK..$tty";
X    }
X    exit length($arg) != 0;
X}
X
Xsub SIGALRM { die "SIGALRM: ECHO timed out\n"; }
Xsub SIGPIPE { die "SIGPIPE: ECHO closed other end\n"; }
X
Xsub main {
X    #
X    # grab the line
X    #
X    $0 = "slipup (locking $tty)";
X    if (`/usr/ucb/netstat -i -n` =~ /$network/) {
X	    warn "Slip line is already up\n" if $verbose;
X	    exit 0;
X    }
X    warn "Opening /dev/$tty...\n" if $verbose;
X    die "$tty is busy\n" if -e "$LCKDIR/LCK..$tty";
X    open(LCK, ">$LCKDIR/LCK..$$") || die "Can't create lock: $!\n";
X    printf LCK "%10d\n", $$;
X    close LCK;
X    die "$tty is busy\n" unless link("$LCKDIR/LCK..$$", "$LCKDIR/LCK..$tty");
X    unlink "$LCKDIR/LCK..$$";
X    $locked++;
X    $0 = "slipup (opening $tty)";
X    die "$tty is not a tty\n" if ! -c "/dev/$tty";
X    die "Cannot open $tty: $!\n" if !open(STDOUT, "+>/dev/$tty");
X    $ttyopen++;
X    die "Cannot dup STDOUT to STDIN\n" if !open(STDIN, "+<&STDOUT");
X    &syslog("Can't ioctl(TIOCEXCL) on $tty: $!")
X	unless ioctl(STDOUT, &TIOCEXCL, 0);
X
X    $SIG{'INT'} = 'INTR_HAND';
X    $SIG{'HUP'} = 'INTR_HAND';
X    $SIG{'QUIT'} = 'INTR_HAND';
X    $SIG{'TERM'} = 'INTR_HAND';
X    $SIG{'USR1'} = 'UNDEBUG';
X
X    #
X    # configure the line
X    #
X    die "stty failed\n" if system "/bin/stty 19200 raw -echo min 1 time 0";
X
X    $| = 1;
X
X    #
X    # dial the modem
X    #
X    $0 = "slipup (dialing $tty)";
X    warn "Dialing modem...\n" if $verbose;
X    #&send("ATE1V1X2Q0S2=0S58=2S68=2S48=1S50=6S51=5S94=0S180=2S181=1S190=4\r\n");
X    &send("ATE1V1X2Q0S2=0S58=2S68=2S48=1S50=6S51=5S94=0S180=2\r\n");
X    &wait_for("OK");
X    &send("ATDT$phone\r");
X    $countdown = $busyretries;
X    while (&wait_pat("(BUSY|CONNECT|CARRIER)") ne 'CONNECT') {
X	$tries = $countdown . ($countdown == 1 ? " try" : " tries");
X	$0 = "slipup (redialing $tty, $tries left)";
X	die "BUSY\n" if $countdown <= 0;
X	warn "BUSY--trying again in $busysleep seconds, $tries left\n" if $verbose;
X	$countdown--;
X	&send("ATH\r");
X	sleep $busysleep;
X	&send("ATDT$phone\r");
X    }
X
X    #
X    # log into the terminal server
X    #
X    $0 = "slipup (logging in on $tty)";
X    warn "Logging in...\n" if $verbose;
X    &send("\r"); sleep($delay);
X    &send("\r"); sleep($delay);
X    &send("\r"); sleep($delay);
X    &send("\r"); sleep($delay);
X    &send("\r"); sleep($delay);
X    &wait_for("name:");
X    &send("$login\r");
X    &wait_for("ssword:");
X    &send("$passwd\r");
X    &wait_for("ts>");
X
X    #
X    # start slip
X    #
X    $0 = "slipup (starting slip on $tty)";
X    warn "Starting slip...\n" if $verbose;
X    &send("slip\n");
X    $_ = &wait_pat("Your IP address is .* MTU is 1500 bytes");
X    die "Cannot find slip address\n"
X	    if !/Your IP address is (\d+\.\d+\.\d+\.\d+),/;
X    $addr = $1;
X    $0 = "slipup (starting slip on $addr)";
X    die "stty failed\n" if system "/bin/stty crtscts";
X    die "route flush failed\n" if system "/usr/etc/route -f >/dev/null";
X
X    $ppid = $$;
X    if (fork) {
X	$SIG{HUP} = EXIT;
X	sleep 1 while 1;
X    }
X    $SIG{'TSTP'} = 'IGNORE';
X
X    if (!($pid = fork())) {
X	    $< = $>;
X	    warn "/usr/etc/slip-attach /dev/$tty 19200 $addr $addr 255.255.0.0\n" if $debug;
X	    exec "/usr/etc/slip-attach /dev/$tty 19200 $addr $addr 255.255.0.0";
X	    die "Couldn't exec slip-attach: $!\n";
X    }
X    $0 = "slipup (adding route for $addr)";
X    sleep 2;
X    if (`/usr/bin/ps auxww` =~ /root *(\d+).*slip-attach/) {
X	$pid = $1;
X    }
X    else {
X	$pid++;
X    }
X    die "route add default failed\n"
X	if system "/usr/etc/route add default $addr 1 >/dev/null";
X    warn "slip is up: process $pid, local address $addr\n" if $verbose;
X    &syslog(NOTICE, "started $pid on $tty, address $addr");
X
X    $SIG{'INT'} = 'IGNORE';
X    $SIG{'HUP'} = 'IGNORE';
X    $SIG{'QUIT'} = 'IGNORE';
X    kill 'HUP', $ppid;
X    sleep 1;
X    kill 'KILL', $ppid;
X
X    #
X    # now loop forever waiting for an idle line
X    #
X
X    setpgrp(0,$$);
X    sleep 2;
X    `/usr/ucb/netstat -i -n` =~ /(slip|stream)\d*\s*\d*\s*$network[.\d]*\s*[.\d]*\s*(\d*)/;
X    $lasti = $2;
X    warn "input: $lasti\n" if $debug;
X
X    &getsock(ECHO, $addr, 'tcp', 'echo');
X    $SIG{PIPE} = SIGPIPE;
X
X    while (1) {
X	    $KEEPTILL = 0 if time > $KEEPTILL;
X	    if ($KEEPTILL) {
X		$tmp = sprintf("%4.2f", ($KEEPTILL - time) / 3600);
X		$0 = "slipup (monitoring $pid--keeping $tmp more hours)";
X	    }
X	    else {
X		$0 = "slipup (monitoring $pid for $addr)";
X	    }
X
X	    sleep $idletime;
X
X	    print ECHO ++$sequencenumber, "\n";
X	    $SIG{ALRM} = SIGALRM;
X	    alarm(60);
X	    $echoed = <ECHO>;
X	    alarm(0);
X	    $echoed == $sequencenumber || die "ECHO sequence mismatch\n";
X
X	    unless (kill 0, $pid) {
X		system "/usr/etc/route -fn >/dev/null 2>&1"
X		    || &syslog(WARNING, "route flush failed\n");
X		&CLEANUP("slip-attach for $network [$pid] died!\n");
X	    }
X	    $_ = `/usr/ucb/netstat -i -n`;
X	    ($slipstream, $i)
X		= /(slip|stream)\d+\s+\d+\s+$network[.\d]*\s+[.\d]+\s+(\d+)/;
X	    unless ($slipstream) {
X		system "/usr/etc/route -fn >/dev/null 2>&1"
X		    || &syslog(WARNING, "route flush failed\n");
X		&CLEANUP("slip interface for $network disappeared!\n");
X	    }
X	    $diff = $i - $lasti;
X	    $lasti = $i;
X	    warn "input: $diff, seqnum: $echoed\n" if $debug;
X	    if ($diff < $threshold && time > $KEEPTILL) {
X		    $0 = "slipup (idlekilling pid $pid)";
X		    kill 'TERM', $pid;
X		    sleep 3;
X		    kill 'KILL', $pid;
X		    system "/usr/etc/route -fn >/dev/null 2>&1"
X			|| die "route flush failed\n";
X		    &syslog(NOTICE, "idle shutdown ($diff/$threshold)");
X		    warn "Idle too long--shutting down slip\n" if $verbose;
X		    &CLEANUP("");
X	    }
X    }
X}
X
Xsub get_char {
X  local($rmask, $nfound, $timeleft, $thisbuf);
X  $endtime = time + $timeout;
X  $rmask = "";
X  vec($rmask,fileno(STDIN),1) = 1;
X  ($nfound, $timeleft) = select($rmask, undef, undef, $endtime - time);
X  if ((0 + $endtime - time) <= 0) {
X	die "Timed out\n";
X  }
X  if ($nfound) {
X    $nread = sysread(STDIN, $thisbuf, 1024);
X    if (defined($nread)) {
X      print STDERR $thisbuf if $debug;
X      $str .= $thisbuf;
X      return "" if $nread == 0; # eof
X    }
X  } else {
X    return undef; # timeout ?
X  }
X}
X
Xsub wait_for {
X	local($pattern);
X
X	warn "WAITING FOR:\n\n$_[0]\n\n" if $debug;
X
X	($pattern = $_[0]) =~ s/(\W)/\\$1/g;
X	while (1) {
X		if ($str =~ /$pattern/) {
X			$str = $';
X			return $&;
X		}
X	&get_char;
X	}
X}
X
Xsub wait_pat {
X	warn "WAITING FOR PATTERN:\n\n$_[0]\n\n" if $debug;
X
X	while (1) {
X		if ($str =~ /$_[0]/) {
X			$str = $';
X			return $&;
X		}
X	&get_char;
X	}
X}
X
Xsub send {
X	local ($send) = @_;
X
X	warn "SENDING:\n\n$send\n\n" if $debug;
X	print "$send";
X}
X
Xsub INTR_HAND {
X	&CLEANUP("Received SIG$_[0]--aborting...\n");
X}
X
Xsub UNDEBUG { $debug = !$debug; warn "debug = $debug\n" if $verbose; }
X
Xsub EXIT { exit 0; }
X
Xsub getsock {
X    local($SOCK, $SERVER, $PROTO, $PORT) = @_;
X
X    $pat = 'S n C4 x8';
X
X    $af_unix = 1;
X    $af_inet = 2;
X
X    $stream = 1;
X    $datagram = 2;
X
X    local($name,$aliases,$proto) = getprotobyname($PROTO);
X
X    local($name,$aliases,$port,$proto) = getservbyname($PORT,$PROTO);
X
X    if ($SERVER =~ /^\d+\./) {
X	@bytes = split(/\./,$SERVER);
X    }
X    else {
X	($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($SERVER);
X	die "Can't lookup $SERVER\n" unless $name;
X	@bytes = unpack("C4",$addrs[0]);
X    }
X
X    $this = pack($pat,$af_inet,0,      0,0,0,0);
X    $that = pack($pat,$af_inet,$port,@bytes);
X
X    socket($SOCK,$af_inet,$stream,$proto) || die "socket: $!\n";
X    bind($SOCK,$this) || die "bind: $!\n";
X    connect($SOCK,$that) || die "connect to @bytes $port: $!\n";
X    select((select($SOCK), $| = 1)[0]);
X    1;
X}
!STUFFY!FUNK!
echo ""
echo "End of kit"
: I do not append .signature, but someone might mail this.
exit