[comp.lang.perl] chat.pl instead of expect

merlyn@iwarp.intel.com (Randal L. Schwartz) (02/09/91)

In article <0B&&-S^@rpi.edu>, rodney@dali (Rodney Peck II) writes:
|							      It doesn't quite
| work yet because I can't get interaction with FTP down properly.  I'm
| planning to use Randal's expect like perl code to handle this.  Ironically,
| I lost the pointer to it so I have to go poke around until I find it or
| someone mails me a message telling me where I can find it.

I set expect.pl aside when I realized that my primary "interaction"
was with TCP-type line-oriented servers (SMTP, FTPD, etc.).

Making plenty of assumptions, I wrote chat.pl, which is probably two
orders of magnitude better for talking to a line-oriented TCP/IP
server.

My next version will allow me to pass a regex for a delimiter to be
used instead of .*\n, and then I can toss expect.pl away for the few
things I was using it for.  I'm also thinking of allowing a pty-open
instead of a socket open, which would *really* allow nearly anyone who
had been using expect.pl to cross over.

Here's how simple it can be to use it.  Let's find out where "root"
mail goes:

##################################################
require '/local/merlyn/lib/perl/chat.pl';
&chat'open("localhost",25);
$_ = &chat'read(time + 10); # should be the 220 message within 10 seconds.
die "saw $_" unless /^220/;
&chat'print("EXPN root\n");
while ($_ = &chat'read(time + 10)) { # wait up to 10 secs for each line.
	print;
	last unless /^\d+-/; # loop until non-continuation line
}
&chat'print("QUIT\n");
$_ = &chat'read(time + 10); # should be the 221 message within 10 seconds.
die "saw $_" unless /^221/;
&chat'close();
##################################################

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of shell archive."
# Contents:  chat.pl
# Wrapped by merlyn@iwarpse on Fri Feb  8 10:35:32 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'chat.pl' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'chat.pl'\"
else
echo shar: Extracting \"'chat.pl'\" \(2050 characters\)
sed "s/^X//" >'chat.pl' <<'END_OF_FILE'
X## chat.pl: chat with a server
X## V1.0 91/02/08
X## Randal L. Schwartz
X
Xpackage chat;
X
X$sockaddr = 'S n a4 x8';
Xchop($thishost = `hostname`); $thisaddr = (gethostbyname($thishost))[4];
X$thisproc = pack($sockaddr, 2, 0, $thisaddr);
X
X# *S = symbol for current I/O, gets assigned *chatsymbol....
X$next = "chatsymbol000000"; # next one
X$nextpat = "^chatsymbol"; # patterns that match next++, ++, ++, ++
X
X
X## $handle = &chat'open("server.address",$port_number);
X
Xsub open { ## public
X	local($server, $port) = @_;
X
X	*S = ++$next;
X	local($serveraddr) = (gethostbyname($server))[4];
X	local($serverproc) = pack($sockaddr, 2, $port, $serveraddr);
X	socket(S, 2, 1, 6) || die "socket: $!";
X	bind(S, $thisproc) || die "bind: $!";
X	connect(S, $serverproc) || die "connect: $!";
X	select((select(S), $| = 1)[0]);
X	$next; # return symbol for switcharound
X}
X
X# $S is the read-ahead buffer
X
X## $return = &chat'read([$handle,] $timeout_time)
X## $handle is from previous &chat'open().
X## $timeout_time is time()-like integer denoting when to return undef
X## into $handle, rather than the first newline-terminated string.
X## "" is returned if handle is closed.
X
Xsub read { ## public
X	if ($_[0] =~ /$nextpat/) {
X		*S = shift;
X	}
X	local($endtime) = @_;
X	local($rmask, $nfound, $timeleft, $thisbuf);
X
X	{
X		return $& if $S =~ s/.*\n//;
X		$rmask = "";
X		vec($rmask,fileno(S),1) = 1;
X		($nfound, $rmask) =
X		 	select($rmask, undef, undef, $endtime - time);
X		if ($nfound) {
X			$nread = sysread(S, $thisbuf, 1024);
X			if (defined($nread)) {
X				$S .= $thisbuf;
X				return "" if $nread == 0; # eof
X			}
X			# if no data read, loop around to see if data is ready
X		} else {
X			return undef; # timeout
X		}
X		redo;
X	}
X}
X
X## &chat'print([$handle,] @data)
X## $handle is from previous &chat'open().
X## like print $handle @data
X
Xsub print { ## public
X	if ($_[0] =~ /$nextpat/) {
X		*S = shift;
X	}
X	print S @_;
X}
X
X## &chat'close([$handle,])
X## $handle is from previous &chat'open().
X## like close $handle
X
Xsub close { ## public
X	if ($_[0] =~ /$nextpat/) {
X	 	*S = shift;
X	}
X	close(S);
X}
X
X1;
END_OF_FILE
if test 2050 -ne `wc -c <'chat.pl'`; then
    echo shar: \"'chat.pl'\" unpacked with wrong size!
fi
# end of 'chat.pl'
fi
echo shar: End of shell archive.
exit 0

print "Just another Perl hacker,"
-- 
/=Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ==========\
| on contract to Intel's iWarp project, Beaverton, Oregon, USA, Sol III      |
| merlyn@iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
\=Cute Quote: "Intel: putting the 'backward' in 'backward compatible'..."====/

emv@ox.com (Ed Vielmetti) (02/09/91)

In article <1991Feb8.184821.6976@iwarp.intel.com> merlyn@iwarp.intel.com (Randal L. Schwartz) writes:

   $_ = &chat'read(time + 10); # should be the 220 message within 10 seconds.

Don't know about you, but I am on a slow line connecting (often) to
slow servers on congested links a long ways away.  10 seconds is not
enough in many cases...especially with TCP round trip times of 2 to 3
seconds!

--Ed
emv@ox.com