[p5sagit/p5-mst-13.2.git] / lib / chat2.pl

# 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`);

# *S = symbol for current I/O, gets assigned *chatsymbol....
$next = "chatsymbol000000"; # next one
$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++


## $handle = &chat'open_port("server.address",$port_number);
## opens a named or numbered TCP server

sub open_port { ## public
	local($server, $port) = @_;

	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);
	} else {
		local(@x) = gethostbyname($server);
		return undef unless @x;
		$serveraddr = $x[4];
	}
	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
	unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) {
		($!) = ($!, close(S)); # close S while saving $!
		return undef;
	}
	unless (bind(S, $thisproc)) {
		($!) = ($!, close(S)); # close S while saving $!
		return undef;
	}
	unless (connect(S, $serverproc)) {
		($!) = ($!, 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
}

## ($host, $port, $handle) = &chat'open_listen([$port_number]);
## opens a TCP port on the current machine, ready to be listened to
## if $port_number is absent or zero, pick a default port number
## process must be uid 0 to listen to a low port number

sub open_listen { ## public

	*S = ++$next;
	local($thisport) = shift || 0;
	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
	local(*NS) = "__" . time;
	unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) {
		($!) = ($!, close(NS));
		return undef;
	}
	unless (bind(NS, $thisproc_local)) {
		($!) = ($!, close(NS));
		return undef;
	}
	unless (listen(NS, 1)) {
		($!) = ($!, close(NS));
		return undef;
	}
	select((select(NS), $| = 1)[0]);
	local($family, $port, @myaddr) =
		unpack("S n C C C C x8", getsockname(NS));
	$S{"needs_accept"} = *NS; # so expect will open it
	(@myaddr, $port, $next); # returning this
}

## $handle = &chat'open_proc("command","arg1","arg2",...);
## opens a /bin/sh on a pseudo-tty

sub open_proc { ## public
	local(@cmd) = @_;

	*S = ++$next;
	local(*TTY) = "__TTY" . time;
	local($pty,$tty) = &_getpty(S,TTY);
	die "Cannot find a new pty" unless defined $pty;
	$pid = fork;
	die "Cannot fork: $!" unless defined $pid;
	unless ($pid) {
		close STDIN; close STDOUT; close STDERR;
		setpgrp(0,$$);
		if (open(DEVTTY, "/dev/tty")) {
		    ioctl(DEVTTY,0x20007471,0);		# XXX s/b &TIOCNOTTY
		    close DEVTTY;
		}
		open(STDIN,"<&TTY");
		open(STDOUT,">&TTY");
		open(STDERR,">&STDOUT");
		die "Oops" unless fileno(STDERR) == 2;	# sanity
		close(S);
		exec @cmd;
		die "Cannot exec @cmd: $!";
	}
	close(TTY);
	$next; # return symbol for switcharound
}

# $S is the read-ahead buffer

## $return = &chat'expect([$handle,] $timeout_time,
## 	$pat1, $body1, $pat2, $body2, ... )
## $handle is from previous &chat'open_*().
## $timeout_time is the time (either relative to the current time, or
## absolute, ala time(2)) at which a timeout event occurs.
## $pat1, $pat2, and so on are regexs which are matched against the input
## stream.  If a match is found, the entire matched string is consumed,
## and the corresponding body eval string is evaled.
##
## Each pat is a regular-expression (probably enclosed in single-quotes
## in the invocation).  ^ and $ will work, respecting the current value of $*.
## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
## If pat is 'EOF', the body is executed if the process exits before
## the other patterns are seen.
##
## Pats are scanned in the order given, so later pats can contain
## general defaults that won't be examined unless the earlier pats
## have failed.
##
## The result of eval'ing body is returned as the result of
## the invocation.  Recursive invocations are not thought
## through, and may work only accidentally. :-)
##
## undef is returned if either a timeout or an eof occurs and no
## corresponding body has been defined.
## I/O errors of any sort are treated as eof.

$nextsubname = "expectloop000000"; # used for subroutines

