merlyn@iwarp.intel.com (Randal Schwartz) (11/02/90)
Well, here it is. The motivation for writing this package is the fact
that Don Libes doesn't like Perl. :-)
Anyway, this is an ALPHA release of an 'expect' emulation written as a
Perl package. There are still some things to add to this, but the
basics (spawning multiple interactive processes, then interacting with
them watching their output through regexps and timeouts) are all
there. And useful too... I'm already writing code that uses these
subroutines, and it's slick.
The matchup of expect<->tcl and expect.pl<->Perl made for some weird
design tradeoffs. I may start from mostly scratch and do everything
right. That is probably why I hesitate to implement the rest of the
functions... they really don't fit in a Perl environment.
Many thanks to Larry Wall. He wrote about 1/3 of the trickier code,
and egged me on to do this. (He's tired of people remarking "Why
should I use Perl when it can't do what expect does?" Now you can
have both in one interpreter. :-)
This code will be revised when I get a Perl that has "caller". Stay
tuned to comp.lang.perl for details.
&spawn(CAT,"cat");&send(CAT,"Just another Perl hacker,");&close(CAT);
#! /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: expect.pl
# Wrapped by merlyn@iwarpse on Thu Nov 1 16:25:12 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'expect.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'expect.pl'\"
else
echo shar: Extracting \"'expect.pl'\" \(9287 characters\)
sed "s/^X//" >'expect.pl' <<'END_OF_FILE'
X## expect.pl rev ALPHA.1.01 01-NOV-90
X# Copyright (c) 1990, Randal L. Schwartz. All Rights Reserved.
X# Available for use by all under the GNU PUBLIC LICENSE
X
X# Status: AN ALPHA RELEASE
X#
X# Missing some functionality provided by the Don Libes 'expect' program.
X# The main stuff for babysitting an interactive process from a Perl program
X# is here, though.
X#
X# Will fail if called from non-'main' package unless variables and
X# filehandles are qualified (I don't have caller() yet).
X#
X# Missing better documentation. :-) It helps if you have used the
X# Libes stuff.
X#
X# Some of the stuff didn't map really well to Perl. I was torn
X# between making it useful and making it compatible. I'm open to
X# suggestions. :-)
X
X# THANKS:
X# Special thanks to Don Libes to provide the reason to write this package.
X# Thanks also to Larry Wall for his infinite patience with me.
X
Xpackage expect;
X
X# &close(HANDLE)
X# Closes HANDLE. may eventually ensure that the process associated
X# with HANDLE is gone, so call this instead of just close().
X
Xsub main'close {
X local($handle) = @_;
X $handle =~ s/^[^']+$/"main'".$&/e; # eventually caller()
X close($handle);
X}
X
X# &debug(...)
X
Xsub main'debug {
X die "debug NOT IMPLEMENTED";
X}
X
X# &exit(EXITVAL)
X# Calls exit.
X
Xsub main'exit {
X exit(@_);
X}
X
X# $expect'match:
X# contains the buffer (limited by $expect'match_max) of the most
X# recent chars seen in the last &expect call.
X
X$match = "";
X
X# $expect'match_max:
X# don't keep any more than this many characters when scanning for
X# an &expect.
X
X$match_max = 2000;
X
X# $expect'timeout:
X# number of seconds to wait before figuring that the process won't
X# give you what you wanted. (This should have been a parameter to
X# expect, but for this round, it's a global for compatibility.)
X
X$timeout = 30;
X
X# $ret = &expect(HANDLE,PATLIST1,BODY1,PATLIST2,BODY2,...)
X# waits until one of the PATLISTn elements matches the output from
X# the process attached to HANDLE, then 'eval's the matching BODYn,
X# in the context of the caller.
X#
X# Each PATLIST is a regular-expression (probably enclosed in single-quotes
X# in the invocation). ^ and $ will work, respecting the current value of $*.
X# If PATLIST is 'timeout', the BODY is executed if $expect'timeout is
X# exceeded. If PATLIST is 'eof', the BODY is executed if the process
X# exits before the other patterns are seen.
X#
X# PATLISTs are scanned in the order given, so later PATLISTs can contain
X# general defaults that won't be examined unless the earlier PATLISTs
X# have failed.
X#
X# The *scalar* result of eval'ing BODY is returned as the result of
X# the invocation. (If you need a list from the BODY, spin it off as
X# a side-effect.) Recursive invocations of &expect are not thought
X# through, and may work only accidentally. :-)
X
Xsub main'expect {
X local($PTY,@case) = @_;
X $PTY =~ s/^[^']+$/"main'".$&/e; # eventually caller()
X local(@casec,$pattern,$action);
X local($rmask,$nfound,$buf,$ret,$nread);
X local($endtime) = time + $timeout;
X local(@incr);
X local($shortkey) = 9999;
X local($meta,$i);
X $match = "";
X @casec = @case;
X @incr[0..255] = ();
X while (@casec) {
X ($pattern,$action) = splice(@casec,0,2);
X ($buf = $pattern) =~ s/\\(\W)//g;
X $meta = $buf =~ /[][()|+*?]/;
X if ($pattern eq 'timeout') {
X next;
X } elsif ($pattern eq 'eof') {
X next;
X } elsif ($meta) {
X @incr = split(//, 1 x 256);
X $shortkey = 1;
X } else {
X $pattern = eval "<<UnLiKeLy\n$pattern\nUnLiKeLy\n"
X if $pattern =~ m#\\#;
X $shortkey = length($pattern)
X if $shortkey > length($pattern);
X chop $pattern;
X $i = 1;
X for (reverse split(//,$pattern)) {
X $incr[ord] = $i unless $incr[ord];
X $i++;
X }
X }
X
X }
X $incr[0] = 1;
X for (@incr) {
X $_ = $shortkey unless $_;
X }
X while (1) {
X $rmask = "";
X vec($rmask,fileno($PTY),1) = 1;
X $nread = 0;
X ($nfound, $timeleft) =
X select($rmask,undef,undef,$endtime - time);
X if ($nfound) {
X $buf = ' ' x @incr[ord(substr($match,-1,1))];
X $nread = syscall(3,fileno($PTY),$buf,length($buf));
X # print STDOUT "<$nread " . length($buf) . ">";
X $nread = 0 if $nread < 0; # any I/O err is eof
X substr($buf,$nread,9999) = '';
X $match .= $buf;
X substr($match,0,
X length($match)-$match_max) = ''
X if length($match) > $match_max;
X print STDOUT $buf if $log_user;
X }
X @casec = @case;
X while (@casec) {
X ($pattern,$action) = splice(@casec,0,2);
X if ($pattern eq 'timeout') {
X unless ($nfound) {
X $ret = eval "package main; $action";
X # add caller() when available
X die "$@\n" if $@;
X return $ret;
X }
X } elsif ($pattern eq 'eof') {
X unless ($nread) {
X $ret = eval "package main; $action";
X # add caller() when available
X die "$@\n" if $@;
X return $ret;
X }
X } elsif ($match =~ /$pattern/) {
X $ret = eval "package main; $action";
X # add caller() when available
X die "$@\n" if $@;
X return $ret;
X }
X }
X return undef unless $nread;
X }
X}
X
X# $ret = &expect_user(PATLIST1,BODY1,PATLIST2,BODY2...)
X# invoke &expect on STDIN
X
Xsub main'expect_user {
X local(@case) = @_;
X local($log_user) = 0; # don't echo user input... let process do that
X &main'expect(STDIN,@case);
X}
X
X# &interact(...)
X
Xsub main'interact {
X die "interact NOT IMPLEMENTED"; # it's broke, so far
X local($esc,$spawnid) = @_;
X # hmm.. have to duplicate most of &select here. not good
X local($imask,$omask) = "";
X local($buf,$nread) = ' ';
X for (STDIN,$spawnid) {
X vec($imask,fileno($_),1) = 1;
X }
X # need to fiddle with STDIN's stty bits now
X while (1) {
X select($omask = $imask, undef, undef, undef);
X if (vec($omask, fileno(STDIN), 1)) {
X # prefer stdin over process
X $nread = syscall(3,fileno(STDIN),$buf,1);
X die "read: $!" if $nread < 0;
X return undef if $nread == 0;
X return $esc if $buf eq $esc;
X &main'send($spawnid,$buf);
X } else {
X $nread = syscall(3,fileno($spawnid),$buf,1);
X die "read: $!" if $nread < 0;
X return undef if $nread == 0;
X &main'send(STDOUT,$buf);
X }
X }
X}
X
X# &log_file(...)
X
Xsub main'log_file {
X die "log_file NOT IMPLEMENTED";
X}
X
X# $expect'log_user:
X# set to non-zero to echo the processes STDOUT to this process STDOUT
X# while scanning via &expect. Default is non-zero.
X
X$log_user = 1;
X
X# &log_user(NEWVAL)
X# sets $expect'log_user to NEWVAL
X
Xsub main'log_user {
X ($log_user) = @_;
X}
X
X# @handlelist = &select(HANDLE1,HANDLE2,HANDLE3...)
X# returns a list of the HANDLEs that can do I/O, or () if none can
X# do I/O before $expect'timeout seconds.
X
Xsub main'select {
X local($rmask) = "";
X local($nfound,$timeleft);
X local(@ret);
X for (@_) {
X s/^[^']+$/"main'".$&/e; # eventually caller()
X vec($rmask,fileno($_),1) = 1;
X }
X ($nfound, $timeleft) =
X select($rmask,undef,undef,$timeout);
X grep(vec($rmask,fileno($_),1),@_);
X}
X
X# &send(HANDLE,@TEXT);
X# sends @TEXT to HANDLE. May log it too, but logging isn't done yet.
X
Xsub main'send {
X local($PTY,@args) = @_;
X $PTY =~ s/^[^']+$/"main'".$&/e; # eventually caller()
X print $PTY @args;
X # should this copy STDOUT if $log_user? dunno yet.
X}
X
X# &send_error(HANDLE,@TEXT);
X# sends @TEXT to STDERR. May log it too, but logging isn't done yet.
X
Xsub main'send_error {
X &main'send(STDERR,@_);
X}
X
X# &send_error(HANDLE,@TEXT);
X# sends @TEXT to STDOUT. May log it too, but logging isn't done yet.
X
Xsub main'send_user {
X &main'send(STDOUT,@_);
X}
X
X# $pty = &spawn(HANDLE,PROGRAM,@ARGS)
X# starts process PROGRAM with args @ARGS, associating it with a pty
X# opened on filehandle HANDLE. Returns the name of the pty, or undef
X# if not successful.
X
Xsub main'spawn {
X local($PTY,@cmd) = @_;
X $PTY =~ s/^[^']+$/"main'".$&/e; # eventually caller()
X local($TTY) = "__TTY" . time;
X local($pty,$tty) = &_getpty($PTY,$TTY);
X return undef unless defined $pty;
X local($pid) = fork;
X return undef unless defined $pid;
X unless ($pid) {
X close STDIN; close STDOUT; close STDERR;
X setpgrp(0,$$);
X if (open(TTY, "/dev/tty")) {
X ioctl(TTY,0x20007471,0); # XXX s/b &TIOCNOTTY
X close TTY;
X }
X open(STDIN,"<&$TTY");
X open(STDOUT,">&$TTY");
X open(STDERR,">&STDOUT");
X die "Oops" unless fileno(STDERR) == 2; # sanity
X close($PTY);
X exec @cmd;
X die "cannot exec @cmd: $!";
X }
X close($TTY);
X $pty;
X}
X
X# &system(@ARGS)
X# just like system(@ARGS)... for compatibility
X
Xsub main'system {
X system(@_);
X}
X
X# &trace(...)
X
Xsub main'trace {
X die "trace NOT IMPLEMENTED";
X}
X
X# &trap(...)
X
Xsub main'trap {
X local($cmd,@signals) = @_;
X die "trap NOT IMPLEMENTED";
X}
X
X# &wait;
X# just like wait... for compatibility.
X
Xsub main'wait {
X wait; # (that's easy. :-)
X}
X
X# ($pty,$tty) = &expect'_getpty(PTY,TTY):
X# internal procedure to get the next available pty.
X# opens pty on handle PTY, and matching tty on handle TTY.
X# returns undef if can't find a pty.
X
Xsub _getpty {
X local($PTY,$TTY) = @_;
X # don't adjust $PTY,$TTY with main', but use caller when available
X local($pty,$tty);
X for $bank (112..127) {
X next unless -e sprintf("/dev/pty%c0", $bank);
X for $unit (48..57) {
X $pty = sprintf("/dev/pty%c%c", $bank, $unit);
X # print "Trying $pty\n";
X open($PTY,"+>$pty") || next;
X select((select($PTY), $| = 1)[0]);
X ($tty = $pty) =~ s/pty/tty/;
X open($TTY,"+>$tty") || next;
X select((select($TTY), $| = 1)[0]);
X system "stty nl >$tty";
X return ($pty,$tty);
X }
X }
X undef;
X}
X
X1;
END_OF_FILE
if test 9287 -ne `wc -c <'expect.pl'`; then
echo shar: \"'expect.pl'\" unpacked with wrong size!
fi
# end of 'expect.pl'
fi
echo shar: End of shell archive.
exit 0
--
/=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 put the 'backward' in 'backward compatible'..."=========/libes@cme.nist.gov (Don Libes) (11/02/90)
In article <1990Nov2.003228.22744@iwarp.intel.com> merlyn@iwarp.intel.com (Randal Schwartz) writes: >The motivation for writing this package is the fact >that Don Libes doesn't like Perl. :-) I've never said anything like that, nor is it true (although I will admit that I've had a lot of trouble learning Perl.) Fact is, I've written several Perl hacks, at least one of which is used daily at my site. >The matchup of expect<->tcl and expect.pl<->Perl made for some weird >design tradeoffs. I may start from mostly scratch and do everything >right. That is probably why I hesitate to implement the rest of the >functions... they really don't fit in a Perl environment. Actually, I discussed these issues with several people during the development of expect. The approach I took effectively sealed off the user from the underlying C implementation, substituting the more shell- like Tcl language and reducing the ability to screw themselves somehow. In the approach you took, the user language IS Perl, which provides incredible power and flexibility. The primary disadvantage is that the user may have to learn Perl, which is hard. Also, as you noticed, some of the features (like logging) are a problem for Perl. Oh, and as you suspected, recursive invocations are useful - consider writing scripts that are half automated and half interactive, like the fsck script I showed at the LISA conference. Please don't get me wrong. I think Perl is very useful. I desperately want a copy of your book. And I consider it a compliment that you followed my implementation as faithfully as you did. Though, I did think some of your Perl code pretty weird! Actually, in my USENIX paper I stated that I fully expected someone to incorporate the expect primitives into a shell, Perl, whatever. I was just showing proof of concept. It just happened to turn out really nice. In fact, I owe a lot for it to John Ousterhout who wrote Tcl. Don Libes libes@cme.nist.gov ...!uunet!cme-durer!libes
cwilson@NISC.SRI.COM (Chan Wilson [Animal]) (11/03/90)
libes@cme.nist.gov (Don Libes) writes: >In article <1990Nov2.003228.22744@iwarp.intel.com> merlyn@iwarp.intel.com (Randal Schwartz) writes: OOoh OOh OOh OOh!!!! Yes yes yes!! :) Ever since I came across expect, I've been nashing my teeth over the fact that it's got such a bizarre, lispy-like syntax, among other, trivial reasons. Granted, I'm not much for high-level languages, but I'd just gotten into perl and was wonderfully spoiled by all the lovely capabilities with it. I was even at the point of trying to emulate expect in perl by doing a open(PROC,"|process > /tmp/output") and feed the PROC by examining the /tmp/output file. Never did get beyond the contemplation stage, thou.. [...] >In the approach you took, the user language IS Perl, which provides >incredible power and flexibility. The primary disadvantage is that >the user may have to learn Perl, which is hard. Oooh, Nosh. I've found that Perl is giving me the same feeling that BASIC did way back when. The power, the flexability, the >simplicity< of the language has won it a permanent place in my language library. But, I've come from an unusual computer background, so perhaps it's just me. :-) Oh boy!! Time to convert my expect scripts to perl-expect scripts!! --Chan Chan Wilson Chief Hard-Question Answer Person SRI Intl. Network Information Systems Center 333 Ravenswood Ave., EJ287 Internet: cwilson@nisc.sri.com Menlo Park, CA., 94025 Phone: (415)859-4492 "If I want to be a surfer this month, I bloody well will be."