perl 5.0 alpha 2perl-5a2

[editor's note: from history.perl.org.  The sparc executables
originally included in the distribution are not in this commit.]

16 files changed, 1201 insertions, 81 deletions

diff --git a/lib/assert.pl b/lib/assert.pl
index cfda70cf29..0661d70af5 100644
--- a/lib/assert.pl
+++ b/lib/assert.pl
@@ -12,7 +12,7 @@
 # routine shamelessly borrowed from the perl debugger.
 
 sub assert {
-    &panic("ASSERTION BOTCHED: $_[0]",$@) unless eval $_[0];
+    &panic("ASSERTION BOTCHED: $_[$[]",$@) unless eval $_[$[];
 } 
 
 sub panic {
diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl
index 278f11d815..9ad171f295 100644
--- a/lib/bigfloat.pl
+++ b/lib/bigfloat.pl
@@ -11,7 +11,7 @@ require "bigint.pl";
 #   'NaN'           An input parameter was "Not a Number" or 
 #                       divide by zero or sqrt of negative number
 # Division is computed to 
-#   max($div_scale,length(dividend).length(divisor)) 
+#   max($div_scale,length(dividend)+length(divisor)) 
 #   digits by default.
 # Also used for default sqrt scale
 
@@ -66,7 +66,7 @@ sub norm { #(mantissa, exponent) return fnum_str
 
 # negation
 sub main'fneg { #(fnum_str) return fnum_str
-    local($_) = &'fnorm($_[0]);
+    local($_) = &'fnorm($_[$[]);
     vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign
     s/^H/N/;
     $_;
@@ -74,14 +74,14 @@ sub main'fneg { #(fnum_str) return fnum_str
 
 # absolute value
 sub main'fabs { #(fnum_str) return fnum_str
-    local($_) = &'fnorm($_[0]);
+    local($_) = &'fnorm($_[$[]);
     s/^-/+/;		                       # mash sign
     $_;
 }
 
 # multiplication
 sub main'fmul { #(fnum_str, fnum_str) return fnum_str
-    local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1]));
+    local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
     if ($x eq 'NaN' || $y eq 'NaN') {
 	'NaN';
     } else {
@@ -93,7 +93,7 @@ sub main'fmul { #(fnum_str, fnum_str) return fnum_str
 
 # addition
 sub main'fadd { #(fnum_str, fnum_str) return fnum_str
-    local($x,$y) = (&'fnorm($_[0]),&'fnorm($_[1]));
+    local($x,$y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
     if ($x eq 'NaN' || $y eq 'NaN') {
 	'NaN';
     } else {
@@ -106,7 +106,7 @@ sub main'fadd { #(fnum_str, fnum_str) return fnum_str
 
 # subtraction
 sub main'fsub { #(fnum_str, fnum_str) return fnum_str
-    &'fadd($_[0],&'fneg($_[1]));    
+    &'fadd($_[$[],&'fneg($_[$[+1]));    
 }
 
 # division
@@ -114,7 +114,7 @@ sub main'fsub { #(fnum_str, fnum_str) return fnum_str
 #   result has at most max(scale, length(dividend), length(divisor)) digits
 sub main'fdiv #(fnum_str, fnum_str[,scale]) return fnum_str
 {
-    local($x,$y,$scale) = (&'fnorm($_[0]),&'fnorm($_[1]),$_[2]);
+    local($x,$y,$scale) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]),$_[$[+2]);
     if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') {
 	'NaN';
     } else {
@@ -141,13 +141,13 @@ sub round { #(int_str, int_str, int_str) return int_str
 	if ( $cmp < 0 ||
 		 ($cmp == 0 &&
 		  ( $rnd_mode eq 'zero'                             ||
-		   ($rnd_mode eq '-inf' && (substr($q,0,1) eq '+')) ||
-		   ($rnd_mode eq '+inf' && (substr($q,0,1) eq '-')) ||
+		   ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) ||
+		   ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) ||
 		   ($rnd_mode eq 'even' && $q =~ /[24680]$/)        ||
 		   ($rnd_mode eq 'odd'  && $q =~ /[13579]$/)        )) ) {
 	    $q;                     # round down
 	} else {
-	    &'badd($q, ((substr($q,0,1) eq '-') ? '-1' : '+1'));
+	    &'badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1'));
 				    # round up
 	}
     }