sub expect { ## public
	if ($_[0] =~ /$nextpat/) {
		*S = shift;
	}
	local($endtime) = shift;

	local($timeout,$eof) = (1,1);
	local($caller) = caller;
	local($rmask, $nfound, $timeleft, $thisbuf);
	local($cases, $pattern, $action, $subname);
	$endtime += time if $endtime < 600_000_000;

	if (defined $S{"needs_accept"}) { # is it a listen socket?
		local(*NS) = $S{"needs_accept"};
		delete $S{"needs_accept"};
		$S{"needs_close"} = *NS;
		unless(accept(S,NS)) {
			($!) = ($!, close(S), close(NS));
			return undef;
		}
		select((select(S), $| = 1)[0]);
	}

	# now see whether we need to create a new sub:

	unless ($subname = $expect_subname{$caller,@_}) {
		# nope.  make a new one:
		$expect_subname{$caller,@_} = $subname = $nextsubname++;

		$cases .= <<"EDQ"; # header is funny to make everything elsif's
sub $subname {
	LOOP: {
		if (0) { ; }
EDQ
		while (@_) {
			($pattern,$action) = splice(@_,0,2);
			if ($pattern =~ /^eof$/i) {
				$cases .= <<"EDQ";
		elsif (\$eof) {
	 		package $caller;
			$action;
		}
EDQ
				$eof = 0;
			} elsif ($pattern =~ /^timeout$/i) {
			$cases .= <<"EDQ";
		elsif (\$timeout) {
		 	package $caller;
			$action;
		}
EDQ
				$timeout = 0;
			} else {
				$pattern =~ s#/#\\/#g;
			$cases .= <<"EDQ";
		elsif (\$S =~ /$pattern/) {
			\$S = \$';
		 	package $caller;
			$action;
		}
EDQ
			}
		}
		$cases .= <<"EDQ" if $eof;
		elsif (\$eof) {
			undef;
		}
EDQ
		$cases .= <<"EDQ" if $timeout;
		elsif (\$timeout) {
			undef;
		}
EDQ
		$cases .= <<'ESQ';
		else {
			$rmask = "";
			vec($rmask,fileno(S),1) = 1;
			($nfound, $rmask) =
		 		select($rmask, undef, undef, $endtime - time);
			if ($nfound) {
				$nread = sysread(S, $thisbuf, 1024);
				if ($nread > 0) {
					$S .= $thisbuf;
				} else {
					$eof++, redo LOOP; # any error is also eof
				}
			} else {
				$timeout++, redo LOOP; # timeout
			}
			redo LOOP;
		}
	}
}
ESQ
		eval $cases; die "$cases:\n$@" if $@;
	}
	$eof = $timeout = 0;
	do $subname();
}

## &chat'print([$handle,] @data)
## $handle is from previous &chat'open().
## like print $handle @data

sub print { ## public
	if ($_[0] =~ /$nextpat/) {
		*S = shift;
	}
	print S @_;
	if( $chat'debug ){
		print STDERR "printed:";
		print STDERR @_;
	}
}

## &chat'close([$handle,])
## $handle is from previous &chat'open().
## like close $handle

sub close { ## public
	if ($_[0] =~ /$nextpat/) {
	 	*S = shift;
	}
	close(S);
	if (defined $S{"needs_close"}) { # is it a listen socket?
		local(*NS) = $S{"needs_close"};
		delete $S{"needs_close"};
		close(NS);
	}
}

## @ready_handles = &chat'select($timeout, @handles)
## select()'s the handles with a timeout value of $timeout seconds.
## Returns an array of handles that are ready for I/O.
## Both user handles and chat handles are supported (but beware of
## stdio's buffering for user handles).

sub select { ## public
	local($timeout) = shift;
	local(@handles) = @_;
	local(%handlename) = ();
	local(%ready) = ();
	local($caller) = caller;
	local($rmask) = "";
	for (@handles) {
		if (/$nextpat/o) { # one of ours... see if ready
			local(*SYM) = $_;
			if (length($SYM)) {
				$timeout = 0; # we have a winner
				$ready{$_}++;
			}
			$handlename{fileno($_)} = $_;
		} else {
			$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
		}
	}
	for (sort keys %handlename) {
		vec($rmask, $_, 1) = 1;
	}
	select($rmask, undef, undef, $timeout);
	for (sort keys %handlename) {
		$ready{$handlename{$_}}++ if vec($rmask,$_,1);
	}
	sort keys %ready;
}

# ($pty,$tty) = $chat'_getpty(PTY,TTY):
# 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, $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/$kind%c0", $bank);
		for $unit (48..57) {
			$pty = sprintf("/dev/$kind%c%c", $bank, $unit);
			open($_PTY,"+>$pty") || next;
			select((select($_PTY), $| = 1)[0]);
			($tty = $pty) =~ s/pty/tty/;
			open($_TTY,"+>$tty") || next;
			select((select($_TTY), $| = 1)[0]);
			system "stty nl>$tty";
			return ($pty,$tty);
		}
	}
	undef;
}

