news.utdallas.edu!wupost!uunet!ftpbox!cssmp.corp.mot.com!mmuegel Tue Mar 16 10:16:13 CST 1993
Article: 1608 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1608
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!wupost!uunet!ftpbox!cssmp.corp.mot.com!mmuegel
From: mmuegel@cssmp.corp.mot.com (Michael S. Muegel)
#Subject: Re: MORE on getting perl to do a telnet
Message-ID: <1993Mar16.041654.23592@ftpbox.mot.com>
Sender: news@ftpbox.mot.com (C News)
Organization: Corporate Information Office, Schaumburg, Illinois, Motorola, Inc.
References: <C3y7u3.5sr@cantua.canterbury.ac.nz> <9307510.27855@mulga.cs.mu.OZ.AU>
Date: Tue, 16 Mar 1993 04:16:54 GMT
Lines: 399

Previously, ggr@nareen.acci.COM.AU (Greg Rose) wrote:
> To correctly start up an actual telnet program on your local machine,
> you'll need to use pseudo-ttys.
> 
> >Any ideas?
> 
> Get Tcl and Expect. For a very small investment in learning, I think
> you'll be able to solve the problem much more easily.

You are correct about needing to emulate the telnet protocol; however,
dnoble@jpl-devvax.jpl.nasa.gov (David Noble) posted a couple of
packages to do just that in Perl.

Since I did not see it in the coombs.anu.edu.au archive I will repost
it here. Maybe it can be put in it Mark?

-Mike

=============================================================================
#! /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


-- 
+----------------------------------------------------------------------------+
| Michael S. Muegel                  | Internet E-Mail:    mmuegel@mot.com   |
| UNIX Applications Startup Group    | Moto Dist E-Mail:   X10090            |
| Corporate Information Office       | Voice:              (708) 576-0507    |
| Motorola                           | ... these are my opinions, honest ... |
+----------------------------------------------------------------------------+