@@ -155,7 +155,7 @@ sub round { #(int_str, int_str, int_str) return int_str
 
 # round the mantissa of $x to $scale digits
 sub main'fround { #(fnum_str, scale) return fnum_str
-    local($x,$scale) = (&'fnorm($_[0]),$_[1]);
+    local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
     if ($x eq 'NaN' || $scale <= 0) {
 	$x;
     } else {
@@ -163,8 +163,8 @@ sub main'fround { #(fnum_str, scale) return fnum_str
 	if (length($xm)-1 <= $scale) {
 	    $x;
 	} else {
-	    &norm(&round(substr($xm,0,$scale+1),
-			 "+0".substr($xm,$scale+1,1),"+10"),
+	    &norm(&round(substr($xm,$[,$scale+1),
+			 "+0".substr($xm,$[+$scale+1,1),"+10"),
 		  $xe+length($xm)-$scale-1);
 	}
     }
@@ -172,7 +172,7 @@ sub main'fround { #(fnum_str, scale) return fnum_str
 
 # round $x at the 10 to the $scale digit place
 sub main'ffround { #(fnum_str, scale) return fnum_str
-    local($x,$scale) = (&'fnorm($_[0]),$_[1]);
+    local($x,$scale) = (&'fnorm($_[$[]),$_[$[+1]);
     if ($x eq 'NaN') {
 	'NaN';
     } else {
@@ -184,10 +184,10 @@ sub main'ffround { #(fnum_str, scale) return fnum_str
 	    if ($xe < 1) {
 		'+0E+0';
 	    } elsif ($xe == 1) {
-		&norm(&round('+0',"+0".substr($xm,1,1),"+10"), $scale);
+		&norm(&round('+0',"+0".substr($xm,$[+1,1),"+10"), $scale);
 	    } else {
-		&norm(&round(substr($xm,0,$trunc),
-		      "+0".substr($xm,$trunc,1),"+10"), $scale);
+		&norm(&round(substr($xm,$[,$xe),
+		      "+0".substr($xm,$[+$xe,1),"+10"), $scale);
 	    }
 	}
     }
@@ -197,14 +197,14 @@ sub main'ffround { #(fnum_str, scale) return fnum_str
 #   returns undef if either or both input value are not numbers
 sub main'fcmp #(fnum_str, fnum_str) return cond_code
 {
-    local($x, $y) = (&'fnorm($_[0]),&'fnorm($_[1]));
+    local($x, $y) = (&'fnorm($_[$[]),&'fnorm($_[$[+1]));
     if ($x eq "NaN" || $y eq "NaN") {
 	undef;
     } else {
 	ord($y) <=> ord($x)
 	||
 	(  local($xm,$xe,$ym,$ye) = split('E', $x."E$y"),
-	     (($xe <=> $ye) * (substr($x,0,1).'1')
+	     (($xe <=> $ye) * (substr($x,$[,1).'1')
              || &bigint'cmp($xm,$ym))
 	);
     }
@@ -212,7 +212,7 @@ sub main'fcmp #(fnum_str, fnum_str) return cond_code
 
 # square root by Newtons method.
 sub main'fsqrt { #(fnum_str[, scale]) return fnum_str
-    local($x, $scale) = (&'fnorm($_[0]), $_[1]);
+    local($x, $scale) = (&'fnorm($_[$[]), $_[$[+1]);
     if ($x eq 'NaN' || $x =~ /^-/) {
 	'NaN';
     } elsif ($x eq '+0E+0') {
diff --git a/lib/bigint.pl b/lib/bigint.pl
index 5c79da9898..a2a0da977e 100644
--- a/lib/bigint.pl
+++ b/lib/bigint.pl
@@ -41,7 +41,7 @@ sub main'bnorm { #(num_str) return num_str
     local($_) = @_;
     s/\s+//g;                           # strip white space
     if (s/^([+-]?)0*(\d+)$/$1$2/) {     # test if number
-	substr($_,0,0) = '+' unless $1; # Add missing sign
+	substr($_,$[,0) = '+' unless $1; # Add missing sign
 	s/^-0/+0/;
 	$_;
     } else {
@@ -53,8 +53,8 @@ sub main'bnorm { #(num_str) return num_str
 #   Assumes normalized value as input.
 sub internal { #(num_str) return int_num_array
     local($d) = @_;
-    ($is,$il) = (substr($d,0,1),length($d)-2);
-    substr($d,0,1) = '';
+    ($is,$il) = (substr($d,$[,1),length($d)-2);
+    substr($d,$[,1) = '';
     ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d)));
 }
 
@@ -87,7 +87,7 @@ sub abs { # post-normalized abs for internal use
 
 # Compares 2 values.  Returns one of undef, <0, =0, >0. (suitable for sort)
 sub main'bcmp { #(num_str, num_str) return cond_code
-    local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1]));
+    local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
     if ($x eq 'NaN') {
 	undef;
     } elsif ($y eq 'NaN') {
@@ -109,7 +109,7 @@ sub cmp { # post-normalized compare for internal use
 }
 
 sub main'badd { #(num_str, num_str) return num_str
-    local(*x, *y); ($x, $y) = (&'bnorm($_[0]),&'bnorm($_[1]));
+    local(*x, *y); ($x, $y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
     if ($x eq 'NaN') {
 	'NaN';
     } elsif ($y eq 'NaN') {
@@ -132,12 +132,12 @@ sub main'badd { #(num_str, num_str) return num_str
 }
 
 sub main'bsub { #(num_str, num_str) return num_str
-    &'badd($_[0],&'bneg($_[1]));    
+    &'badd($_[$[],&'bneg($_[$[+1]));    
 }
 
 # GCD -- Euclids algorithm Knuth Vol 2 pg 296
 sub main'bgcd { #(num_str, num_str) return num_str
-    local($x,$y) = (&'bnorm($_[0]),&'bnorm($_[1]));
+    local($x,$y) = (&'bnorm($_[$[]),&'bnorm($_[$[+1]));
     if ($x eq 'NaN' || $y eq 'NaN') {
 	'NaN';
     } else {
@@ -176,7 +176,7 @@ sub sub { #(int_num_array, int_num_array) return int_num_array
 
 # multiply two numbers -- stolen from Knuth Vol 2 pg 233
 sub main'bmul { #(num_str, num_str) return num_str
-    local(*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1]));
+    local(*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
     if ($x eq 'NaN') {
 	'NaN';
     } elsif ($y eq 'NaN') {
@@ -187,7 +187,7 @@ sub main'bmul { #(num_str, num_str) return num_str
 	local($signr) = (shift @x ne shift @y) ? '-' : '+';
 	@prod = ();
 	for $x (@x) {
-	    ($car, $cty) = (0, 0);
+	    ($car, $cty) = (0, $[);
 	    for $y (@y) {
 		$prod = $x * $y + $prod[$cty] + $car;
 		$prod[$cty++] =
@@ -202,16 +202,16 @@ sub main'bmul { #(num_str, num_str) return num_str
 
 # modulus
 sub main'bmod { #(num_str, num_str) return num_str
-    (&'bdiv(@_))[1];
+    (&'bdiv(@_))[$[+1];
 }
 
 sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
-    local (*x, *y); ($x, $y) = (&'bnorm($_[0]), &'bnorm($_[1]));
+    local (*x, *y); ($x, $y) = (&'bnorm($_[$[]), &'bnorm($_[$[+1]));
     return wantarray ? ('NaN','NaN') : 'NaN'
 	if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0');
     return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0);
     @x = &internal($x); @y = &internal($y);
-    $srem = $y[0];
+    $srem = $y[$[];
     $sr = (shift @x ne shift @y) ? '-' : '+';
     $car = $bar = $prd = 0;
     if (($dd = int(1e5/($y[$#y]+1))) != 1) {
@@ -235,14 +235,14 @@ sub main'bdiv { #(dividend: num_str, divisor: num_str) return num_str
 	--$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2);
 	if ($q) {
 	    ($car, $bar) = (0,0);
-	    for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) {
+	    for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
 		$prd = $q * $y[$y] + $car;
 		$prd -= ($car = int($prd * 1e-5)) * 1e5;
 		$x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0));
 	    }
 	    if ($x[$#x] < $car + $bar) {
 		$car = 0; --$q;
-		for ($y = 0, $x = $#x-$#y-1; $y <= $#y; ++$y,++$x) {
+		for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) {
 		    $x[$x] -= 1e5
 			if ($car = (($x[$x] += $y[$y] + $car) > 1e5));
 		}
diff --git a/lib/bigrat.pl b/lib/bigrat.pl
index fb10cf35de..5bd127a9ae 100644
--- a/lib/bigrat.pl
+++ b/lib/bigrat.pl
@@ -62,63 +62,63 @@ sub norm { #(bint, bint) return rat_num
 	    $num = &'bnorm($num);
 	    $dom = &'bnorm($dom);
 	}
-	substr($dom,0,1) = '';
+	substr($dom,$[,1) = '';
 	"$num/$dom";
     }
 }
 
 # negation
 sub main'rneg { #(rat_num) return rat_num
-    local($_) = &'rnorm($_[0]);
+    local($_) = &'rnorm(@_);
     tr/-+/+-/ if ($_ ne '+0/1');
     $_;
 }
 
 # absolute value
 sub main'rabs { #(rat_num) return $rat_num
-    local($_) = &'rnorm($_[0]);
-    substr($_,0,1) = '+' unless $_ eq 'NaN';
+    local($_) = &'rnorm(@_);
+    substr($_,$[,1) = '+' unless $_ eq 'NaN';
     $_;
 }
 
 # multipication
 sub main'rmul { #(rat_num, rat_num) return rat_num
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
     &norm(&'bmul($xn,$yn),&'bmul($xd,$yd));
 }
 
 # division
 sub main'rdiv { #(rat_num, rat_num) return rat_num
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
     &norm(&'bmul($xn,$yd),&'bmul($xd,$yn));
 }
 
 # addition
 sub main'radd { #(rat_num, rat_num) return rat_num
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
     &norm(&'badd(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
 }
 
 # subtraction
 sub main'rsub { #(rat_num, rat_num) return rat_num
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
     &norm(&'bsub(&'bmul($xn,$yd),&'bmul($yn,$xd)),&'bmul($xd,$yd));
 }
 
 # comparison
 sub main'rcmp { #(rat_num, rat_num) return cond_code
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
-    local($yn,$yd) = split('/',&'rnorm($_[1]));
+    local($xn,$xd) = split('/',&'rnorm($_[$[]));
+    local($yn,$yd) = split('/',&'rnorm($_[$[+1]));
     &bigint'cmp(&'bmul($xn,$yd),&'bmul($yn,$xd));
 }
 
 # int and frac parts
 sub main'rmod { #(rat_num) return (rat_num,rat_num)
-    local($xn,$xd) = split('/',&'rnorm($_[0]));
+    local($xn,$xd) = split('/',&'rnorm(@_));
     local($i,$f) = &'bdiv($xn,$xd);
     if (wantarray) {
 	("$i/1", "$f/$xd");
@@ -130,7 +130,7 @@ sub main'rmod { #(rat_num) return (rat_num,rat_num)
 # square root by Newtons method.
 #   cycles specifies the number of iterations default: 5
 sub main'rsqrt { #(fnum_str[, cycles]) return fnum_str
-    local($x, $scale) = (&'rnorm($_[0]), $_[1]);
+    local($x, $scale) = (&'rnorm($_[$[]), $_[$[+1]);
     if ($x eq 'NaN') {
 	'NaN';
     } elsif ($x =~ /^-/) {
diff --git a/lib/chat2.pl b/lib/chat2.pl
index 662872c2d3..67d0c84069 100644
--- a/lib/chat2.pl
+++ b/lib/chat2.pl
@@ -1,12 +1,28 @@
-## chat.pl: chat with a server
-## V2.01.alpha.7 91/06/16
-## Randal L. Schwartz
+# chat.pl: chat with a server
+# Based on: V2.01.alpha.7 91/06/16
+# Randal L. Schwartz (was <merlyn@iwarp.intel.com>)
+# multihome additions by A.Macpherson@bnr.co.uk
+# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU>
 
 package chat;
 
+if( defined( &main'PF_INET ) ){
+	$pf_inet = &main'PF_INET;
+	$sock_stream = &main'SOCK_STREAM;
+	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	$tcp_proto = $proto;
+}
+else {
+	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+	# but who the heck would change these anyway? (:-)
+	$pf_inet = 2;
+	$sock_stream = 1;
+	$tcp_proto = 6;
+}
+
+
 $sockaddr = 'S n a4 x8';
-chop($thishost = `hostname`); $thisaddr = (gethostbyname($thishost))[4];
-$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+chop($thishost = `hostname`);
 
 # *S = symbol for current I/O, gets assigned *chatsymbol....
 $next = "chatsymbol000000"; # next one
@@ -21,6 +37,10 @@ sub open_port { ## public
 
 	local($serveraddr,$serverproc);
 
+	# We may be multi-homed, start with 0, fixup once connexion is made
+	$thisaddr = "\0\0\0\0" ;
+	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+
 	*S = ++$next;
 	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
 		$serveraddr = pack('C4', $1, $2, $3, $4);
@@ -30,9 +50,7 @@ sub open_port { ## public
 		$serveraddr = $x[4];
 	}
 	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
-	unless (socket(S, 2, 1, 6)) {
-		# XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
-		# but who the heck would change these anyway? (:-)
+	unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) {
 		($!) = ($!, close(S)); # close S while saving $!
 		return undef;
 	}
@@ -44,6 +62,13 @@ sub open_port { ## public
 		($!) = ($!, close(S)); # close S while saving $!
 		return undef;
 	}
+# We opened with the local address set to ANY, at this stage we know
+# which interface we are using.  This is critical if our machine is
+# multi-homed, with IP forwarding off, so fix-up.
+	local($fam,$lport);
+	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S));
+	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
+# end of post-connect fixup
 	select((select(S), $| = 1)[0]);
 	$next; # return symbol for switcharound
 }
@@ -59,9 +84,7 @@ sub open_listen { ## public
 	local($thisport) = shift || 0;
 	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
 	local(*NS) = "__" . time;
-	unless (socket(NS, 2, 1, 6)) {
-		# XXX hardwired $AF_SOCKET, $SOCK_STREAM, 'tcp'
-		# but who the heck would change these anyway? (:-)
+	unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) {
 		($!) = ($!, close(NS));
 		return undef;
 	}
@@ -90,7 +113,7 @@ sub open_proc { ## public
 	local(*TTY) = "__TTY" . time;
 	local($pty,$tty) = &_getpty(S,TTY);
 	die "Cannot find a new pty" unless defined $pty;
-	local($pid) = fork;
+	$pid = fork;
 	die "Cannot fork: $!" unless defined $pid;
 	unless ($pid) {
 		close STDIN; close STDOUT; close STDERR;
@@ -108,7 +131,6 @@ sub open_proc { ## public
 		die "Cannot exec @cmd: $!";
 	}
 	close(TTY);
-	$PID{$next} = $pid;
 	$next; # return symbol for switcharound
 }
 
@@ -252,6 +274,10 @@ sub print { ## public
 		*S = shift;
 	}
 	print S @_;
+	if( $chat'debug ){
+		print STDERR "printed:";
+		print STDERR @_;
+	}
 }
 
 ## &chat'close([$handle,])
@@ -259,15 +285,10 @@ sub print { ## public
 ## like close $handle
 
 sub close { ## public
-	local($pid);
 	if ($_[0] =~ /$nextpat/) {
-		$pid = $PID{$_[0]};
 	 	*S = shift;
-	} else {
-		$pid = $PID{$next};
 	}
 	close(S);
-	waitpid($pid,0);
 	if (defined $S{"needs_close"}) { # is it a listen socket?
 		local(*NS) = $S{"needs_close"};
 		delete $S{"needs_close"};
@@ -314,16 +335,22 @@ sub select { ## public
 # internal procedure to get the next available pty.
 # opens pty on handle PTY, and matching tty on handle TTY.
 # returns undef if can't find a pty.
+# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik.
 
 sub _getpty { ## private
 	local($_PTY,$_TTY) = @_;
 	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
 	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
-	local($pty,$tty);
+	local($pty, $tty, $kind);
+	if( -e "/dev/pts000" ){		## mods by Joe Doupnik Dec 1992
+		$kind = "pts";		## SVR4 Streams
+	} else {
+		$kind = "pty";		## BSD Clist stuff
+	}
 	for $bank (112..127) {
-		next unless -e sprintf("/dev/pty%c0", $bank);
+		next unless -e sprintf("/dev/$kind%c0", $bank);
 		for $unit (48..57) {
-			$pty = sprintf("/dev/pty%c%c", $bank, $unit);
+			$pty = sprintf("/dev/$kind%c%c", $bank, $unit);
 			open($_PTY,"+>$pty") || next;
 			select((select($_PTY), $| = 1)[0]);
 			($tty = $pty) =~ s/pty/tty/;
diff --git a/lib/ctime.pl b/lib/ctime.pl
index 6000d29a19..2d5ee65e36 100644
--- a/lib/ctime.pl
+++ b/lib/ctime.pl
@@ -3,7 +3,7 @@
 ;# Waldemar Kebsch, Federal Republic of Germany, November 1988
 ;# kebsch.pad@nixpbe.UUCP
 ;# Modified March 1990, Feb 1991 to properly handle timezones
-;#  $RCSfile: ctime.pl,v $$Revision: 4.0.1.1 $$Date: 92/06/08 13:38:06 $
+;#  $RCSfile: ctime.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:47 $
 ;#   Marion Hakanson (hakanson@cse.ogi.edu)
 ;#   Oregon Graduate Institute of Science and Technology
 ;#
diff --git a/lib/ftp.pl b/lib/ftp.pl
new file mode 100644
index 0000000000..e87a9b260c
--- /dev/null
+++ b/lib/ftp.pl
@@ -0,0 +1,1076 @@
+#-*-perl-*-
+# This is a wrapper to the chat2.pl routines that make life easier
+# to do ftp type work.
+# Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
+# based on original version by Alan R. Martello <al@ee.pitt.edu>
+# And by A.Macpherson@bnr.co.uk for multi-homed hosts
+#
+# $Header: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/ftp.pl,v 1.17 1993/04/21 10:06:54 lmjm Exp lmjm $
+# $Log: ftp.pl,v $
+# Revision 1.17  1993/04/21  10:06:54  lmjm
+# Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
+# Allow target file to be '-' meaning STDOUT
+# Added ftp'quote
+#
+# Revision 1.16  1993/01/28  18:59:05  lmjm
+# Allow socket arguemtns to come from main.
+# Minor cleanups - removed old comments.
+#
+# Revision 1.15  1992/11/25  21:09:30  lmjm
+# Added another REST return code.
+#
+# Revision 1.14  1992/08/12  14:33:42  lmjm
+# Fail ftp'write if out of space.
+#
+# Revision 1.13  1992/03/20  21:01:03  lmjm
+# Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
+# Added  ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
+#
+# Revision 1.12  1992/02/06  23:25:56  lmjm
+# Moved code around so can use this as a lib for both mirror and ftpmail.
+# Time out opens.  In case Unix doesn't bother to.
+#
+# Revision 1.11  1991/11/27  22:05:57  lmjm
+# Match the response code number at the start of a line allowing
+# for any leading junk.
+#
+# Revision 1.10  1991/10/23  22:42:20  lmjm
+# Added better timeout code.
+# Tried to optimise file transfer
+# Moved open/close code to not leak file handles.
+# Cleaned up the alarm code.
+# Added $fatalerror to show wether the ftp link is really dead.
+#
+# Revision 1.9  1991/10/07  18:30:35  lmjm
+# Made the timeout-read code work.
+# Added restarting file gets.
+# Be more verbose if ever have to call die.
+#
+# Revision 1.8  1991/09/17  22:53:16  lmjm
+# Spot when open_data_socket fails and return a failure rather than dying.
+#
+# Revision 1.7  1991/09/12  22:40:25  lmjm
+# Added Andrew Macpherson's patches for hosts without ip forwarding.
+#
+# Revision 1.6  1991/09/06  19:53:52  lmjm
+# Relaid out the code the way I like it!
+# Changed the debuggin to produce more "appropriate" messages
+# Fixed bugs in the ordering of put and dir listing.
+# Allow for hash printing when getting files (a la ftp).
+# Added the new commands from Al.
+# Don't print passwords in debugging.
+#
+# Revision 1.5  1991/08/29  16:23:49  lmjm
+# Timeout reads from the remote ftp server.
+# No longer call die expect on fatal errors.  Just return fail codes.
+# Changed returns so higher up routines can tell whats happening.
+# Get expect/accept in correct order for dir listing.
+# When ftp_show is set then print hashes every 1k transfered (like ftp).
+# Allow for stripping returns out of incoming data.
+# Save last error in a global string.
+#
+# Revision 1.4  1991/08/14  21:04:58  lmjm
+# ftp'get now copes with ungetable files.
+# ftp'expect code changed such that the string_to_print is
+# ignored and the string sent back from the remote system is printed
+# instead.
+# Implemented patches from al.  Removed spuiours tracing statements.
+#
+# Revision 1.3  1991/08/09  21:32:18  lmjm
+# Allow for another ok code on cwd's
+# Rejigger the log levels
+# Send \r\n for some odd ftp daemons
+#
+# Revision 1.2  1991/08/09  18:07:37  lmjm
+# Don't print messages unless ftp_show says to.
+#
+# Revision 1.1  1991/08/08  20:31:00  lmjm
+# Initial revision
+#
+
+require 'chat2.pl';
+require 'socket.ph';
+
+
+package ftp;
+
+if( defined( &main'PF_INET ) ){
+	$pf_inet = &main'PF_INET;
+	$sock_stream = &main'SOCK_STREAM;
+	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	$tcp_proto = $proto;
+}
+else {
+	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
+	# but who the heck would change these anyway? (:-)
+	$pf_inet = 2;
+	$sock_stream = 1;
+	$tcp_proto = 6;
+}
+
+# If the remote ftp daemon doesn't respond within this time presume its dead
+# or something.
+$timeout = 30;
+
+# Timeout a read if I don't get data back within this many seconds
+$timeout_read = 20 * $timeout;
+
+# Timeout an open
+$timeout_open = $timeout;
+
+# This is a "global" it contains the last response from the remote ftp server
+# for use in error messages
+$ftp'response = "";
+# Also ftp'NS is the socket containing the data coming in from the remote ls
+# command.
+
+# The size of block to be read or written when talking to the remote
+# ftp server
+$ftp'ftpbufsize = 4096;
+
+# How often to print a hash out, when debugging
+$ftp'hashevery = 1024;
+# Output a newline after this many hashes to prevent outputing very long lines
+$ftp'hashnl = 70;
+
+# If a proxy connection then who am I really talking to?
+$real_site = "";
+
+# This is just a tracing aid.
+$ftp_show = 0;
+sub ftp'debug
+{
+	$ftp_show = @_[0];
+#	if( $ftp_show ){
+#		print STDERR "ftp debugging on\n";
+#	}
+}
+
+sub ftp'set_timeout
+{
+	$timeout = @_[0];
+	$timeout_open = $timeout;
+	$timeout_read = 20 * $timeout;
+	if( $ftp_show ){
+		print STDERR "ftp timeout set to $timeout\n";
+	}
+}
+
+
+sub ftp'open_alarm
+{
+	die "timeout: open";
+}
+
+sub ftp'timed_open
+{
+	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+	local( $connect_site, $connect_port );
+	local( $res );
+
+	alarm( $timeout_open );
+
+	while( $attempts-- ){
+		if( $ftp_show ){
+			print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
+			print STDERR "Connecting to $site";
+			if( $ftp_port != 21 ){
+				print STDERR " [port $ftp_port]";
+			}
+			print STDERR "\n";
+		}
+		
+		if( $proxy ) {
+			if( ! $proxy_gateway ) {
+				# if not otherwise set
+				$proxy_gateway = "internet-gateway";
+			}
+			if( $debug ) {
+				print STDERR "using proxy services of $proxy_gateway, ";
+				print STDERR "at $proxy_ftp_port\n";
+			}
+			$connect_site = $proxy_gateway;
+			$connect_port = $proxy_ftp_port;
+			$real_site = $site;
+		}
+		else {
+			$connect_site = $site;
+			$connect_port = $ftp_port;
+		}
+		if( ! &chat'open_port( $connect_site, $connect_port ) ){
+			if( $retry_call ){
+				print STDERR "Failed to connect\n" if $ftp_show;
+				next;
+			}
+			else {
+				print STDERR "proxy connection failed " if $proxy;
+				print STDERR "Cannot open ftp to $connect_site\n" if $ftp_show;
+				return 0;
+			}
+		}
+		$res = &ftp'expect( $timeout,
+				    120, "service unavailable to $site", 0, 
+	                            220, "ready for login to $site", 1,
+				    421, "service unavailable to $site, closing connection", 0);
+		if( ! $res ){
+			&chat'close();
+			next;
+		}
+		return 1;
+	}
+	continue {
+		print STDERR "Pausing between retries\n";
+		sleep( $retry_pause );
+	}
+	return 0;
+}
+
+sub ftp'open
+{
+	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
+
+	$SIG{ 'ALRM' } = "ftp\'open_alarm";
+
+	local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
+	alarm( 0 );
+
+	if( $@ =~ /^timeout/ ){
+		return -1;
+	}
+	return $ret;
+}
+
+sub ftp'login
+{
+	local( $remote_user, $remote_password ) = @_;
+
+	if( $proxy ){
+		&ftp'send( "USER $remote_user@$site" );
+	}
+	else {
+		&ftp'send( "USER $remote_user" );
+	}
+        local( $val ) =
+               &ftp'expect($timeout,
+	           230, "$remote_user logged in", 1,
+		   331, "send password for $remote_user", 2,
+
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   530, "not logged in", 0,
+		   332, "account for login not supported", 0,
+
+		   421, "service unavailable, closing connection", 0);
+	if( $val == 1 ){
+		return 1;
+	}
+	if( $val == 2 ){
+		# A password is needed
+		&ftp'send( "PASS $remote_password" );
+
+		$val = &ftp'expect( $timeout,
+		   230, "$remote_user logged in", 1,
+
+		   202, "command not implemented", 0,
+		   332, "account for login not supported", 0,
+
+		   530, "not logged in", 0,
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   503, "bad sequence of commands", 0, 
+
+		   421, "service unavailable, closing connection", 0);
+		if( $val == 1){
+			# Logged in
+			return 1;
+		}
+	}
+	# If I got here I failed to login
+	return 0;
+}
+
+sub ftp'close
+{
+	&ftp'quit();
+	&chat'close();
+}
+
+# Change directory
+# return 1 if successful
+# 0 on a failure
+sub ftp'cwd
+{
+	local( $dir ) = @_;
+
+	&ftp'send( "CWD $dir" );
+
+	return &ftp'expect( $timeout,
+		200, "working directory = $dir", 1,
+		250, "working directory = $dir", 1,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+                502, "command not implemented", 0,
+		530, "not logged in", 0,
+                550, "cannot change directory", 0,
+		421, "service unavailable, closing connection", 0 );
+}
+
+# Get a full directory listing:
+# &ftp'dir( remote LIST options )
+# Start a list goin with the given options.
+# Presuming that the remote deamon uses the ls command to generate the
+# data to send back then then you can send it some extra options (eg: -lRa)
+# return 1 if sucessful and 0 on a failure
+sub ftp'dir_open
+{
+	local( $options ) = @_;
+	local( $ret );
+	
+	if( ! &ftp'open_data_socket() ){
+		return 0;
+	}
+	
+	if( $options ){
+		&ftp'send( "LIST $options" );
+	}
+	else {
+		&ftp'send( "LIST" );
+	}
+	
+	$ret = &ftp'expect( $timeout,
+		150, "reading directory", 1,
+	
+		125, "data connection already open?", 0,
+	
+		450, "file unavailable", 0,
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		502, "command not implemented", 0,
+		530, "not logged in", 0,
+	
+		   421, "service unavailable, closing connection", 0 );
+	if( ! $ret ){
+		&ftp'close_data_socket;
+		return 0;
+	}
+	
+	# 
+	# the data should be coming at us now
+	#
+	
+	# now accept
+	accept(NS,S) || die "accept failed $!";
+	
+	return 1;
+}
+
+
+# Close down reading the result of a remote ls command
+# return 1 if successful and 0 on failure
+sub ftp'dir_close
+{
+	local( $ret );
+
+	# read the close
+	#
+	$ret = &ftp'expect($timeout,
+        	226, "", 1,     # transfer complete, closing connection
+        	250, "", 1,     # action completed
+
+	        425, "can't open data connection", 0,
+        	426, "connection closed, transfer aborted", 0,
+	        451, "action aborted, local error", 0,
+	        421, "service unavailable, closing connection", 0);
+
+	# shut down our end of the socket
+	&ftp'close_data_socket;
+
+	if( ! $ret ){
+		return 0;
+	}
+
+	return 1;
+}
+
+# Quit from the remote ftp server
+# return 1 if successful and 0 on failure
+sub ftp'quit
+{
+	$site_command_check = 0;
+	@site_command_list = ();
+
+	&ftp'send("QUIT");
+
+	return &ftp'expect($timeout, 
+		221, "Goodbye", 1,     # transfer complete, closing connection
+	
+		500, "error quitting??", 0);
+}
+
+sub ftp'read_alarm
+{
+	die "timeout: read";
+}
+
+sub ftp'timed_read
+{
+	alarm( $timeout_read );
+	return sysread( NS, $buf, $ftpbufsize );
+}
+
+sub ftp'read
+{
+	$SIG{ 'ALRM' } = "ftp\'read_alarm";
+
+	local( $ret ) = eval '&timed_read()';
+	alarm( 0 );
+
+	if( $@ =~ /^timeout/ ){
+		return -1;
+	}
+	return $ret;
+}
+
+# Get a remote file back into a local file.
+# If no loc_fname passed then uses rem_fname.
+# returns 1 on success and 0 on failure
+sub ftp'get
+{
+	local($rem_fname, $loc_fname, $restart ) = @_;
+	
+	if ($loc_fname eq "") {
+		$loc_fname = $rem_fname;
+	}
+	
+	if( ! &ftp'open_data_socket() ){
+		print STDERR "Cannot open data socket\n";
+		return 0;
+	}
+
+	if( $loc_fname ne '-' ){
+		# Find the size of the target file
+		local( $restart_at ) = &ftp'filesize( $loc_fname );
+		if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
+			$restart = 1;
+			# Make sure the file can be updated
+			chmod( 0644, $loc_fname );
+		}
+		else {
+			$restart = 0;
+			unlink( $loc_fname );
+		}
+	}
+
+	&ftp'send( "RETR $rem_fname" );
+	
+	local( $ret ) =
+		&ftp'expect($timeout, 
+                   150, "receiving $rem_fname", 1,
+
+                   125, "data connection already open?", 0,
+
+                   450, "file unavailable", 2,
+                   550, "file unavailable", 2,
+
+		   500, "syntax error", 0,
+		   501, "syntax error", 0,
+		   530, "not logged in", 0,
+
+		   421, "service unavailable, closing connection", 0);
+	if( $ret != 1 ){
+		print STDERR "Failure on RETR command\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+	# 
+	# the data should be coming at us now
+	#
+
+	# now accept
+	accept(NS,S) || die "accept failed: $!";
+
+	#
+	#  open the local fname
+	#  concatenate on the end if restarting, else just overwrite
+	if( !open(FH, ($restart ? '>>' : '>') . $loc_fname) ){
+		print STDERR "Cannot create local file $loc_fname\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+#    while (<NS>) {
+#        print FH ;
+#    }
+
+	local( $start_time ) = time;
+	local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
+	while( ($len = &ftp'read()) > 0 ){
+		$bytes += $len;
+		if( $strip_cr ){
+			$ftp'buf =~ s/\r//g;
+		}
+		if( $ftp_show ){
+			while( $bytes > ($lasthash + $ftp'hashevery) ){
+				print STDERR '#';
+				$lasthash += $ftp'hashevery;
+				$hashes++;
+				if( ($hashes % $ftp'hashnl) == 0 ){
+					print STDERR "\n";
+				}
+			}
+		}
+		if( ! print FH $ftp'buf ){
+			print STDERR "\nfailed to write data";
+			return 0;
+		}
+	}
+	close( FH );
+
+	# shut down our end of the socket
+	&ftp'close_data_socket;
+
+	if( $len < 0 ){
+		print STDERR "\ntimed out reading data!\n";
+
+		return 0;
+	}
+		
+	if( $ftp_show ){
+		if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
+			print STDERR "\n";
+		}
+		local( $secs ) = (time - $start_time);
+		if( $secs <= 0 ){
+			$secs = 1; # To avoid a divide by zero;
+		}
+
+		local( $rate ) = int( $bytes / $secs );
+		print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
+	}
+
+	#
+	# read the close
+	#
+
+	$ret = &ftp'expect($timeout, 
+		226, "Got file", 1,     # transfer complete, closing connection
+	        250, "Got file", 1,     # action completed
+	
+	        110, "restart not supported", 0,
+	        425, "can't open data connection", 0,
+	        426, "connection closed, transfer aborted", 0,
+	        451, "action aborted, local error", 0,
+		421, "service unavailable, closing connection", 0);
+
+	return $ret;
+}
+
+sub ftp'delete
+{
+	local( $rem_fname, $val ) = @_;
+
+	&ftp'send("DELE $rem_fname" );
+	$val = &ftp'expect( $timeout, 
+			   250,"Deleted $rem_fname", 1,
+			   550,"Permission denied",0
+			   );
+	return $val == 1;
+}
+
+sub ftp'deldir
+{
+    local( $fname ) = @_;
+
+    # not yet implemented
+    # RMD
+}
+
+# UPDATE ME!!!!!!
+# Add in the hash printing and newline conversion
+sub ftp'put
+{
+	local( $loc_fname, $rem_fname ) = @_;
+	local( $strip_cr );
+	
+	if ($loc_fname eq "") {
+		$loc_fname = $rem_fname;
+	}
+	
+	if( ! &ftp'open_data_socket() ){
+		return 0;
+	}
+	
+	&ftp'send("STOR $rem_fname");
+	
+	# 
+	# the data should be coming at us now
+	#
+	
+	local( $ret ) =
+	&ftp'expect($timeout, 
+		150, "sending $loc_fname", 1,
+
+		125, "data connection already open?", 0,
+		450, "file unavailable", 0,
+
+		532, "need account for storing files", 0,
+		452, "insufficient storage on system", 0,
+		553, "file name not allowed", 0,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		530, "not logged in", 0,
+
+		421, "service unavailable, closing connection", 0);
+
+	if( $ret != 1 ){
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+
+
+	# 
+	# the data should be coming at us now
+	#
+	
+	# now accept
+	accept(NS,S) || die "accept failed: $!";
+	
+	#
+	#  open the local fname
+	#
+	if( !open(FH, "<$loc_fname") ){
+		print STDERR "Cannot open local file $loc_fname\n";
+
+		# shut down our end of the socket
+		&ftp'close_data_socket;
+
+		return 0;
+	}
+	
+	while (<FH>) {
+		print NS ;
+	}
+	close(FH);
+	
+	# shut down our end of the socket to signal EOF
+	&ftp'close_data_socket;
+	
+	#
+	# read the close
+	#
+	
+	$ret = &ftp'expect($timeout, 
+		226, "file put", 1,     # transfer complete, closing connection
+		250, "file put", 1,     # action completed
+	
+		110, "restart not supported", 0,
+		425, "can't open data connection", 0,
+		426, "connection closed, transfer aborted", 0,
+		451, "action aborted, local error", 0,
+		551, "page type unknown", 0,
+		552, "storage allocation exceeded", 0,
+	
+		421, "service unavailable, closing connection", 0);
+	if( ! $ret ){
+		print STDERR "error putting $loc_fname\n";
+	}
+	return $ret;
+}
+
+sub ftp'restart
+{
+	local( $restart_point, $ret ) = @_;
+
+	&ftp'send("REST $restart_point");
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect($timeout, 
+			   350, "restarting at $restart_point", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "REST not implemented", 2,
+			   530, "not logged in", 0,
+			   554, "REST not implemented", 2,
+			   
+			   421, "service unavailable, closing connection", 0);
+	return $ret;
+}
+
+# Set the file transfer type
+sub ftp'type
+{
+	local( $type ) = @_;
+
+	&ftp'send("TYPE $type");
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect($timeout, 
+			   200, "file type set to $type", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   504, "Invalid form or byte size for type $type", 0,
+			   
+			   421, "service unavailable, closing connection", 0);
+	return $ret;
+}
+
+$site_command_check = 0;
+@site_command_list = ();
+
+# routine to query the remote server for 'SITE' commands supported
+sub ftp'site_commands
+{
+	local( $ret );
+	
+	# if we havent sent a 'HELP SITE', send it now
+	if( !$site_command_check ){
+	
+		$site_command_check = 1;
+	
+		&ftp'send( "HELP SITE" );
+	
+		# assume the line in the HELP SITE response with the 'HELP'
+		# command is the one for us
+		$ret = &ftp'expect( $timeout,
+			".*HELP.*", "", "\$1",
+			214, "", "0",
+			202, "", "0" );
+	
+		if( $ret eq "0" ){
+			print STDERR "No response from HELP SITE\n" if( $ftp_show );
+		}
+	
+		@site_command_list = split(/\s+/, $ret);
+	}
+	
+	return @site_command_list;
+}
+
+# return the pwd, or null if we can't get the pwd
+sub ftp'pwd
+{
+	local( $ret, $cwd );
+
+	&ftp'send( "PWD" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   257, "working dir is", 1,
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "PWD not implemented", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	if( $ret ){
+		if( $ftp'response =~ /^257\s"(.*)"\s.*$/ ){
+			$cwd = $1;
+		}
+	}
+	return $cwd;
+}
+
+# return 1 for success, 0 for failure
+sub ftp'mkdir
+{
+	local( $path ) = @_;
+	local( $ret );
+
+	&ftp'send( "MKD $path" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   257, "made directory $path", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "MKD not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	return $ret;
+}
+
+# return 1 for success, 0 for failure
+sub ftp'chmod
+{
+	local( $path, $mode ) = @_;
+	local( $ret );
+
+	&ftp'send( sprintf( "SITE CHMOD %o $path", $mode ) );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   200, "chmod $mode $path succeeded", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "CHMOD not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+
+			   421, "service unavailable, closing connection", 0 );
+	return $ret;
+}
+
+# rename a file
+sub ftp'rename
+{
+	local( $old_name, $new_name ) = @_;
+	local( $ret );
+
+	&ftp'send( "RNFR $old_name" );
+
+	# 
+	# see what they say
+
+	$ret = &ftp'expect( $timeout, 
+			   350, "", 1,
+			   
+			   500, "syntax error", 0,
+			   501, "syntax error", 0,
+			   502, "RNFR not implemented", 0,
+			   530, "not logged in", 0,
+	                   550, "file unavailable", 0,
+	                   450, "file unavailable", 0,
+			   
+			   421, "service unavailable, closing connection", 0);
+
+
+	# check if the "rename from" occurred ok
+	if( $ret ) {
+		&ftp'send( "RNTO $new_name" );
+	
+		# 
+		# see what they say
+	
+		$ret = &ftp'expect( $timeout, 
+			           250, "rename $old_name to $new_name", 1, 
+
+				   500, "syntax error", 0,
+				   501, "syntax error", 0,
+				   502, "RNTO not implemented", 0,
+				   503, "bad sequence of commands", 0,
+				   530, "not logged in", 0,
+		                   532, "need account for storing files", 0,
+		                   553, "file name not allowed", 0,
+				   
+				   421, "service unavailable, closing connection", 0);
+	}
+
+	return $ret;
+}
+
+
+sub ftp'quote
+{
+      local( $cmd ) = @_;
+
+      &ftp'send( $cmd );
+
+      return &ftp'expect( $timeout, 
+              200, "Remote '$cmd' OK", 1,
+              500, "error in remote '$cmd'", 0 );
+}
+
+# ------------------------------------------------------------------------------
+# These are the lower level support routines
+
+sub ftp'expectgot
+{
+	($ftp'response, $ftp'fatalerror) = @_;
+	if( $ftp_show ){
+		print STDERR "$ftp'response\n";
+	}
+}
+
+#
+#  create the list of parameters for chat'expect
+#
+#  ftp'expect(time_out, {value, string_to_print, return value});
+#     if the string_to_print is "" then nothing is printed
+#  the last response is stored in $ftp'response
+#
+# NOTE: lmjm has changed this code such that the string_to_print is
+# ignored and the string sent back from the remote system is printed
+# instead.
+#
+sub ftp'expect {
+	local( $ret );
+	local( $time_out );
+	local( $expect_args );
+	
+	$ftp'response = '';
+	$ftp'fatalerror = 0;
+
+	@expect_args = ();
+	
+	$time_out = shift(@_);
+	
+	while( @_ ){
+		local( $code ) = shift( @_ );
+		local( $pre ) = '^';
+		if( $code =~ /^\d/ ){
+			$pre =~ "[.|\n]*^";
+		}
+		push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
+		shift( @_ );
+		push( @expect_args, 
+			"&ftp'expectgot( \$1, 0 ); " . shift( @_ ) );
+	}
+	
+	# Treat all unrecognised lines as continuations
+	push( @expect_args, "^(.*)\\015\\n" );
+	push( @expect_args, "&ftp'expectgot( \$1, 0 ); 100" );
+	
+	# add patterns TIMEOUT and EOF
+	
+	push( @expect_args, 'TIMEOUT' );
+	push( @expect_args, "&ftp'expectgot( \"timed out\", 1 ); 0" );
+	
+	push( @expect_args, 'EOF' );
+	push( @expect_args, "&ftp'expectgot( \"remote server gone away\", 1 ); 0" );
+	
+	if( $ftp_show > 9 ){
+		&printargs( $time_out, @expect_args );
+	}
+	
+	$ret = &chat'expect( $time_out, @expect_args );
+	if( $ret == 100 ){
+		# we saw a continuation line, wait for the end
+		push( @expect_args, "^.*\n" );
+		push( @expect_args, "100" );
+	
+		while( $ret == 100 ){
+			$ret = &chat'expect( $time_out, @expect_args );
+		}
+	}
+	
+	return $ret;
+}
+
+#
+#  opens NS for io
+#
+sub ftp'open_data_socket
+{
+	local( $ret );
+	local( $hostname );
+	local( $sockaddr, $name, $aliases, $proto, $port );
+	local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
+	local( $mysockaddr, $family, $hi, $lo );
+	
+	
+	$sockaddr = 'S n a4 x8';
+	chop( $hostname = `hostname` );
+	
+	$port = "ftp";
+	
+	($name, $aliases, $proto) = getprotobyname( 'tcp' );
+	($name, $aliases, $port) = getservbyname( $port, 'tcp' );
+	
+#	($name, $aliases, $type, $len, $thisaddr) =
+#	gethostbyname( $hostname );
+	($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
+	
+#	$this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
+	$this = $chat'thisproc;
+	
+	socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
+	bind(S, $this) || die "bind: $!";
+	
+	# get the port number
+	$mysockaddr = getsockname(S);
+	($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
+	
+	$hi = ($port >> 8) & 0x00ff;
+	$lo = $port & 0x00ff;
+	
+	#
+	# we MUST do a listen before sending the port otherwise
+	# the PORT may fail
+	#
+	listen( S, 5 ) || die "listen";
+	
+	&ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
+	
+	return &ftp'expect($timeout,
+		200, "PORT command successful", 1,
+		250, "PORT command successful", 1 ,
+
+		500, "syntax error", 0,
+		501, "syntax error", 0,
+		530, "not logged in", 0,
+
+		421, "service unavailable, closing connection", 0);
+}
+	
+sub ftp'close_data_socket
+{
+	close(NS);
+}
+
+sub ftp'send
+{
+	local($send_cmd) = @_;
+	if( $send_cmd =~ /\n/ ){
+		print STDERR "ERROR, \\n in send string for $send_cmd\n";
+	}
+	
+	if( $ftp_show ){
+		local( $sc ) = $send_cmd;
+
+		if( $send_cmd =~ /^PASS/){
+			$sc = "PASS <somestring>";
+		}
+		print STDERR "---> $sc\n";
+	}
+	
+	&chat'print( "$send_cmd\r\n" );
+}
+
+sub ftp'printargs
+{
+	while( @_ ){
+		print STDERR shift( @_ ) . "\n";
+	}
+}
+
+sub ftp'filesize
+{
+	local( $fname ) = @_;
+
+	if( ! -f $fname ){
+		return -1;
+	}
+
+	return (stat( _ ))[ 7 ];
+	
+}
+
+# make this package return true
+1;
diff --git a/lib/getopt.pl b/lib/getopt.pl
index b9d7b5b75b..a6023c80bc 100644
--- a/lib/getopt.pl
+++ b/lib/getopt.pl
@@ -1,4 +1,4 @@
-;# $RCSfile: getopt.pl,v $$Revision: 4.0.1.1 $$Date: 91/11/05 17:53:01 $
+;# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $
 
 ;# Process single-character switches with switch clustering.  Pass one argument
 ;# which is a string containing all switches that take an argument.  For each
diff --git a/lib/importenv.pl b/lib/importenv.pl
index 98ffa14131..d56f32633b 100644
--- a/lib/importenv.pl
+++ b/lib/importenv.pl
@@ -1,4 +1,4 @@
-;# $Header: importenv.pl,v 4.0 91/03/20 01:25:28 lwall Locked $
+;# $RCSfile: importenv.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:02 $
 
 ;# This file, when interpreted, pulls the environment into normal variables.
 ;# Usage:
diff --git a/lib/perldb.pl b/lib/perldb.pl
index 8cfc36c32d..ff73d81e3d 100644
--- a/lib/perldb.pl
+++ b/lib/perldb.pl
@@ -4,7 +4,7 @@ package DB;
 # Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990
 # Johan Vromans -- upgrade to 4.0 pl 10
 
-$header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.3 $$Date: 92/06/08 13:43:57 $';
+$header = '$RCSfile: perldb.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:07 $';
 #
 # This file is automatically included if you do perl -d.
 # It's probably not useful to include this yourself.
@@ -14,6 +14,8 @@ $header = '$RCSfile: perldb.pl,v $$Revision: 4.0.1.3 $$Date: 92/06/08 13:43:57 $
 # have a breakpoint.  It also inserts a do 'perldb.pl' before the first line.
 #
 # $Log:	perldb.pl,v $
+# Revision 4.1  92/08/07  18:24:07  lwall
+# 
 # Revision 4.0.1.3  92/06/08  13:43:57  lwall
 # patch20: support for MSDOS folded into perldb.pl
 # patch20: perldb couldn't debug file containing '-', such as STDIN designator
@@ -199,8 +201,9 @@ command		Execute as a perl statement in current package.
 		    next CMD; };
 		$cmd =~ s/^X\b/V $package/;
 		$cmd =~ /^V$/ && do {
-		    $cmd = 'V $package'; };
+		    $cmd = "V $package"; };
 		$cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do {
+		    local ($savout) = select(OUT);
 		    $packname = $1;
 		    @vars = split(' ',$2);
 		    do 'dumpvar.pl' unless defined &main'dumpvar;
@@ -210,6 +213,7 @@ command		Execute as a perl statement in current package.
 		    else {
 			print DB'OUT "dumpvar.pl not available.\n";
 		    }
+		    select ($savout);
 		    next CMD; };
 		$cmd =~ /^f\b\s*(.*)/ && do {
 		    $file = $1;
diff --git a/lib/pwd.pl b/lib/pwd.pl
index 89fc230ff2..8e17dd02d2 100644
--- a/lib/pwd.pl
+++ b/lib/pwd.pl
@@ -1,8 +1,10 @@
 ;# pwd.pl - keeps track of current working directory in PWD environment var
 ;#
-;# $RCSfile: pwd.pl,v $$Revision: 4.0.1.1 $$Date: 92/06/08 13:45:22 $
+;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $
 ;#
 ;# $Log:	pwd.pl,v $
+;# Revision 4.1  92/08/07  18:24:11  lwall
+;# 
 ;# Revision 4.0.1.1  92/06/08  13:45:22  lwall
 ;# patch20: support added to pwd.pl to strip automounter crud
 ;# 
diff --git a/lib/stat.pl b/lib/stat.pl
index 9f03cbc161..f7c240a4b3 100644
--- a/lib/stat.pl
+++ b/lib/stat.pl
@@ -1,4 +1,4 @@
-;# $Header: stat.pl,v 4.0 91/03/20 01:26:16 lwall Locked $
+;# $RCSfile: stat.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:13 $
 
 ;# Usage:
 ;#	require 'stat.pl';
diff --git a/lib/syslog.pl b/lib/syslog.pl
index 842414e4c7..8e64a0028d 100644
--- a/lib/syslog.pl
+++ b/lib/syslog.pl
@@ -2,6 +2,8 @@
 # syslog.pl
 #
 # $Log:	syslog.pl,v $
+# Revision 4.1  92/08/07  18:24:15  lwall
+# 
 # Revision 4.0.1.1  92/06/08  13:48:05  lwall
 # patch20: new warning for ambiguous use of unary operators
 # 
diff --git a/lib/tainted.pl b/lib/tainted.pl
new file mode 100644
index 0000000000..6e24867a83
--- /dev/null
+++ b/lib/tainted.pl
@@ -0,0 +1,9 @@
+# This subroutine returns true if its argument is tainted, false otherwise.
+
+sub tainted {
+    local($@);
+    eval { kill 0 * $_[0] };
+    $@ =~ /^Insecure/;
+}
+
+1;
diff --git a/lib/termcap.pl b/lib/termcap.pl
index aa221dfc39..5b48d71720 100644
--- a/lib/termcap.pl
+++ b/lib/termcap.pl
@@ -1,4 +1,4 @@
-;# $RCSfile: termcap.pl,v $$Revision: 4.0.1.1 $$Date: 92/06/08 13:49:17 $
+;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $
 ;#
 ;# Usage:
 ;#	require 'ioctl.pl';
diff --git a/lib/validate.pl b/lib/validate.pl
index 2c8ee45c1d..21d0505ad4 100644
--- a/lib/validate.pl
+++ b/lib/validate.pl
@@ -1,4 +1,4 @@
-;# $Header: validate.pl,v 4.0 91/03/20 01:26:56 lwall Locked $
+;# $RCSfile: validate.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:19 $
 
 ;# The validate routine takes a single multiline string consisting of
 ;# lines containing a filename plus a file test to try on it.  (The