spssig.spss.com!news.oc.com!eff!sol.ctr.columbia.edu!howland.reston.ans.net!usc!elroy.jpl.nasa.gov!jato!ufo!dnoble Fri Feb 12 09:50:34 CST 1993
Article: 940 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:940
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!spssig.spss.com!news.oc.com!eff!sol.ctr.columbia.edu!howland.reston.ans.net!usc!elroy.jpl.nasa.gov!jato!ufo!dnoble
From: dnoble@jpl-devvax.jpl.nasa.gov (David Noble)
#Subject: Re: processing telnet output in perl
Message-ID: <1993Feb12.042613.2101@jpl-devvax.jpl.nasa.gov>
Summary: libraries for sockets and telnet
Organization: Jet Propulsion Laboratory (NASA)
References: <C2AMJ6.JwC@usenet.ucs.indiana.edu>
Date: Fri, 12 Feb 1993 04:26:13 GMT
Lines: 391

dan jacobson <djacobso@silver.ucs.indiana.edu> writes:
>From within a perl script, I'd like to open up a telnet session, issue
>commands and pipe the output for processing.

Maybe this is a good time for me to release some socket & telnet stuff I've
been playing with for a while. One library lets you open a socket and returns
a regular ol' file handle. The other library handles preprocessing the ugly
telnet handshaking and negotiations. They are mutually exclusive, which is
good if you've already got something you like that does one or the other.
I've also included a test program that starts a login session, sends a bad
password, then gives up. I haven't given this an expect-like interface,
basically since I've never ended up needing it, but that probably wouldn't
be too hard of an addition. Hope this helps...

$S = &sock'open($host,$port) && print $S "Just Another Perl Hacker\n";

David Noble (dnoble@ufo.jpl.nasa.gov)

Enclosed: sock.pl, telnet.pl, test_telnet
=============================================================================
# /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	perl_sockets
# This archive created: Thu Feb 11 20:10:16 1993
export PATH; PATH=/bin:$PATH
if test ! -d 'perl_sockets'
then
	mkdir 'perl_sockets'
fi
cd 'perl_sockets'
if test -f 'telnet.pl'
then
	echo shar: will not over-write existing file "'telnet.pl'"
else
cat << \SHAR_EOF > 'telnet.pl'
#/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;
SHAR_EOF
if test 4290 -ne "`wc -c < 'telnet.pl'`"
then
	echo shar: error transmitting "'telnet.pl'" '(should have been 4290 characters)'
fi
fi # end of overwriting check
if test -f 'sock.pl'
then
	echo shar: will not over-write existing file "'sock.pl'"
else
cat << \SHAR_EOF > 'sock.pl'
#/usr/local/bin/perl
package sock;

;# USAGE:
;# ======
;#
;# To open a connection to a socket:
;#
;#	$handle = &sock'open($hostname, $port) || die $!;
;#	# hostname & port can each be either a name or a number
;#
;# Read and write the same as with any other file handle:
;#
;#	print $handle "hello, socket\n";
;#	$response = <$handle>;
;#
;# To close cleanly:
;#
;#	&sock'close($handle);
;#
;# To close all open sockets, in case of an emergency exit:
;#
;#	&sock'close_all;
;#
;# 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.
;#
;#############################################################################

;# Get system-specific socket parameters, make assumptions if necessary.
$sockaddr_t = 'S n a4 x8';
eval "require 'sys/socket.ph'";
eval <<'END_SOCKET_DEFINITIONS' if $@;
  sub AF_INET		{ 2; }
  sub SOCK_STREAM	{ 1; }
  sub SOL_SOCKET	{ 65535; }
  sub SO_REUSEADDR	{ 4; }
END_SOCKET_DEFINITIONS

;# Seed the generation of names for file handles.
$latest_handle = 'sock0000000001';

