#!/usr/local/bin/perl
package telnet;

;# USAGE:
;# ======
;#
;# $buffer = &telnet'read($handle, $timeout);
;#
;# INPUTS:
;#
;# $handle	- regular file handle returned by opening the socket
;# $timeout	- number of seconds to wait before returning empty-handed
;#
;# RETURN VALUE:
;#
;# Returns data from the socket after removing the garbage from telnet
;# handshaking. If there is no multiline pattern matching, ie: ($* == 0),
;# then only one line at a time is returned. The remaining lines are buffered
;# in the package, and will be used to satisfy further requests for data until
;# the buffer is empty again. A partial line may be returned if the timeout
;# was reached before a newline. On the other hand, when multiline pattern
;# matching is on ($* == 1), all the available data is returned.
;#
;# Returns the empty string on EOF or timeout.
;# To decide which it was, use these functions:
;#
;#	if ( &telnet'eof )	{ &outta_here; }
;#	if ( &telnet'timeout )	{ &whatever; }
;#	if ( &telnet'ok )	{ &data_received; }
;#
;# AUTHOR:	David Noble (dnoble@ufo.jpl.nasa.gov)
;# DATE:	11 Feb 1993
;#
;# Modify and use as you see fit, but please leave my name on
;# it as long as it still resembles the original code.
;#
;#############################################################################

$status = 'ok';

sub read {
    local ($handle) = shift (@_);
    local ($endtime) = shift (@_);
    local ($rmask, $nfound, $nread, $thisbuf);
    local ($multilines) = $*;
    local ($buf) == '';
    $status = 'ok';
    $* = 1; # this gets restored to its previous value before returning

    if (!$TelnetBuffer{$handle}) {
      $endtime += time;
      get_data: while ($endtime > time) {
	$rmask = "";
	$thisbuf = "";
	vec($rmask, fileno($handle), 1) = 1;
	($nfound, $rmask) = select($rmask, undef, undef, $endtime - time);
	if ($nfound) {
	    $nread = sysread($handle, $thisbuf, 1024);
	    if ($nread > 0) {
		$TelnetBuffer{$handle} .= $thisbuf;
		last get_data if &_preprocess($handle) && !$multilines;
	    }
	    else {
		$status = 'eof';
		return ''; # connection closed
	    }
	}
	else {
	    $status = 'timeout';
	    last get_data;
	}
      }
    }

    if ($TelnetBuffer{$handle}) {
	if (!$multilines && ($TelnetBuffer{$handle} =~ m/\n/o)) {
	    $TelnetBuffer{$handle} =~ s/^(.*\n)//o;
	    $buf = $1;
	}
	else {
	    $buf = $TelnetBuffer{$handle};
	    $TelnetBuffer{$handle} = '';
	}
    }

    $* = $multilines;
    $buf;
}

sub ok { $status eq 'ok'; }
sub eof { $status eq 'eof'; }
sub timeout { $status eq 'timeout'; }
sub status { $status; }

sub _preprocess {
    local ($handle) = shift(@_);
    local ($_) = $TelnetBuffer{$handle};

    s/\015\012/\012/go; # combine (CR NL) into NL

    while (m/\377/o) {
	# respond to "IAC DO x" or "IAC DON'T x" with "IAC WON'T x"
	if (s/([^\377])?\377[\375\376](.|\n)/\1/o)
	    { print $handle "\377\374$2"; }

	# ignore "IAC WILL x" or "IAC WON'T x"
	elsif (s/([^\377])?\377[\373\374](.|\n)/\1/o) {;}

	# respond to "IAC AYT" (are you there)
	elsif (s/([^\377])?\377\366/\1/o)
	    { print $handle "nobody here but us pigeons\n"; }

	else { last; }
    }
    s/\377\377/\377/go; # handle escaped IAC characters

    $TelnetBuffer{$handle} = $_;
    m/\n/o; # return value: whether there is a full line or not
}

;# For those who are curious, here are some of the special characters
;# interpretted by the telnet protocol:
;# Name    Dec. Octal   Description
;# ----    ---- -----   -----------
;# IAC     255	\377	/* interpret as command: */
;# DONT    254	\376	/* you are not to use option */
;# DO      253	\375	/* please, you use option */
;# WONT    252	\374	/* I won't use option */
;# WILL    251	\373	/* I will use option */
;# SB      250	\372	/* interpret as subnegotiation */
;# GA      249	\371	/* you may reverse the line */
;# EL      248	\370	/* erase the current line */
;# EC      247	\367	/* erase the current character */
;# AYT     246	\366	/* are you there */
;# AO      245	\365	/* abort output--but let prog finish */
;# IP      244	\364	/* interrupt process--permanently */
;# BREAK   243	\363	/* break */
;# DM      242	\362	/* data mark--for connect. cleaning */
;# NOP     241	\361	/* nop */
;# SE      240	\360	/* end sub negotiation */
;# EOR     239	\357	/* end of record (transparent mode) */

1;