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: [email protected] (Michael S. Muegel)
#Subject: Re: MORE on getting perl to do a telnet
Message-ID: <[email protected]>
Sender: [email protected] (C News)
Organization: Corporate Information Office, Schaumburg, Illinois, Motorola, Inc.
References: <[email protected]> <[email protected]>
Date: Tue, 16 Mar 1993 04:16:54 GMT
Lines: 399

Previously, [email protected] (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,
[email protected] (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 ([email protected])
;# 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 ([email protected])
;# 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:    [email protected]   |
| UNIX Applications Startup Group    | Moto Dist E-Mail:   X10090            |
| Corporate Information Office       | Voice:              (708) 576-0507    |
| Motorola                           | ... these are my opinions, honest ... |
+----------------------------------------------------------------------------+

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.