sub open {
  local ($remote_host, $remote_port) = @_;
  if (!$remote_port) {
    $! = "bad arguments to sock'open()";
    return 0;
  }
  $sock = ++$latest_handle;

  ;# Look up the port if it was specified by name instead of by number.
  if ($remote_port =~ /\D/o) {
    ($name,$aliases,$remote_port) = getservbyname($remote_port,'tcp');
  }

  ;# Look up the address if it was specified by name instead of by number.
  if ($remote_host =~ /\D/o) {
    ($name,$aliases,$type,$len,$remote_addr) = gethostbyname($remote_host);
  } else {
    $remote_addr = $remote_host;
  }

  ;# Make the socket structures.
  $this = pack($sockaddr_t, &AF_INET, 0, "\0\0\0\0");
  $remote_sock = pack($sockaddr_t, &AF_INET, $remote_port, $remote_addr);

  ;# Make the socket filehandle.
  ($name,$aliases,$proto) = getprotobyname('tcp');
  socket($sock, &AF_INET, &SOCK_STREAM, $proto) || return 0;

  ;# Set up the port so it's freed as soon as we're done.
  setsockopt($sock, &SOL_SOCKET, &SO_REUSEADDR, 1);

  ;# Bind this socket to an address.
  bind($sock, $this) || return 0;

  ;# Call up the remote socket.
  connect($sock,$remote_sock) || return 0;

  $handles{$sock} = 1;
  $oldfh = select($sock); $| = 1; select($oldfh);
  return "sock'" . $sock;
}

sub close {
  local ($sock) = shift(@_) || return 0;
  shutdown ($sock, 2);
  delete $handles{$sock};
}

sub close_all {
  for $sock (keys %handles) {
    shutdown ($sock, 2);
    delete $handles{$sock};
  }
}
SHAR_EOF
if test 2588 -ne "`wc -c < 'sock.pl'`"
then
	echo shar: error transmitting "'sock.pl'" '(should have been 2588 characters)'
fi
fi # end of overwriting check
if test -f 'test_telnet'
then
	echo shar: will not over-write existing file "'test_telnet'"
else
cat << \SHAR_EOF > 'test_telnet'
#/usr/local/bin/perl
#
# test_telnet - simple test of sock.pl and telnet.pl
#
# This opens a telnet connection, attempts to log in as "nobody" with a
# bad password, then leaves the telnet session by sending a CTRL-D.
# The prompt strings are those of a Sun, so you may have to change these.
#
#############################################################################

require 'sock.pl';
require 'telnet.pl';

# routine for clean shutdown on error
sub abort {
  &sock'close_all;
  die "ended unexpectedly, but shut down cleanly\n";
}

$hostname = "localhost";
$port = "telnet";
$timeout = 1;

$login_prompt = '^login:';
$password_prompt = '^Password:';

#############################################################################
#
#	Open the connection
#
$session = &sock'open($hostname,$port) || die $!;

#############################################################################
#
# Get to the login prompt
#
while (1) {
  $_ = &telnet'read($session, $timeout);
  &abort if &telnet'eof;
  print;
  last if m/$login_prompt/o;
}
print $session "nobody\n"; # send a login name

#############################################################################
#
# Get the password prompt
#
while (1) {
  $_ = &telnet'read($session, $timeout);
  &abort if &telnet'eof;
  print;
  last if m/$password_prompt/o;
}
print $session "boguspw\n"; # send a password

#############################################################################
#
# Get the next login prompt, since the last one one should have failed
#
while (1) {
  $_ = &telnet'read($session, $timeout);
  &abort if &telnet'eof;
  print;
  last if m/$login_prompt/o;
}
print $session "\004"; # CTRL-D to abort the telnet session

#############################################################################
#
# Get any exit messages
#
until (&telnet'eof) {
  print &telnet'read($session, $timeout);
}
print "\ntest completed\n";

&sock'close($session);
exit (0);
SHAR_EOF
if test 1930 -ne "`wc -c < 'test_telnet'`"
then
	echo shar: error transmitting "'test_telnet'" '(should have been 1930 characters)'
fi
chmod +x 'test_telnet'
fi # end of overwriting check
cd ..
#	End of shell archive
exit 0