1;
Commit	Line	Data
79072805	1	# chat.pl: chat with a server
	2	# Based on: V2.01.alpha.7 91/06/16
	3	# Randal L. Schwartz (was <merlyn@iwarp.intel.com>)
	4	# multihome additions by A.Macpherson@bnr.co.uk
	5	# allow for /dev/pts based systems by Joe Doupnik <JRD@CC.USU.EDU>
11aea360	6
	7	package chat;
	8
79072805	9	if( defined( &main'PF_INET ) ){
	10	$pf_inet = &main'PF_INET;
	11	$sock_stream = &main'SOCK_STREAM;
	12	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
	13	$tcp_proto = $proto;
	14	}
	15	else {
	16	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
	17	# but who the heck would change these anyway? (:-)
	18	$pf_inet = 2;
	19	$sock_stream = 1;
	20	$tcp_proto = 6;
	21	}
	22
	23
11aea360	24	$sockaddr = 'S n a4 x8';
79072805	25	chop($thishost = `hostname`);
11aea360	26
	27	# S = symbol for current I/O, gets assigned chatsymbol....
	28	$next = "chatsymbol000000"; # next one
	29	$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
	30
	31
	32	## $handle = &chat'open_port("server.address",$port_number);
	33	## opens a named or numbered TCP server
	34
	35	sub open_port { ## public
	36	local($server, $port) = @_;
	37
	38	local($serveraddr,$serverproc);
	39
79072805	40	# We may be multi-homed, start with 0, fixup once connexion is made
	41	$thisaddr = "\0\0\0\0" ;
	42	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
	43
11aea360	44	*S = ++$next;
	45	if ($server =~ /^(\d+)+\.(\d+)\.(\d+)\.(\d+)$/) {
	46	$serveraddr = pack('C4', $1, $2, $3, $4);
	47	} else {
	48	local(@x) = gethostbyname($server);
	49	return undef unless @x;
	50	$serveraddr = $x[4];
	51	}
	52	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
79072805	53	unless (socket(S, $pf_inet, $sock_stream, $tcp_proto)) {
11aea360	54	($!) = ($!, close(S)); # close S while saving $!
	55	return undef;
	56	}
	57	unless (bind(S, $thisproc)) {
	58	($!) = ($!, close(S)); # close S while saving $!
	59	return undef;
	60	}
	61	unless (connect(S, $serverproc)) {
	62	($!) = ($!, close(S)); # close S while saving $!
	63	return undef;
	64	}
79072805	65	# We opened with the local address set to ANY, at this stage we know
	66	# which interface we are using. This is critical if our machine is
	67	# multi-homed, with IP forwarding off, so fix-up.
	68	local($fam,$lport);
	69	($fam,$lport,$thisaddr) = unpack($sockaddr, getsockname(S));
	70	$thisproc = pack($sockaddr, 2, 0, $thisaddr);
	71	# end of post-connect fixup
11aea360	72	select((select(S), $\| = 1)[0]);
	73	$next; # return symbol for switcharound
	74	}
	75
	76	## ($host, $port, $handle) = &chat'open_listen([$port_number]);
	77	## opens a TCP port on the current machine, ready to be listened to
	78	## if $port_number is absent or zero, pick a default port number
	79	## process must be uid 0 to listen to a low port number
	80
	81	sub open_listen { ## public
	82
	83	*S = ++$next;
	84	local($thisport) = shift \|\| 0;
	85	local($thisproc_local) = pack($sockaddr, 2, $thisport, $thisaddr);
	86	local(*NS) = "__" . time;
79072805	87	unless (socket(NS, $pf_inet, $sock_stream, $tcp_proto)) {
11aea360	88	($!) = ($!, close(NS));
	89	return undef;
	90	}
	91	unless (bind(NS, $thisproc_local)) {
	92	($!) = ($!, close(NS));
	93	return undef;
	94	}
	95	unless (listen(NS, 1)) {
	96	($!) = ($!, close(NS));
	97	return undef;
	98	}
	99	select((select(NS), $\| = 1)[0]);
	100	local($family, $port, @myaddr) =
	101	unpack("S n C C C C x8", getsockname(NS));
	102	$S{"needs_accept"} = *NS; # so expect will open it
	103	(@myaddr, $port, $next); # returning this
	104	}
	105
	106	## $handle = &chat'open_proc("command","arg1","arg2",...);
	107	## opens a /bin/sh on a pseudo-tty
	108
	109	sub open_proc { ## public
	110	local(@cmd) = @_;
	111
	112	*S = ++$next;
	113	local(*TTY) = "__TTY" . time;
	114	local($pty,$tty) = &_getpty(S,TTY);
	115	die "Cannot find a new pty" unless defined $pty;
79072805	116	$pid = fork;
11aea360	117	die "Cannot fork: $!" unless defined $pid;
	118	unless ($pid) {
	119	close STDIN; close STDOUT; close STDERR;
	120	setpgrp(0,$$);
	121	if (open(DEVTTY, "/dev/tty")) {
	122	ioctl(DEVTTY,0x20007471,0); # XXX s/b &TIOCNOTTY
	123	close DEVTTY;
	124	}
	125	open(STDIN,"<&TTY");
	126	open(STDOUT,">&TTY");
	127	open(STDERR,">&STDOUT");
	128	die "Oops" unless fileno(STDERR) == 2; # sanity
	129	close(S);
	130	exec @cmd;
	131	die "Cannot exec @cmd: $!";
	132	}
	133	close(TTY);
	134	$next; # return symbol for switcharound
	135	}
	136
	137	# $S is the read-ahead buffer
	138
	139	## $return = &chat'expect([$handle,] $timeout_time,
	140	## $pat1, $body1, $pat2, $body2, ... )
	141	## $handle is from previous &chat'open_*().
	142	## $timeout_time is the time (either relative to the current time, or
	143	## absolute, ala time(2)) at which a timeout event occurs.
	144	## $pat1, $pat2, and so on are regexs which are matched against the input
	145	## stream. If a match is found, the entire matched string is consumed,
	146	## and the corresponding body eval string is evaled.
	147	##
	148	## Each pat is a regular-expression (probably enclosed in single-quotes
	149	## in the invocation). ^ and $ will work, respecting the current value of $*.
	150	## If pat is 'TIMEOUT', the body is executed if the timeout is exceeded.
	151	## If pat is 'EOF', the body is executed if the process exits before
	152	## the other patterns are seen.
	153	##
	154	## Pats are scanned in the order given, so later pats can contain
	155	## general defaults that won't be examined unless the earlier pats
	156	## have failed.
	157	##
	158	## The result of eval'ing body is returned as the result of
	159	## the invocation. Recursive invocations are not thought
	160	## through, and may work only accidentally. :-)
	161	##
	162	## undef is returned if either a timeout or an eof occurs and no
	163	## corresponding body has been defined.
	164	## I/O errors of any sort are treated as eof.
	165
	166	$nextsubname = "expectloop000000"; # used for subroutines
	167
	168	sub expect { ## public
	169	if ($_[0] =~ /$nextpat/) {
	170	*S = shift;
	171	}
	172	local($endtime) = shift;
	173
	174	local($timeout,$eof) = (1,1);
	175	local($caller) = caller;
	176	local($rmask, $nfound, $timeleft, $thisbuf);
	177	local($cases, $pattern, $action, $subname);
	178	$endtime += time if $endtime < 600_000_000;
	179
	180	if (defined $S{"needs_accept"}) { # is it a listen socket?
181	local(*NS) = $S{"needs_accept"};
182	delete $S{"needs_accept"};
183	$S{"needs_close"} = *NS;
184	unless(accept(S,NS)) {
185	($!) = ($!, close(S), close(NS));
186	return undef;
187	}
188	select((select(S), $\| = 1)[0]);
189	}
190
191	# now see whether we need to create a new sub:
192
193	unless ($subname = $expect_subname{$caller,@_}) {
194	# nope. make a new one:
195	$expect_subname{$caller,@_} = $subname = $nextsubname++;
196
197	$cases .= <<"EDQ"; # header is funny to make everything elsif's
198	sub $subname {
199	LOOP: {
200	if (0) { ; }
201	EDQ
202	while (@_) {
203	($pattern,$action) = splice(@_,0,2);
204	if ($pattern =~ /^eof$/i) {
205	$cases .= <<"EDQ";
206	elsif (\$eof) {
207	package $caller;
208	$action;
209	}
210	EDQ
211	$eof = 0;
212	} elsif ($pattern =~ /^timeout$/i) {
213	$cases .= <<"EDQ";
214	elsif (\$timeout) {
215	package $caller;
216	$action;
217	}
218	EDQ
219	$timeout = 0;
220	} else {
221	$pattern =~ s#/#\\/#g;
222	$cases .= <<"EDQ";
223	elsif (\$S =~ /$pattern/) {
224	\$S = \$';
225	package $caller;
226	$action;
227	}
228	EDQ
229	}
230	}
231	$cases .= <<"EDQ" if $eof;
232	elsif (\$eof) {
233	undef;
234	}
235	EDQ
236	$cases .= <<"EDQ" if $timeout;
237	elsif (\$timeout) {
238	undef;
239	}
240	EDQ
241	$cases .= <<'ESQ';
242	else {
243	$rmask = "";
244	vec($rmask,fileno(S),1) = 1;
245	($nfound, $rmask) =
246	select($rmask, undef, undef, $endtime - time);
247	if ($nfound) {
248	$nread = sysread(S, $thisbuf, 1024);
249	if ($nread > 0) {
250	$S .= $thisbuf;
251	} else {
252	$eof++, redo LOOP; # any error is also eof
253	}
254	} else {
255	$timeout++, redo LOOP; # timeout
256	}
257	redo LOOP;
258	}
259	}
260	}
261	ESQ
262	eval $cases; die "$cases:\n$@" if $@;
263	}
264	$eof = $timeout = 0;
265	do $subname();
266	}
267
268	## &chat'print([$handle,] @data)
269	## $handle is from previous &chat'open().
270	## like print $handle @data
271
272	sub print { ## public
273	if ($_[0] =~ /$nextpat/) {
274	*S = shift;
275	}
276	print S @_;
79072805	277	if( $chat'debug ){
	278	print STDERR "printed:";
	279	print STDERR @_;
	280	}
11aea360	281	}
	282
	283	## &chat'close([$handle,])
	284	## $handle is from previous &chat'open().
	285	## like close $handle
	286
	287	sub close { ## public
	288	if ($_[0] =~ /$nextpat/) {
	289	*S = shift;
	290	}
	291	close(S);
	292	if (defined $S{"needs_close"}) { # is it a listen socket?
	293	local(*NS) = $S{"needs_close"};
	294	delete $S{"needs_close"};
	295	close(NS);
	296	}
	297	}
	298
	299	## @ready_handles = &chat'select($timeout, @handles)
	300	## select()'s the handles with a timeout value of $timeout seconds.
	301	## Returns an array of handles that are ready for I/O.
	302	## Both user handles and chat handles are supported (but beware of
	303	## stdio's buffering for user handles).
	304
	305	sub select { ## public
	306	local($timeout) = shift;
	307	local(@handles) = @_;
	308	local(%handlename) = ();
	309	local(%ready) = ();
	310	local($caller) = caller;
	311	local($rmask) = "";
	312	for (@handles) {
	313	if (/$nextpat/o) { # one of ours... see if ready
	314	local(*SYM) = $_;
	315	if (length($SYM)) {
	316	$timeout = 0; # we have a winner
	317	$ready{$_}++;
	318	}
	319	$handlename{fileno($_)} = $_;
	320	} else {
	321	$handlename{fileno(/'/ ? $_ : "$caller\'$_")} = $_;
	322	}
	323	}
	324	for (sort keys %handlename) {
	325	vec($rmask, $_, 1) = 1;
	326	}
	327	select($rmask, undef, undef, $timeout);
	328	for (sort keys %handlename) {
	329	$ready{$handlename{$_}}++ if vec($rmask,$_,1);
	330	}
	331	sort keys %ready;
	332	}
	333
	334	# ($pty,$tty) = $chat'_getpty(PTY,TTY):
	335	# internal procedure to get the next available pty.
	336	# opens pty on handle PTY, and matching tty on handle TTY.
	337	# returns undef if can't find a pty.
79072805	338	# Modify "/dev/pty" to "/dev/pts" for Dell Unix v2.2 (aka SVR4.04). Joe Doupnik.
11aea360	339
	340	sub _getpty { ## private
	341	local($_PTY,$_TTY) = @_;
	342	$_PTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
	343	$_TTY =~ s/^([^']+)$/(caller)[$[]."'".$1/e;
79072805	344	local($pty, $tty, $kind);
	345	if( -e "/dev/pts000" ){ ## mods by Joe Doupnik Dec 1992
	346	$kind = "pts"; ## SVR4 Streams
	347	} else {
	348	$kind = "pty"; ## BSD Clist stuff
	349	}
11aea360	350	for $bank (112..127) {
79072805	351	next unless -e sprintf("/dev/$kind%c0", $bank);
11aea360	352	for $unit (48..57) {
79072805	353	$pty = sprintf("/dev/$kind%c%c", $bank, $unit);
11aea360	354	open($_PTY,"+>$pty") \|\| next;
	355	select((select($_PTY), $\| = 1)[0]);
	356	($tty = $pty) =~ s/pty/tty/;
	357	open($_TTY,"+>$tty") \|\| next;
	358	select((select($_TTY), $\| = 1)[0]);
	359	system "stty nl>$tty";
	360	return ($pty,$tty);
	361	}
	362	}
	363	undef;
	364	}
	365
	366	1;