juha@lne.kth.se (Juha Sarlin) (04/09/91)
This is a modified version of the expect.pl that was originally
written by Randal L. Schwartz. The most important changes are that
&interact now works well enough to be useful and the speed of &expect
is somewhat improved.
#! /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: README Makefile expect.pl expect-test maketty raw-sgtty.pl
# raw-termio.pl raw-termios.pl rawtest tty-sgtty.pl tty-termio.pl
# tty-termios.pl ttytest README.aftp aftp sun3-4.1 sun3-4.1/README
# sun3-4.1/termios.pl sun3-4.1/termio.pl sun3-4.1/sgtty.pl
# dec5000-4.1 dec5000-4.1/README dec5000-4.1/termios.pl
# dec5000-4.1/termio.pl dec5000-4.1/sgtty.pl
# Wrapped by juha@comtess on Mon Apr 8 21:05:04 1991
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(1037 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XThis is a modified version of the expect.pl that was originally
Xwritten by Randal L. Schwartz. The most important changes are that
X&interact now works well enough to be useful and the speed of &expect
Xis somewhat improved.
X
XThe maketty program tries to create a minimal version of termios.pl,
Xtermio.pl or sgtty.pl for use with tty.pl and raw.pl. If it fails,
Xyou could perhaps create one manually using the example files in
Xsun3-4.1/ and dec5000-4.1/.
X
XIf everything fails or you want a more complete version, you could use
Xh2ph and the programs in perl/h2pl/, but this usually requires a lot
Xof manual work. Note also that h2ph doesn't create any pack-strings
Xor symbolic structure indexes, like for example $struct_termios and
X$c_iflag in sun3-4.1/termios.pl, so it might be easier to tweak with
Xmaketty until it works on your system.
X
XOf course you could instead write your own raw.pl to do whatever is
Xnecessary. For example:
X sub raw {system 'stty', 'raw';}
X sub unraw {system 'stty', '-raw';}
X--
XJuha Sarlin juha@lne.kth.se
END_OF_FILE
if test 1037 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'Makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'Makefile'\"
else
echo shar: Extracting \"'Makefile'\" \(216 characters\)
sed "s/^X//" >'Makefile' <<'END_OF_FILE'
Xlib = /usr/local/lib/perl
X
Xraw.pl:
X maketty
X
Xinstall: raw.pl
X cp expect.pl raw.pl tty.pl $(lib)
X
Xclean:
X $(RM) termios termio sgtty termios.c termio.c sgtty.c \
X termios.pl termio.pl sgtty.pl raw.pl tty.pl debug.log
END_OF_FILE
if test 216 -ne `wc -c <'Makefile'`; then
echo shar: \"'Makefile'\" unpacked with wrong size!
fi
# end of 'Makefile'
fi
if test -f 'expect.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'expect.pl'\"
else
echo shar: Extracting \"'expect.pl'\" \(10053 characters\)
sed "s/^X//" >'expect.pl' <<'END_OF_FILE'
X## expect.pl Based on rev ALPHA.2.01 09-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# 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
X# Modifications:
X# Mar 26 1991 Juha Sarlin <juha@lne.kth.se>
X# - Implemented &interact.
X# - Open slave side of pty after doing TIOCNOTTY to make it the
X# controlling terminal for the spawned process.
X# - Skipped the "Boyer-Moore"-style read-amount optimization from
X# &expect, always read as much as possible instead.
X# - Pre-expanded the pattern matching loop and optimized handling of
X# 'timeout' and 'eof'.
X# - Patterns like 'timeout=17' specify a temporary timeout.
X# - Added some debugging output.
X# Jan 9 1991 Juha Sarlin <juha@lne.kth.se>
X# - Use sysread() instead of syscall(3, ...).
X# - Removed obsolete HANDLE from some comments.
X
Xrequire 'tty.pl';
Xrequire 'raw.pl';
Xdefined($TIOCNOTTY) || die '$TIOCNOTTY not defined';
X
Xpackage expect;
X
Xundef($spawn_id);
X$spawn_id_next = "expect'SPAWN00001";
X
X# &close()
X# Closes $spawn_id. may eventually ensure that the process associated
X# with $spawn_id is gone, so call this instead of just close().
X
Xsub main'close {
X close($spawn_id);
X}
X
X$debug = 0;
X
X# &debug(...)
X
Xsub main'debug {
X if ($debug = shift) {
X if (@_) {
X local($debug_file) = shift;
X open(DEBUG, ">$debug_file") || die "$debug_file: $!\n";
X $DEBUG = 'DEBUG';
X # Set unbuffered debugging output
X select((select(DEBUG), local($|) = 1)[0]);
X }
X else {
X $DEBUG = 'STDERR';
X }
X }
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# Default number of seconds to wait before figuring that the process
X# won't give you what you wanted.
X
X$timeout = 30;
X
X# $ret = &expect(PATTERN1,BODY1,PATTERN2,BODY2,...)
X# waits until one of the PATTERNn elements matches the output from
X# the process attached to $spawn_id, then 'eval's the matching BODYn,
X# in the context of the caller.
X#
X# Each PATTERN is a regular-expression (probably enclosed in single-quotes
X# in the invocation). ^ and $ will work, respecting the current value of $*.
X#
X# If PATTERN is 'timeout' or matches /^timeout=\d+$/, the BODY is
X# executed if the timeout time is exceeded. The first form uses
X# $expect'timeout and the second uses the time specified by the
X# digits. For example 'timeout=17' will time out after 17 seconds.
X#
X# If PATTERN is 'eof', the BODY is executed if the process exits
X# before the other patterns are seen.
X#
X# PATTERNs are scanned in the order given, so later PATTERNs can contain
X# general defaults that won't be examined unless the earlier PATTERNs
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(@case) = @_;
X local(@cases,$pattern,$action);
X local($timeout_action,$eof_action);
X local($rmask,$rout,$nfound,$buf,$ret,$nread);
X local($expect_timeout) = $timeout;
X local($package,$filename,$line) = caller;
X local($patnum,@pat) = $[-1 if $debug;
X
X while (@case) {
X ($pattern,$action) = splice(@case,0,2);
X if ($pattern =~ /^timeout(=(\d+))?$/) {
X $expect_timeout = $2 if defined $2;
X $timeout_action = $action;
X } elsif ($pattern eq 'eof') {
X $eof_action = $action;
X } else {
X push(@pat, $pattern), $patnum++ if $debug;
X push(@cases, <<END
Xif (\$match =~ /$pattern/) {
XEND
X .($debug ? "print $DEBUG 'expect: match /',\$pat[$patnum],\"/\\n\";\n"
X : '')
X .<<END);
X \$ret = do {package $package; $action;};
X last;
X}
XEND
X }
X }
X local($endtime) = time + $expect_timeout;
X local($timeleft,$timeleft_out) = $expect_timeout;
X $match = "";
X $rmask = "";
X vec($rmask,fileno($spawn_id),1) = 1;
X select((select(STDOUT), local($|) = 1)[0]);
X print $DEBUG join('els', @cases) if $debug > 1;
X eval <<'END'.
X while (1) {
X $nread = 0;
X ($nfound, $timeleft_out)
X = select($rout=$rmask,undef,undef,$timeleft);
X if ($timeleft_out == $timeleft) {
X $timeleft = $endtime - time;
X }
X else {
X $timeleft = $timeleft_out;
X }
X if ($nfound) {
X $nread = sysread($spawn_id, $buf, 256);
X print $DEBUG '<', $nread, '>' if $debug > 2;
X $nread = 0 if $nread < 0; # any I/O err is eof
X unless ($nread) {
X print $DEBUG "expect: eof\n" if $debug;
X $ret = eval "package $package;".$eof_action
X if defined $eof_action;
X last;
X }
X $match .= $buf;
X substr($match,0,length($match)-$match_max) = ''
X if length($match) > $match_max;
X print STDOUT $buf if $log_user;
X }
X else {
X print $DEBUG 'expect: timeout=',$expect_timeout,"\n"
X if $debug;
X $ret = eval "package $package;".$timeout_action
X if defined $timeout_action;
X last;
X }
XEND
X join('els', @cases) . <<'END';
X }
XEND
X if ($@) {
X $@ =~ s/at \(eval\) line \d+\.$/at $filename line $line/;
X die $@;
X }
X print $DEBUG 'expect: return value = \'', $ret, "'\n" if $debug;
X $ret;
X}
X
X# $ret = &expect_user(PATTERN1,BODY1,PATTERN2,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 local($esc) = @_;
X # hmm.. have to duplicate most of &select here. not good
X local($imask,$omask) = "";
X local($buf,$nread);
X for (STDIN,$spawn_id) {
X vec($imask,fileno($_),1) = 1;
X }
X select((select(STDOUT), local($|) = 1)[0]);
X &main'raw; # Set STDIN in raw mode
X while (1) {
X select($omask = $imask, undef, undef, undef);
X if (vec($omask, fileno(STDIN), 1)) {
X # prefer stdin over process
X $nread = sysread(STDIN, $buf, 1);
X last if $nread <= 0;
X if ($buf eq $esc) {
X &main'unraw;
X return $esc;
X }
X print $spawn_id $buf;
X } else {
X $nread = sysread($spawn_id, $buf, 256);
X last if $nread <= 0;
X print STDOUT $buf;
X }
X }
X &main'unraw;
X die "read: $!" if $nread < 0;
X undef;
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(@TEXT);
X# sends @TEXT to $spawn_id. May log it too, but logging isn't done yet.
X
Xsub main'send {
X local(@args) = @_;
X print $spawn_id @args;
X # should this copy STDOUT if $log_user? dunno yet.
X}
X
X# &send_error(@TEXT);
X# sends @TEXT to STDERR. May log it too, but logging isn't done yet.
X
Xsub main'send_error {
X local($spawn_id) = "STDERR";
X &main'send(@_);
X}
X
X# &send_error(@TEXT);
X# sends @TEXT to STDOUT. May log it too, but logging isn't done yet.
X
Xsub main'send_user {
X local($spawn_id) = "STDOUT";
X &main'send(@_);
X}
X
X# $pty = &spawn(PROGRAM,@ARGS)
X# starts process PROGRAM with args @ARGS, associating it with a pty
X# opened on a new filehandle. Returns the name of the pty, or undef
X# if not successful.
X
Xsub main'spawn {
X local(@cmd) = @_;
X print STDOUT join(' ',@cmd),"\n" if $log_user;
X $spawn_id = $spawn_id_next++;
X local($pty,$tty) = &_getpty($spawn_id);
X return undef unless defined $pty;
X # Try to copy tty modes from STDIN
X $stdin_mode = &main'get_tty(STDIN) unless defined($stdin_mode);
X local($pid) = fork;
X return undef unless defined $pid;
X unless ($pid) {
X if (open(TTY, "/dev/tty")) {
X ioctl(TTY,$main'TIOCNOTTY,0) || die $!;
X close TTY;
X }
X setpgrp(0,0);
X open(STDIN,"+>$tty");
X open(STDOUT,">&STDIN");
X open(STDERR,">&STDOUT");
X die "Oops" unless fileno(STDERR) == 2; # sanity
X if (defined($stdin_mode)) {
X &main'set_tty(STDIN, $stdin_mode)
X || die "spawn: set_tty: $!";
X }
X close($spawn_id);
X exec @cmd;
X die "cannot exec @cmd: $!";
X }
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):
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) = @_;
X # don't adjust $PTY 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 next unless -r $tty;
X return ($pty,$tty);
X }
X }
X undef;
X}
X
X1;
END_OF_FILE
if test 10053 -ne `wc -c <'expect.pl'`; then
echo shar: \"'expect.pl'\" unpacked with wrong size!
fi
# end of 'expect.pl'
fi
if test -f 'expect-test' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'expect-test'\"
else
echo shar: Extracting \"'expect-test'\" \(1625 characters\)
sed "s/^X//" >'expect-test' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X# Test some basic features of expect.pl.
X# The check of controlling terminal is not very portable. It probably
X# works only on dialects of Berkeley Unix.
X# Written by Juha Sarlin <juha@lne.kth.se>
Xunshift(@INC, '.'); # Want to use files in current directory
Xrequire 'expect.pl';
X
X&debug(3, 'debug.log');
X$expect'timeout = 10;
X&spawn('sh') || die 'spawn failed';
Xif (&expect('^\$ $', 1, 'eof', 'die "unexpected eof"')) {
X $prompt = '\$ ';
X}
Xelse {
X $prompt = $expect'match;
X print 'The prompt seems to be "', $prompt, "\"\n";
X $prompt =~ s/(\W)/\\$1/g;
X}
X&send("tty\r");
X&expect($prompt, 1) || die "no prompt";
Xif ($expect'match =~ m%/dev/tty(..)%) {
X $tty = $1;
X $ps = `ps t$tty`;
X if ($ps !~ / sh$/) {
X print "Spawned process lacks own controlling terminal\n";
X system 'ps', 'x';
X }
X}
X&send("sleep 1;echo;sleep 2\r");
X&expect($prompt, 'die "Timeout doesn\'t work\n"', 'timeout=2');
Xprint "Type at least one command to test interaction, finish with CTRL-D\n";
X&interact("\4") || die "unexpected eof";
X&send("exit\r");
X$ret = &expect($prompt, 2, 'eof', 1);
Xif ($ret == 2) {
X # The exit command failed to exit, try sending an EOF character.
X $buf = &get_tty(STDIN);
X if (defined $struct_termios) {
X $eof = (unpack($struct_termios, $buf))[$c_cc+$VEOF];
X }
X elsif (defined $struct_termio) {
X $eof = (unpack($struct_termio, $buf))[$c_cc+$VEOF];
X }
X else {
X $eof = 4; # Try CTRL-D
X }
X &send(pack("C", $eof));
X $ret = &expect('eof', 1);
X print "\n";
X}
Xdie "eof not detected\n" unless $ret;
X&close;
X
Xsub exit {
X}
X# Local variables:
X# mode: perl
X# End:
END_OF_FILE
if test 1625 -ne `wc -c <'expect-test'`; then
echo shar: \"'expect-test'\" unpacked with wrong size!
fi
chmod +x 'expect-test'
# end of 'expect-test'
fi
if test -f 'maketty' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'maketty'\"
else
echo shar: Extracting \"'maketty'\" \(3752 characters\)
sed "s/^X//" >'maketty' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X# Create a minimal version of termios.pl, termio.pl or sgtty.pl
X# for use with tty.pl and raw.pl.
X# Written by Juha Sarlin <juha@lne.kth.se>
X
X$CC = 'cc';
X$CFLAGS = '';
X
X@sizes = ('char', 'short', 'long');
X@struct_termio = ('c_iflag', 'c_oflag', 'c_cflag', 'c_lflag', 'c_line','c_cc');
X@ioctl_termio = ('TCGETA', 'TCSETA', 'VEOF', 'VMIN', 'VTIME', 'TIOCNOTTY');
X@struct_termios = @struct_termio;
X@ioctl_termios = ('TCGETS', 'TCSETS', 'TCGETP', 'TCSANOW',
X 'VEOF', 'VMIN', 'VTIME', 'TIOCNOTTY');
X@struct_sgttyb = ('sg_ispeed', 'sg_ospeed', 'sg_erase', 'sg_kill', 'sg_flags');
X@ioctl_sgtty = ('TIOCGETP', 'TIOCSETP', 'RAW', 'TIOCNOTTY');
X
Xfor $name ('termios', 'termio', 'sgtty') {
X $C = $name.'.c';
X open(C, '>'.$C) || die "$C: $!\n";
X select(C);
X print <<'END';
X#include <stdio.h>
X#if __STDC__
X#define print_size(type) printf("sizeof(" #type ") = %d\n", sizeof(type));
X#define print_offset(x) printf(#x " = %d\n", (char *) &t.x - (char *) &t);
X#define print_value(val) printf(#val " = 0x%x\n", val);
X#else
X#define print_size(type) printf("sizeof(type) = %d\n", sizeof(type));
X#define print_offset(x) printf("x = %d\n", (char *) &t.x - (char *) &t);
X#define print_value(val) printf("val = 0x%x\n", val);
X#endif
XEND
X ($struct_name = $name) =~ s/sgtty/sgttyb/;
X print "#include <$name.h>\nstruct $struct_name t;\nmain()\n{\n";
X for (@sizes) {
X print " print_size($_);\n";
X }
X print " print_size(struct $struct_name);\n";
X *struct = 'struct_'.$struct_name;
X for (@struct) {
X print " print_offset($_);\n";
X }
X *ioctl = 'ioctl_'.$name;
X for (@ioctl) {
X print "#ifdef $_\n print_value($_);\n#endif\n";
X }
X print " exit(0);\n}\n";
X close C;
X print STDERR "$CC $CFLAGS $C -o $name\n";
X unless (system("$CC $CFLAGS $C -o $name")) {
X local(%pack, %ioctl, %struct);
X local($struct, $i, $prev_offset, $subst);
X
X open(IN, "./$name|") || die "./$name: $!\n";
X while (<IN>) {
X chop;
X if (/^sizeof\(char\) = (\d+)$/) {
X $pack{$1} = 'C';
X }
X elsif (/^sizeof\(short\) = (\d+)$/) {
X $pack{$1} = 'S';
X }
X elsif (/^sizeof\(long\) = (\d+)$/) {
X $pack{$1} = 'L';
X }
X elsif (/^sizeof\(struct \w+\) = (\d+)$/) {
X $sizeof_struct = $1;
X }
X elsif (/^(\w+) = (\d+)$/) {
X $struct{$2} = $1;
X }
X elsif (/^(\w+) = (0x[0-9a-fA-F]+)$/) {
X $ioctl{$1} = $2;
X }
X }
X close(IN);
X if ($?) {
X printf STDERR "./$name failed, exit status = 0x%x\n", $?;
X next;
X }
X print STDERR 'creating ', $name, ".pl\n";
X open(PL, ">$name.pl") || die "$name.pl: $!\n";
X select(PL);
X for (sort keys %ioctl) {
X print '$', $_, ' = ', $ioctl{$_}, ";\n";
X }
X @struct = sort num keys(%struct);
X $prev_offset = shift(@struct);
X push(@struct, $sizeof_struct);
X $i = 0;
X for (@struct) {
X print '$', $struct{$prev_offset}, ' = ', $i, ";\n";
X $size = $_ - $prev_offset;
X if (defined $pack{$size}) {
X $struct .= $pack{$size};
X $i++;
X }
X else {
X $struct .= 'C'.$size;
X $i += $size;
X }
X $prev_offset = $_;
X }
X print '$struct_', $struct_name, ' = \'', $struct, "';\n";
X # Change TCSETS into TCSANOW and TCGETS into TCGETP when it
X # seems to be necessary. Needed on Ultrix 4.1.
X unless (defined $ioctl{'TCSETS'} || defined $ioctl{'TCGETS'}) {
X if (defined $ioctl{'TCSANOW'} && defined $ioctl{'TCGETP'}) {
X $subst = 's/TCSETS/TCSANOW/g; s/TCGETS/TCGETP/g';
X }
X }
X local($/) = undef;
X for $file ('raw', 'tty') {
X print STDERR "copying $file-$name.pl to $file.pl\n";
X open(IN, "$file-$name.pl") || die "$file-$name.pl: $!\n";
X open(OUT, ">$file.pl") || die "$file.pl: $!\n";
X $_ = <IN>;
X eval $subst;
X print OUT;
X }
X exit 0;
X }
X}
Xexit 1;
X
Xsub num {
X $a <=> $b;
X}
X# Local variables:
X# mode: perl
X# End:
END_OF_FILE
if test 3752 -ne `wc -c <'maketty'`; then
echo shar: \"'maketty'\" unpacked with wrong size!
fi
chmod +x 'maketty'
# end of 'maketty'
fi
if test -f 'raw-sgtty.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'raw-sgtty.pl'\"
else
echo shar: Extracting \"'raw-sgtty.pl'\" \(631 characters\)
sed "s/^X//" >'raw-sgtty.pl' <<'END_OF_FILE'
X# Set terminal into "raw" mode, ie make all input characters available.
X# This version might work on some systems with BSD 4.3 sgtty.
X
Xrequire 'sgtty.pl';
Xdefined($struct_sgttyb) || die '$struct_sgttyb not defined';
X
Xsub raw {
X local(@sgtty,$sgtty_buf);
X
X ioctl(STDIN, $TIOCGETP, $sgtty_buf) || return undef;
X $unraw_sgtty = $sgtty_buf unless defined($unraw_sgtty);
X @sgtty = unpack($struct_sgttyb, $sgtty_buf);
X $sgtty[$sg_flags] = $RAW;
X $sgtty_buf = pack($struct_sgttyb, @sgtty);
X ioctl(STDIN, $TIOCSETP, $sgtty_buf);
X}
X
Xsub unraw {
X ioctl(STDIN, $TIOCSETP, $unraw_sgtty) if defined($unraw_sgtty);
X}
X
X1;
END_OF_FILE
if test 631 -ne `wc -c <'raw-sgtty.pl'`; then
echo shar: \"'raw-sgtty.pl'\" unpacked with wrong size!
fi
# end of 'raw-sgtty.pl'
fi
if test -f 'raw-termio.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'raw-termio.pl'\"
else
echo shar: Extracting \"'raw-termio.pl'\" \(744 characters\)
sed "s/^X//" >'raw-termio.pl' <<'END_OF_FILE'
X# Set terminal into "raw" mode, ie make all input characters available.
X# This version might work on some systems with termio.
X
Xrequire 'termio.pl';
Xdefined($struct_termio) || die '$struct_termio not defined';
X
Xsub raw {
X local(@termio,$termio_buf);
X
X ioctl(STDIN, $TCGETA, $termio_buf) || return undef;
X $unraw_termio = $termio_buf unless defined($unraw_termio);
X @termio = unpack($struct_termio, $termio_buf);
X $termio[$c_iflag] = 0;
X $termio[$c_oflag] = 0;
X $termio[$c_lflag] = 0;
X $termio[$c_cc+$VMIN] = 1;
X $termio[$c_cc+$VTIME] = 0;
X $termio_buf = pack($struct_termio, @termio);
X ioctl(STDIN, $TCSETA, $termio_buf);
X}
X
Xsub unraw {
X ioctl(STDIN, $TCSETA, $unraw_termio) if defined($unraw_termio);
X}
X
X1;
END_OF_FILE
if test 744 -ne `wc -c <'raw-termio.pl'`; then
echo shar: \"'raw-termio.pl'\" unpacked with wrong size!
fi
# end of 'raw-termio.pl'
fi
if test -f 'raw-termios.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'raw-termios.pl'\"
else
echo shar: Extracting \"'raw-termios.pl'\" \(768 characters\)
sed "s/^X//" >'raw-termios.pl' <<'END_OF_FILE'
X# Set terminal into "raw" mode, ie make all input characters available.
X# This version might work on some systems with termios.
X
Xrequire 'termios.pl';
Xdefined($struct_termios) || die '$struct_termios not defined';
X
Xsub raw {
X local(@termios,$termios_buf);
X
X ioctl(STDIN, $TCGETS, $termios_buf) || return undef;
X $unraw_termios = $termios_buf unless defined($unraw_termios);
X @termios = unpack($struct_termios, $termios_buf);
X $termios[$c_iflag] = 0;
X $termios[$c_oflag] = 0;
X $termios[$c_lflag] = 0;
X $termios[$c_cc+$VMIN] = 1;
X $termios[$c_cc+$VTIME] = 0;
X $termios_buf = pack($struct_termios, @termios);
X ioctl(STDIN, $TCSETS, $termios_buf);
X}
X
Xsub unraw {
X ioctl(STDIN, $TCSETS, $unraw_termios) if defined($unraw_termios);
X}
X
X1;
END_OF_FILE
if test 768 -ne `wc -c <'raw-termios.pl'`; then
echo shar: \"'raw-termios.pl'\" unpacked with wrong size!
fi
# end of 'raw-termios.pl'
fi
if test -f 'rawtest' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'rawtest'\"
else
echo shar: Extracting \"'rawtest'\" \(185 characters\)
sed "s/^X//" >'rawtest' <<'END_OF_FILE'
X#!/usr/local/bin/perl
Xrequire 'raw.pl';
X
X&raw || die "raw: $!\n";
X$| = 1;
Xprint 'Type one character: ';
X$c = getc;
Xprint "\r\nGot char ", ord($c), ".\r\n";
X&unraw || die "unraw: $!\n";
END_OF_FILE
if test 185 -ne `wc -c <'rawtest'`; then
echo shar: \"'rawtest'\" unpacked with wrong size!
fi
chmod +x 'rawtest'
# end of 'rawtest'
fi
if test -f 'tty-sgtty.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tty-sgtty.pl'\"
else
echo shar: Extracting \"'tty-sgtty.pl'\" \(649 characters\)
sed "s/^X//" >'tty-sgtty.pl' <<'END_OF_FILE'
X# Get and set terminal modes in a way that hides system specific details.
X# These functions are useful when you don't want to change any modes, but
X# just need to save the current state and later restore it.
X# This version might work on some systems with BSD 4.3 sgtty.
X
X# Example usage:
X# require 'tty.pl';
X# $tty_state = &get_tty(STDIN) || die "get_tty: $!";
X# &set_tty(STDIN, $tty_state) || die "set_tty: $!";
X
Xrequire 'sgtty.pl';
X
Xsub get_tty {
X local(*FILE) = @_;
X local($sgtty_buf);
X
X ioctl(FILE, $TIOCGETP, $sgtty_buf) && $sgtty_buf;
X}
X
Xsub set_tty {
X local(*FILE, $sgtty_buf) = @_;
X
X ioctl(FILE, $TIOCSETP, $sgtty_buf);
X}
X
X1;
END_OF_FILE
if test 649 -ne `wc -c <'tty-sgtty.pl'`; then
echo shar: \"'tty-sgtty.pl'\" unpacked with wrong size!
fi
# end of 'tty-sgtty.pl'
fi
if test -f 'tty-termio.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tty-termio.pl'\"
else
echo shar: Extracting \"'tty-termio.pl'\" \(644 characters\)
sed "s/^X//" >'tty-termio.pl' <<'END_OF_FILE'
X# Get and set terminal modes in a way that hides system specific details.
X# These functions are useful when you don't want to change any modes, but
X# just need to save the current state and later restore it.
X# This version might work on some systems with termio.
X
X# Example usage:
X# require 'tty.pl';
X# $tty_state = &get_tty(STDIN) || die "get_tty: $!";
X# &set_tty(STDIN, $tty_state) || die "set_tty: $!";
X
Xrequire 'termio.pl';
X
Xsub get_tty {
X local(*FILE) = @_;
X local($termio_buf);
X
X ioctl(FILE, $TCGETA, $termio_buf) && $termio_buf;
X}
X
Xsub set_tty {
X local(*FILE, $termio_buf) = @_;
X
X ioctl(FILE, $TCSETA, $termio_buf);
X}
X
X1;
END_OF_FILE
if test 644 -ne `wc -c <'tty-termio.pl'`; then
echo shar: \"'tty-termio.pl'\" unpacked with wrong size!
fi
# end of 'tty-termio.pl'
fi
if test -f 'tty-termios.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'tty-termios.pl'\"
else
echo shar: Extracting \"'tty-termios.pl'\" \(651 characters\)
sed "s/^X//" >'tty-termios.pl' <<'END_OF_FILE'
X# Get and set terminal modes in a way that hides system specific details.
X# These functions are useful when you don't want to change any modes, but
X# just need to save the current state and later restore it.
X# This version might work on some systems with termios.
X
X# Example usage:
X# require 'tty.pl';
X# $tty_state = &get_tty(STDIN) || die "get_tty: $!";
X# &set_tty(STDIN, $tty_state) || die "set_tty: $!";
X
Xrequire 'termios.pl';
X
Xsub get_tty {
X local(*FILE) = @_;
X local($termios_buf);
X
X ioctl(FILE, $TCGETS, $termios_buf) && $termios_buf;
X}
X
Xsub set_tty {
X local(*FILE, $termios_buf) = @_;
X
X ioctl(FILE, $TCSETS, $termios_buf);
X}
X
X1;
END_OF_FILE
if test 651 -ne `wc -c <'tty-termios.pl'`; then
echo shar: \"'tty-termios.pl'\" unpacked with wrong size!
fi
# end of 'tty-termios.pl'
fi
if test -f 'ttytest' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ttytest'\"
else
echo shar: Extracting \"'ttytest'\" \(272 characters\)
sed "s/^X//" >'ttytest' <<'END_OF_FILE'
X#!/usr/local/bin/perl
Xrequire 'tty.pl';
Xprint "Before:\n";
Xsystem 'stty';
X$tty_state = &get_tty(STDIN) || die "get_tty: $!";
Xsystem 'stty', '-echo';
Xprint "Without echo:\n";
Xsystem 'stty';
X&set_tty(STDIN, $tty_state) || die "set_tty: $!";
Xprint "After:\n";
Xsystem 'stty';
END_OF_FILE
if test 272 -ne `wc -c <'ttytest'`; then
echo shar: \"'ttytest'\" unpacked with wrong size!
fi
chmod +x 'ttytest'
# end of 'ttytest'
fi
if test -f 'README.aftp' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README.aftp'\"
else
echo shar: Extracting \"'README.aftp'\" \(623 characters\)
sed "s/^X//" >'README.aftp' <<'END_OF_FILE'
XAftp is a small example of how to use expect. It starts a "ftp host"
Xcommand and automatically logs you in for anonymous ftp. After the
Xlogin is completed you can interactively type ftp-commands.
X
XAs an additional feature it looks for hostname aliases in the file
X.aftp_aliases in your home directory. Here is an example file:
X
X# hostname aliases
Xexport.lcs.mit.edu export expo
Xprep.ai.mit.edu prep
Xwsmr-simtel20.army.mil simtel
Xwuarchive.wustl.edu wuarchive
X
XYou could also specify numerical addresses, which can be useful on
Xhosts without a working name resolver. Like this, for example:
X
X35.1.1.47 ub.cc.umich.edu
END_OF_FILE
if test 623 -ne `wc -c <'README.aftp'`; then
echo shar: \"'README.aftp'\" unpacked with wrong size!
fi
# end of 'README.aftp'
fi
if test -f 'aftp' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'aftp'\"
else
echo shar: Extracting \"'aftp'\" \(1475 characters\)
sed "s/^X//" >'aftp' <<'END_OF_FILE'
X#!/usr/local/bin/perl
X# Connect to a host with ftp and login for anonymous ftp.
X# Written by Juha Sarlin <juha@lne.kth.se>
Xrequire 'expect.pl';
X
X@ARGV || die "usage: aftp hostname\n";
X
X# Special user names for hosts where 'ftp' doesn't work.
X%anonymous = ('wsmr-simtel20.army.mil', 'anonymous',
X 'nic.ddn.mil', 'anonymous');
X
X$host = shift;
X$HOME = $ENV{'HOME'} || $ENV{'LOGDIR'} || (getpwuid($<))[7];
Xif (open(ALIAS, "$HOME/.aftp_aliases")) {
X Alias:
X while (<ALIAS>) {
X if (/$host/o) {
X s/#.*$//; # remove comment
X ($fullname, @alias) = split;
X for (@alias) {
X if ($host eq $_) {
X $host = $fullname;
X last Alias;
X }
X }
X }
X }
X close ALIAS;
X}
X$anonymous = 'ftp'; # Default name for anonymous FTP
X$anonymous = $anonymous{$host} if defined $anonymous{$host};
X$login = getlogin || (getpwuid($<))[0] || 'someone';
Xchop($domain = `domainname` || `hostname` || 'somewhere.');
X$passwd = $login.'@'.$domain;
X&spawn('ftp', '-n', $host);
X&expect('Connected to [\0-\377]*ftp> ', 1,
X 'ftp> ', '&quit',
X 'eof', '&quit',
X 'timeout=999', 'die "aftp: timed out\n"');
X&send('user ', $anonymous, ' ', $passwd, "\r");
X&expect('Login failed\.', '&quit',
X 'ftp> ', 1,
X 'eof', '&quit',
X 'timeout=120', 'die "aftp: login timed out\n"');
Xwhile (&interact("\032")) { # "\cz"
X kill 'TSTP', 0;
X}
X&close;
X
Xsub quit {
X &send("quit\r");
X &expect('221 Goodbye\.\r\n', 1, 'timeout=10');
X &close;
X exit 1;
X}
X# Local variables:
X# mode: perl
X# End:
END_OF_FILE
if test 1475 -ne `wc -c <'aftp'`; then
echo shar: \"'aftp'\" unpacked with wrong size!
fi
chmod +x 'aftp'
# end of 'aftp'
fi
if test ! -d 'sun3-4.1' ; then
echo shar: Creating directory \"'sun3-4.1'\"
mkdir 'sun3-4.1'
fi
if test -f 'sun3-4.1/README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'sun3-4.1/README'\"
else
echo shar: Extracting \"'sun3-4.1/README'\" \(72 characters\)
sed "s/^X//" >'sun3-4.1/README' <<'END_OF_FILE'
XThe files in this diretory were generated on a Sun 3/60 with SunOS 4.1.
END_OF_FILE
if test 72 -ne `wc -c <'sun3-4.1/README'`; then
echo shar: \"'sun3-4.1/README'\" unpacked with wrong size!
fi
# end of 'sun3-4.1/README'
fi
if test -f 'sun3-4.1/termios.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'sun3-4.1/termios.pl'\"
else
echo shar: Extracting \"'sun3-4.1/termios.pl'\" \(219 characters\)
sed "s/^X//" >'sun3-4.1/termios.pl' <<'END_OF_FILE'
X$TCGETS = 0x40225408;
X$TCSETS = 0x80225409;
X$TIOCNOTTY = 0x20007471;
X$VEOF = 0x4;
X$VMIN = 0x4;
X$VTIME = 0x5;
X$c_iflag = 0;
X$c_oflag = 1;
X$c_cflag = 2;
X$c_lflag = 3;
X$c_line = 4;
X$c_cc = 5;
X$struct_termios = 'LLLLCC17';
END_OF_FILE
if test 219 -ne `wc -c <'sun3-4.1/termios.pl'`; then
echo shar: \"'sun3-4.1/termios.pl'\" unpacked with wrong size!
fi
# end of 'sun3-4.1/termios.pl'
fi
if test -f 'sun3-4.1/termio.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'sun3-4.1/termio.pl'\"
else
echo shar: Extracting \"'sun3-4.1/termio.pl'\" \(217 characters\)
sed "s/^X//" >'sun3-4.1/termio.pl' <<'END_OF_FILE'
X$TCGETA = 0x40125401;
X$TCSETA = 0x80125402;
X$TIOCNOTTY = 0x20007471;
X$VEOF = 0x4;
X$VMIN = 0x4;
X$VTIME = 0x5;
X$c_iflag = 0;
X$c_oflag = 1;
X$c_cflag = 2;
X$c_lflag = 3;
X$c_line = 4;
X$c_cc = 5;
X$struct_termio = 'SSSSCC9';
END_OF_FILE
if test 217 -ne `wc -c <'sun3-4.1/termio.pl'`; then
echo shar: \"'sun3-4.1/termio.pl'\" unpacked with wrong size!
fi
# end of 'sun3-4.1/termio.pl'
fi
if test -f 'sun3-4.1/sgtty.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'sun3-4.1/sgtty.pl'\"
else
echo shar: Extracting \"'sun3-4.1/sgtty.pl'\" \(188 characters\)
sed "s/^X//" >'sun3-4.1/sgtty.pl' <<'END_OF_FILE'
X$RAW = 0x20;
X$TIOCGETP = 0x40067408;
X$TIOCNOTTY = 0x20007471;
X$TIOCSETP = 0x80067409;
X$sg_ispeed = 0;
X$sg_ospeed = 1;
X$sg_erase = 2;
X$sg_kill = 3;
X$sg_flags = 4;
X$struct_sgttyb = 'CCCCS';
END_OF_FILE
if test 188 -ne `wc -c <'sun3-4.1/sgtty.pl'`; then
echo shar: \"'sun3-4.1/sgtty.pl'\" unpacked with wrong size!
fi
# end of 'sun3-4.1/sgtty.pl'
fi
if test ! -d 'dec5000-4.1' ; then
echo shar: Creating directory \"'dec5000-4.1'\"
mkdir 'dec5000-4.1'
fi
if test -f 'dec5000-4.1/README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'dec5000-4.1/README'\"
else
echo shar: Extracting \"'dec5000-4.1/README'\" \(79 characters\)
sed "s/^X//" >'dec5000-4.1/README' <<'END_OF_FILE'
XThe files in this diretory were generated on a DECsystem 5820 with Ultrix 4.1.
END_OF_FILE
if test 79 -ne `wc -c <'dec5000-4.1/README'`; then
echo shar: \"'dec5000-4.1/README'\" unpacked with wrong size!
fi
# end of 'dec5000-4.1/README'
fi
if test -f 'dec5000-4.1/termios.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'dec5000-4.1/termios.pl'\"
else
echo shar: Extracting \"'dec5000-4.1/termios.pl'\" \(221 characters\)
sed "s/^X//" >'dec5000-4.1/termios.pl' <<'END_OF_FILE'
X$TCGETP = 0x40247455;
X$TCSANOW = 0x80247454;
X$TIOCNOTTY = 0x20007471;
X$VEOF = 0x4;
X$VMIN = 0x8;
X$VTIME = 0x9;
X$c_iflag = 0;
X$c_oflag = 1;
X$c_cflag = 2;
X$c_lflag = 3;
X$c_cc = 4;
X$c_line = 23;
X$struct_termios = 'LLLLC19C';
END_OF_FILE
if test 221 -ne `wc -c <'dec5000-4.1/termios.pl'`; then
echo shar: \"'dec5000-4.1/termios.pl'\" unpacked with wrong size!
fi
# end of 'dec5000-4.1/termios.pl'
fi
if test -f 'dec5000-4.1/termio.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'dec5000-4.1/termio.pl'\"
else
echo shar: Extracting \"'dec5000-4.1/termio.pl'\" \(218 characters\)
sed "s/^X//" >'dec5000-4.1/termio.pl' <<'END_OF_FILE'
X$TCGETA = 0x4014745b;
X$TCSETA = 0x8014745a;
X$TIOCNOTTY = 0x20007471;
X$VEOF = 0x4;
X$VMIN = 0x8;
X$VTIME = 0x9;
X$c_iflag = 0;
X$c_oflag = 1;
X$c_cflag = 2;
X$c_lflag = 3;
X$c_line = 4;
X$c_cc = 5;
X$struct_termio = 'SSSSCC11';
END_OF_FILE
if test 218 -ne `wc -c <'dec5000-4.1/termio.pl'`; then
echo shar: \"'dec5000-4.1/termio.pl'\" unpacked with wrong size!
fi
# end of 'dec5000-4.1/termio.pl'
fi
if test -f 'dec5000-4.1/sgtty.pl' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'dec5000-4.1/sgtty.pl'\"
else
echo shar: Extracting \"'dec5000-4.1/sgtty.pl'\" \(188 characters\)
sed "s/^X//" >'dec5000-4.1/sgtty.pl' <<'END_OF_FILE'
X$RAW = 0x20;
X$TIOCGETP = 0x40067408;
X$TIOCNOTTY = 0x20007471;
X$TIOCSETP = 0x80067409;
X$sg_ispeed = 0;
X$sg_ospeed = 1;
X$sg_erase = 2;
X$sg_kill = 3;
X$sg_flags = 4;
X$struct_sgttyb = 'CCCCS';
END_OF_FILE
if test 188 -ne `wc -c <'dec5000-4.1/sgtty.pl'`; then
echo shar: \"'dec5000-4.1/sgtty.pl'\" unpacked with wrong size!
fi
# end of 'dec5000-4.1/sgtty.pl'
fi
echo shar: End of shell archive.
exit 0
--
Juha Sarlin juha@elixir.lne.kth.se