clipper@csd.uwo.ca (Khun Yee Fung) (05/01/91)
There is the whole ftp client I wrote last year. It works for SUNs.
You might have to change the domain name server address. You don't
have to worry about that if you have the resolver library builtin. I
also include all the .h .pl and .ph files it uses. Be warned they are
for Suns.
If it is useful, good. If not, oh well. Randal can obviously write a
much better one. If only I had chat2 at that time...
Here it goes,
#! /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:
# nftp.dir
# This archive created: Tue Apr 30 19:32:38 1991
export PATH; PATH=/bin:$PATH
if test ! -d 'nftp.dir'
then
mkdir 'nftp.dir'
fi
cd 'nftp.dir'
if test -f 'nftp'
then
echo shar: will not over-write existing file "'nftp'"
else
cat << \SHAR_EOF > 'nftp'
#!/usr2/new/bin/perl
# -*-perl-*-
# A simple ftp client in perl.
# Copyright 1990 Khun Yee Fung (clipper@csd.uwo.ca)
# You can modify, distribute, duplicate or do whatever to this file
# provided you do not delete the copyright notice and do not sell this
# program for profit. No warranty whatsoever.
# $Id: nftp,v 1.21 90/07/26 16:39:19 clipper Exp $
# $Source: /u3/thesis/clipper/pl/RCS/nftp,v $
eval "exec perl -S $0 $*"
if $running_under_some_shell;
# Return code value for the reply from the server
$DATA = 1;
$SUCCESS = 2;
$CONTINUE = 3;
$ERROR = 4;
$FAIL = 5;
# the smaller verbose is, the less printing this program will do.
# verbose == 4 : everything is shown
# verbose == 3 : hash marks are not shown
# verbose == 2 : commands are not shown
# verbose == 1 : reply codes are not shown
# verbose == 0 : the prompt is not printed.
# verbose == -1: not even the error messages are shown.
if ($ENV{'TERM'} eq 'emacs') {
$verbose = 3;
}
else {
$verbose = 4;
}
# flag to indicate whether \r should be rid of
$NOCR = 1;
# the anonymous ftp list compiled by odin@pilot.njin.net
$ftplist = "/usr2/new/lib/ftp.list.Z";
# subroutine associate array for different commands of ftp
%func = ('lmkdir', 'domkdir', 'lcd', 'dochdir', 'quit', 'doquit',
'open', 'connect', 'back', 'background', 'rm', 'rm',
'mput', 'mput', 'ls', 'list', 'cd', 'cd', 'more', 'more',
'get', 'get', 'put', 'put', 'verb', 'verbose',
'reget', 'restoffile', 'mget', 'mget', 'login', 'login',
'cdup', 'simple', 'close', 'close', 'rename', 'rename',
'del', 'simple1', 'rmdir', 'simple1', 'mkdir', 'simple1',
'pwd', 'simple', 'syst', 'simple', 'status', 'simple',
'help', 'dohelp', 'noop', 'simple', 'binary', 'type', 'ascii', 'type',
'tenex', 'type', 'rhelp', 'dorhelp',
'history', 'dohistory', '!', 'doshell', '%', 'dohis',
# 'set', 'doset', 'unset', 'dounset',
# 'alias', 'doalias', 'unalias', 'dounalias',
);
# The actual code word understood by ftpd
%words = ('nlst', 'NLST', 'ls', 'LIST', 'cd', 'CWD',
'get', 'RETR', 'put', 'STOR', 'cdup', 'CDUP',
'close', 'QUIT', 'del', 'DELE', 'rmdir', 'RMD', 'type', 'TYPE',
'mkdir', 'MKD', 'pwd', 'PWD', 'syst', 'SYST', 'status', 'STAT',
'help', 'HELP', 'noop', 'NOOP', 'binary', 'I', 'ascii', 'A',
'tenex', 'L');
require 'sys/socket.h';
require 'sys/ioctl.pl';
require 'telnet.h';
require 'pathname.pl';
require 'getopts.pl';
require 'cbreak2.pl';
require 'resolver.pl';
require 'sys/time.h';
require 'sys/errno.ph';
# -h hostname -- specify a hostname on the command line
# -a -- do anonymous login automatically
do Getopts('h:a');
# flag indicating whether this is a background job (started by the back
# command)
$background = 0;
# other than options, no filenames, must be interactive.
if ($#ARGV < $[) {
$interactive = 1;
}
$SIG{'PIPE'} = 'Sigpipe';
# get the file name of this ftp program
@prog = split("/", $0);
$sockaddr = 'S n a4 C8';
$connecting = 0;
# initialize nice little prompt with working directory name
if ($interactive) {
$pwd = $ENV{'PWD'};
@t = localtime(time);
$prompt = $pwd;
$prompt =~ s|$ENV{'HOME'}|~|;
$prompt .= sprintf ("[%02d:%02d]", $t[2], $t[1]);
print "nftp Version 1.0 February 21, 1991\n";
print "Comments to clipper@csd.uwo.ca\n\n";
}
if (defined($opt_h)) {
do connect($opt_h); ## connect the host specified on the command line
}
if (defined($opt_v) && ($opt_v =~ /^[01234]$/ || $opt_v == -1)) {
$verbose = $opt_v;
print "Verbose level is: $verbose\n";
}
# Help messges
%help = (
"help",
" Nftp is a ftp client. To get help messages for a command, type
help command. Commands available in nftp are:
! % ascii back binary cd cdup
close del get help history lcd lmkdir
login ls mget mkdir more mput noop
open put pwd quit reget rename rhelp
rm rmdir status syst tenex verb
Newer commands are: [nothing yet]
",
'!', "
! command
Execute a UNIX command. '! ls' lists the current directory. Notice the
space after the character '!'. This is different from '!' in csh, for
example.
",
'%', "
% history-entry-number
Run the history entry number again. % 2 executes the entry number 2.
",
'ascii', "
ascii
Set the type of file transfer to be ASCII
",
'back', "
back [log-file]
This command asks for commands to be executed in the background. Then nftp
will disconnect its own terminal and runs in the background. The
optional log file will contain the output of nftp in the backgorund
session. The default file name for the log file is /tmp/nftp$$.back
where $$ is the process number of the current nftp process.
",
'binary', "
binary
Set the file type to be binary
",
'cd', "
cd [directory]
Change the current directory on the remote machine.
",
'cdup', "
cdup
Goes up a level in a tree-structured file system.
",
'close', "
close
Close ftp connection to the remote machine.
",
'del', "
del file
Delete the file from the remote machine.
",
'get', "
get remote-file [local-file]
Get the remote file and optionally rename it to the local file name
provided.
",
'history', "
history
Returns the list of commands executed in the history array.
",
'lcd', "
lcd [dir]
Change the local directory.
",
'lmkdir', "
lmkdir dir
Make a local directory.
",
'login', "
login
Login as a user.
",
'ls', "
ls [options] [file]
List the current directory of the remote machine. The syntax depends
on the machine type of the remote machine.
",
'mget', "
mget regexp
Get multiple files from remote machine using regular expression.
Notice the regular expression syntax is that of Unix.
",
'mkdir', "
mkdir dir
Create a new directory on the remote machine.
",
'more', "
more file
Print the content of a file on the current directory of the remote
mahcine on the screen.
",
'mput', "
mput regexp
Putting multiple files to remote machine using Unix regular expression
syntax.
",
'noop', "
noop
No-op.
",
'open', "
open machine
Connect to a new remote machine.
",
'put', "
put localfile [remotefile]
Putting localfile to remote machine using a optional remote file name.
",
'pwd', "
pwd
Print the current directory of the remote machine.
",
'quit', "
quit
Close the connection and exit nftp.
",
'reget', "
reget filename
Starting from the last byte of the file in the current local
directory, get the rest of the file from the remote machine.
",
'rename', "
rename original new
Rename a file on the remote machine.
",
'rhelp', "
rhelp [text]
Ask for help from the remote machine.
",
'rm', "
rm file
Remove a local file.
",
'rmdir', "
rmdir dir
Remove a directory from the remote machine.
",
'status', "
status
Return the status of the remote machine.
",
'syst', "
syst
Print the remote machine type.
",
'tenex', "
tenex
Set file type to tenex, whatever that is.
",
'verb', "
verb level
Set the verbose level of nftp to level. the verbose levels of nftp
are:
the smaller the value of verbose is, the less printing nftp will do.
verbose == 4 : everything is shown
verbose == 3 : hash marks are not shown
verbose == 2 : commands are not shown
verbose == 1 : reply codes are not shown
verbose == 0 : the prompt is not printed.
verbose == -1: not even the error messages are shown.
");
# number of command lines remembered
$histnum = 20;
if ($interactive) {
$SIG{'INT'} = 'again';
}
while ($in = &getinput(":$prompt> ")) {
chop($in);
push(@history, $in);
if ($#history > $histnum) {
shift(@history);
}
$in =~ s/\s+/ /g; ## no useless spaces
@command = split(' ', $in);
next if ($#command < $[); ## no command, next line
$command_name = $command[0];
$command_name =~ y/A-Z/a-z/;
shift(@command);
if ($func{$command_name} ne "") {
$func = $func{$command_name};
do $func(@command);
}
elsif ($interactive && $verbose >= 0) {
print "Unknown command: Passed directly to the server (y/n)? ";
$answer = <STDIN>;
if ($answer =~ /^[yY]/) {
do literal(@command);
}
}
elsif ($verbose >= 0) {
print "Ignored command: $command_name @command\n";
}
}
continue {
if ($interactive){
@t = localtime(time);
$prompt = $pwd;
$prompt =~ s|$ENV{'HOME'}|~|;
$prompt .= sprintf ("[%02d:%02d]", $t[2], $t[1]);
}
}
do doquit();
## End of main program
# get the reply, parse it and return a nice code
sub getreply {
local($code);
local($answer);
$answer = <SERVER> || ((&printn("Lost connection, getreply\n")), close SERVER,
$connecting = 0, return $FAIL);
$answer =~ s/\r//g;
local($reply) = $answer;
while ($reply ne "") {
if ($reply =~ /^\d\d\d\-/) { ## Oh no, multi-line reply
&print1 ($reply);
while ($reply = <SERVER>) {
$reply =~ s/\r//g;
$answer = $reply;
if ($reply =~ /^\d\d\d[^-]/) { last; }
&print1($reply);
}
}
($reply =~ /^1/) && ($code = $DATA, last);
($reply =~ /^2/) && ($code = $SUCCESS, last);
($reply =~ /^3/) && ($code = $CONTINUE, last);
($reply =~ /^4/) && ($code = $ERROR, last);
($reply =~ /^5/) && ($code = $FAIL, last);
($reply =~ /^&IAC&WILL(.)/) && ((print SERVER "&IAC&WONT$1"), $reply = $');
($reply =~ /^&IAC&DO(.)/) && ((print SERVER "&IAC&DONT$1"), $reply = $');
$answer = "ERROR: $answer"; $code = $ERROR;
}
&print1 ($answer);
$code;
}
# The simplest commands, just the command name
sub simple {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
&print2 (" $words{$command_name}\n");
print SERVER $words{$command_name}, "\r\n";
$code = &getreply();
}
# The next simplest commands, with one and only one command
sub simple1 {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
if ($#_ > $[) {
&printn ("$prog: trailing garbage ignored\n");
}
elsif ($#_ < $[) {
&printn ("Need one argument\n");
return;
}
&print2 (" $words{$command_name} $_[0]\n");
print SERVER $words{$command_name}, " $_[0]\r\n";
$code = &getreply();
}
# for local help.
sub dohelp {
if ($#_ < $[ || $#_ > $[) {
print $help{'help'};
}
else {
print $help{$_[0]};
}
print "\n";
}
# for remote help command, just pass everything to the remote site
sub dorhelp {
local($command) = $words{$command_name};
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
for ($index = 0; $index <= $#_; $index++){
$command .= " " . $_[$index];
}
&print2 (" $command\n");
print SERVER $command, "\r\n";
$code = &getreply();
}
# pass everything as typed to the remote site
sub literal {
local($command) = $command_name;
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
for ($index = 0; $index <= $#_; $index++){
$command .= " " . $_[$index];
}
&print2 (" $command\n");
print SERVER $command, "\r\n";
$code = &getreply();
}
# change working directory. just as Unix cd
sub cd {
local($command) = $words{$command_name};
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
if ($#_ > $[) {
&printn ("trailing garbage ignored\n");
$#_ = $[;
}
for ($index = 0; $index <= $#_; $index++){
$command .= " " . $_[$index];
}
&print2 (" $command\n");
print SERVER $command, "\r\n";
$code = &getreply();
}
# Get a file from remote site. The first argument is the remote filename
# If the second argument is absent, it is assumed to be the same as the
# first argument. The second argument is the local filename
sub get {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
if ($#_ < $[) {
&printn ("Need at least one ardument\n");
return;
}
local($rfilename) = $_[0];
local($lfilename);
local($code);
local($buf);
if ($#_ == $[) {
$lfilename = ">$rfilename";
}
else {
$lfilename = ">$_[1]";
}
open(FILE, $lfilename) || ((&printn ("open:$!\n")), return);
$code = &setup();
if ($code != 2) { return; } # &setup reply code is not 2, something is wrong
&print2 (" RETR \'$rfilename\'\n");
print SERVER "RETR $rfilename\r\n";
$code = &getreply();
if ($code != 1) { return; }
($addr = accept(DATA1, DATA)) || ((&printn ("accept:$!\n")), return);
select(FILE); $| = 1; select(STDOUT); $| = 1;
if ($interactive) {
do init_hash();
}
$buf = '';
while (!$inter && (($len = read(DATA1, $buf, 1000)) > 0 || $! == &EINTR)) {
$buf =~ s/\r//g if ($NOCR);
$bytes += $len;
print FILE $buf;
$buf = '';
}
$SIG{'INT'} = 'again';
if ($interactive) {
do end_hash();
}
close FILE;
close DATA1;
$code = &getreply();
}
sub more {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
if ($#_ < $[) {
&printn ("Need at least one ardument\n");
return;
}
local($rfilename) = $_[0];
local($code);
local($buf);
local($code) = &setup();
if ($code != 2) { return; }
&print2 (" RETR \'$rfilename\'\n");
print SERVER "RETR $rfilename\r\n";
$code = &getreply();
if ($code != 1) { return; }
($addr = accept(DATA1, DATA)) || ((&printn ("accept:$!\n")), return);
if ($rfilename =~ /\.Z$/) {
open(RFILE, "| zmore");
}
else {
open(RFILE, "| more") || ((&printn ("open:$!\n")), return);
}
$SIG{'INT'} = 'abort';
while (($len = read(DATA1, $buf, 1000)) > 0 || $! == &EINTR) {
$buf =~ s/\r//g if ($NOCR);
print RFILE $buf;
}
$SIG{'INT'} = 'again';
close DATA1;
close RFILE;
$code = &getreply();
}
# List the current directory
# Has the same syntax and options as Unix ls command
sub list {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
local($buf, $command, $index);
local($code) = &setup();
if ($code != 2) { return; }
$command = "LIST";
for ($index = 0; $index <= $#_; $index++) {
$command .= " " . $_[$index];
}
&print2 (" $command\n");
print SERVER $command, "\r\n";
$code = &getreply();
if ($code != 1) { return; }
($addr = accept(DATA1, DATA)) || ((&printn ("accept:$!\n")), return);
$SIG{'INT'} = 'abort';
$less = 0;
if ($interactive & $ENV{'TERM'} ne 'emacs' & $ENV{'TERM'} ne 'unknown') {
$less = 1;
open(LESS, "|less");
$SIG{'PIPE'} = 'SIGPIPE';
$nooutput = 0;
}
while (sysread(DATA1, $buf, 1000) > 0) {
$buf =~ s/\r//g if ($NOCR);
if ($less) {
$ret = eval 'print LESS $buf';
}
else {
print $buf;
}
}
if ($less) {
close(LESS);
}
$SIG{'INT'} = 'again';
close DATA1;
$code = &getreply();
}
# Return a file list of the current remote working directory in a tmp file
sub nlst {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
local($buf, $command, $index);
local($code) = &setup();
if ($code != 2) { return; }
$command = "NLST";
for ($index = 0; $index <= $#_; $index++) {
$command .= " " . $_[$index];
}
&print2 (" $command\n");
print SERVER $command, "\r\n";
$code = &getreply();
if ($code != 1) { return; }
($addr = accept(DATA1, DATA)) || ((&printn ("accept:$!\n")), return);
$SIG{'INT'} = 'abort';
open(FILE, ">/tmp/nftp$$.nlst")||((&printn ("open:$!\n")), close(DATA1), return);
while (sysread(DATA1, $buf, 1000) > 0) {
$buf =~ s/\r//g if ($NOCR);
print FILE $buf;
}
$SIG{'INT'} = 'again';
close(FILE);
# unlink("/tmp/nftp$$.nlst");
close DATA1;
$code = &getreply();
}
# Put a local file to the remote site. The first argument is the local file
# name. The seocnd argument is the remote filename, assumed to be the same
# as the first argument when it is missing
sub put {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
if ($#_ < $[) {
&nprint ("Need at least one argument\n");
return;
}
local($rfilename);
local($lfilename) = $_[0];
open(FILE, $lfilename) || ((&printn ("open:$!\n")), return);
local($code) = &setup();
local($buf);
if ($code != 2) { return; }
if ($#_ == $[) {
$rfilename = $lfilename;
}
else {
$rfilename = $_[1];
}
&print2 (" STOR $rfilename\n");
print SERVER "STOR $rfilename\r\n";
$code = &getreply();
if ($code != 1) { return; }
($addr = accept(DATA1, DATA)) || ((&printn ("accept:$!\n")), return);
select(FILE); $| = 1; select(STDOUT); $| = 1;
$bytes = 0;
$SIG{'INT'} = 'abort';
if ($interactive) {
do init_hash();
}
while (($len = read(FILE, $buf, 1000)) > 0) {
$bytes += $len;
print DATA1 $buf;
}
if ($interactive){
do end_hash();
}
$SIG{'INT'} = 'again';
close DATA1;
$code = &getreply();
}
# Rename a remote file
sub rename {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
local($from, $to) = @_;
local($code);
&print2 (" RNFR $from\n");
print SERVER "RNFR $from\r\n";
$code = &getreply();
if ($code != 3) { return; }
&print2 (" RNTO $to\n");
print SERVER "RNTO $to\r\n";
$code = &getreply();
}
# Get the rest of the file. No different filenames for the remote
# and local files, sorry.
sub restoffile {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
if ($#_ < $[) {
&nprint ("Need at least one argument\n");
return;
}
local($code);
local(@size) = stat($_[0]);
&print2 (" REST $size[7]\n");
print SERVER "REST ", $size[7], "\r\n";
$code = &getreply();
if ($code != 3) { return; }
do get($_[0], ">$_[0]");
}
sub init_hash {
$SIG{'ALRM'} = 'sig_alarm';
$ten = 0;
$#ten = -1;
$tentimes = 0;
$lastbytes = 0;
alarm(1);
$bytes = 0;
$totaltime = 0;
$inter = 0;
$SIG{'INT'} = 'abort';
}
sub end_hash {
print "\n";
$SIG{'ALRM'} = 'IGNORE';
alarm(0);
}
sub sig_alarm {
$totaltime++;
if ($totaltime > 0) {
$usetime = $bytes / $totaltime / 1000;
}
if ($totaltime < 10) {
$increment = $bytes - $lastbytes;
$tentimes += $increment;
$tentime = $tentimes / $totaltime / 1000;
$ten[$ten] = $increment;
$ten++;
}
else {
$increment = $bytes - $lastbytes;
$tentimes += $increment - $ten[$ten];
$tentime = $tentimes / 10000;
$ten[$ten] = $increment;
$ten = ($ten + 1) % 10;
}
$lastbytes = $bytes;
if ($verbose > 3) {
printf "\r%5d:%8d:%7.2f:%7.2f", $totaltime, $bytes, $usetime, $tentime;
}
$SIG{'ALRM'} = 'sig_alarm';
alarm(1);
}
# login if -a is not specified,
sub ilogin {
if (defined($opt_a)) {
&printn ("Ah, but you specified -a option.\n");
}
else {
&login (@_);
}
}
# login the remote site
sub login {
local($user, $pass, $acct) = @_;
local($code);
if (! defined($_[0])) {
print "login:";
$user = <>;
chop($user);
}
&print2 (" USER $user\n");
print SERVER "USER ", $user, "\r\n";
$code = &getreply();
if ($code == 2) { $connecting = 1; $NOCR = 1; return; }
if ($code != 3) { return; }
$NOCR = 1;
if (! defined($_[1])) {
do set_cbreak(1);
print "Password:";
$pass = <>;
do set_cbreak(0);
print "\n";
chop($pass);
}
&print2 (" PASS\n");
print SERVER "PASS ", $pass, "\r\n";
$code = &getreply();
if ($code == 2) { $connecting = 1; return; }
if ($code != 3) { return; }
if (! defined($_[2])) {
do set_cbreak(1);
print "Account:";
$acct = <>;
do set_cbreak(0);
print "\n";
chop($acct);
}
&print2 (" ACCT\n");
print SERVER "ACCT ", $acct, "\r\n";
$code = &getreply();
if ($code == 2) { $connecting = 1; return; }
}
# Set up the data connection
sub setup {
socket(DATA, &PF_INET, &SOCK_STREAM, 0) || ((&printn ("socket:$!\n")), return 0);
$sockname = getsockname(SERVER) || ((&printn ("getsockname:$!\n")), return 0);
($family, $port, $addr) = unpack($sockaddr, $sockname);
@port = unpack("CC", $port);
$sout = pack($sockaddr, &AF_INET, 0, $addr);
bind(DATA, $sout) || ((&printn ("bind:$!\n")), return $FAIL);
listen(DATA, 1) || ((&printn ("listen:$!\n")), return $FAIL);
$sockname = getsockname(DATA) || ((&printn ("getsockname:$!\n")), return $FAIL);
($family, $port, $addr) = unpack($sockaddr, $sockname);
$port[0] = int($port / 256);
$port[1] = $port % 256;
&print2 (" PORT $addr[0],$addr[1],$addr[2],$addr[3],$port[0],$port[1]\n");
print SERVER "PORT $addr[0],$addr[1],$addr[2],$addr[3],$port[0],$port[1]\r\n";
&getreply();
}
# Connect to a remote site
sub connect {
if ($connecting) {
&printn ("Connected. Disconnect first\n");
return;
}
$port = 21;
if ($_[0] =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) {
print "IP address is given...";
$saddr = pack("CCCC", $1, $2, $3, $4);
}
else {
print "Trying the host table /etc/hosts...";
if (!(($name, $aliases, $type, $len, $saddr) = gethostbyname($_[0]))) {
print "\nTrying the domain name server for IP address...";
if (!($saddr = &resolver($_[0]))) {
print "\nTrying the FTP file for IP address...";
if (!($saddr = &ftpl($_[0]))) {
&printn ("\nNo such host\n");
return;
}
}
}
}
print join('.', unpack('C4', $saddr)), "\n";
$sin = pack($sockaddr, 2, $port, $saddr);
socket(SERVER, 2, 1, 0) || ((&printn ("socket:$!\n")), return $FAIL);
connect(SERVER, $sin) || ((&printn ("connect:$!\n")), return $FAIL);
$sockname = getsockname(SERVER) || ((&printn ("getsockname:$!\n")), return $FAIL);
($family, $port, $addr) = unpack($sockaddr, $sockname);
@addr = unpack("CCCC", $addr);
select(SERVER); $| = 1; select(STDOUT); $| = 1;
$connecting = 1;
&getreply();
if ($opt_a) {
do login("ftp", "guest");
}
}
# make a local directory
sub domkdir {
mkdir($_[0], 0700) || ((&printn ("lmkdir: $!\n")), return);
&print1 ("created: $_[0]\n");
}
# delete a local file
sub rm {
unlink($_[0]);
}
# change the current local working directory
sub dochdir {
local($path2) = $_[0];
if ($path2 eq "~") {
$path2 = $ENV{'HOME'};
}
if ($path2 =~ m|^~([^/]*)|) {
if ($1 eq "") {
$path2 = $ENV{'HOME'} . $';
}
else {
@ent = getpwnam($1);
$path2 = $ent[7] . $';
}
}
if ($path2 eq "") {
$path2 = $ENV{'HOME'};
}
chdir $path2 || ((&printn ("lcd: $!\n")), next);
$pwd = &pathname($pwd, $path2);
}
# Quit the current session
sub doquit {
if ($connecting) {
$command_name = "QUIT";
do literal();
unlink ("/tmp/nftp$$");
close SERVER;
}
&print1 ("<End of nftp session>\n");
close STDOUT;
exit 0;
}
# send abort command. Unfortunately, this is optional in some sites. Oh well
sub abort {
&end_hash();
printf SERVER pack("CC", &IAC, &IP);
send(SERVER, pack("C", &IAC), 1, &MSG_OOB);
printf SERVER pack("C", &DM);
$command_name = "ABOR";
do literal();
$inter = 1;
$code = &getreply();
$code = &getreply();
# close DATA1;
$SIG{'INT'} = 'again';
print "Tried my best\n";
}
# dummy interrupt routine
sub again {
$in = "";
print "\n";
}
# multiple get command
sub mget {
do nlst($_[0]);
open(NLIST, "/tmp/nftp$$.nlst");
$inter = 0;
$reg = $_[0];
# convert Unix regular expression to perl regular expression
$reg =~ s/\?/./g;
$reg =~ s/([^\\]*)([\*\+])/\1.\2/g;
$reg =~ s/^\*/\.\*/g;
$reg =~ s/^\?/\.\?/g;
while ($name = <NLIST>) {
chop($name);
$name =~ s/(.*)\r/\1/;
$name =~ /$reg/ && do get($name, "$name");
if ($inter && $interactive) {
print "Continue with mget? ";
$c = <STDIN>;
if ($c =~ /^[yY]/) {
$inter = 0;
next;
}
else {
last;
}
}
}
unlink("/tmp/nftp$$.nlst");
}
# multiple put command
sub mput {
local($names) = $_[0];
local($_, @file);
while (<${names}>) {
if ($inter && $interactive) {
print "Continue with mput? ";
$c = <STDIN>;
if ($c =~ /^[yY]/) {
$inter = 0;
next;
}
else {
last;
}
}
@file = split('/', $_);
do put($file[$#file], $_);
}
}
# get a line of command
sub getinput {
if (defined($lastcommand)) {
$_ = $lastcommand;
undef($lastcommand);
return;
}
$prompt_sig = $_[0];
if ($interactive) {
&print0 ($_[0]);
if ($_ = <>) {
$_;
}
else {
"quit\n";
}
}
elsif ($background) {
if ($_ = <STDIN>) {
$_;
}
else {
"quit\n";
}
}
elsif ($_ = <>) {
$_;
}
else {
"quit\n";
}
}
# set background ftp session
sub background {
$background = 1;
$interactive = 0;
$noread = 0;
$SIG{'INT'} = 'backint';
open (COMM, ">/tmp/nftpback$$");
&print0 ("Input commands. Finish by a single dot on the line.\n");
&print0 ("> ");
$comm = <STDIN>;
while ($comm !~ /^\.$/) {
print COMM $comm;
}
continue {
&print0 ("> ");
$comm = <STDIN>;
}
close(COMM);
$SIG{'INT'} = 'again';
open(STDIN, "/tmp/nftpback$$");
if (defined($_[0])) {
$file = "$_[0]";
}
else {
$file = "/tmp/nftpback$$.stdout";
}
if ($child = fork()) {
&print1 ("[nftp log file: $file process: $child]\n");
exit(0);
}
$SIG{'HUP'} = 'IGNORE';
open(STDOUT, ">$file");
open(TTY, '/dev/tty');
ioctl(TTY, $TIOCNOTTY, 0);
close(TTY);
backexit: return;
}
# for changing the type of file expected
sub type {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
local($command) = $command_name;
$command_name = "TYPE";
$command =~ 'binary' && (do literal('I'), $NOCR = 0, return);
$command =~ 'ascii' && (do literal('A'), $NOCR = 1, return);
$command =~ 'tenex' && (do literal('L', 8), $NOCR = 1);
}
# close remote connection
sub close {
if (!$connecting) {
&printn ("Not connected. Connect first\n");
return;
}
$command_name = "close";
&simple();
$connecting = 0;
$NOCR = 1;
}
# set verbose levels
sub verbose {
return if ($#_ < $[);
local($level) = $_[0];
return if ($level < -1 || $level > 4);
$verbose = $level;
if ($verbose > 1) {
print "Verbose level is now: $verbose\n";
}
}
sub printn {
&nprint (-1, @_);
}
sub print1 {
&nprint (1, @_);
}
sub print0 {
&nprint (0, @_);
}
sub print2 {
&nprint (2, @_);
}
sub print3 {
&nprint (3, @_);
}
sub nprint {
local($level, @str) = @_;
print @str if ($verbose > $level);
}
sub Sigpipe {
# print "Can't handle sigpipe signal\n";
# print "Leaving...\n";
# exit(1);
}
sub backint {
$SIG{'INT'} = 'DEFAULT';
goto backexit;
}
sub ftpl {
local($ftpl) = @_;
open(FTPL, "uncompress -c $ftplist |");
while (<FTPL>) {
last if ($_ =~ /^=/);
}
while (<FTPL>) {
if ($_ =~ /^$ftpl /) {
($name, $addr) = split(' ', $_);
close(FTPL);
return $addr;
}
}
close(FTPL);
0;
}
sub dohistory {
local($i, $entry);
$i = 0;
foreach $entry (@history) {
print "$i: $entry\n";
$i++;
}
}
sub doshell {
system("sh -c @_");
}
sub dohis {
if ($#_ < 0 || $#_ > 0 || $_[0] < 0 || $_[0] > $#history) {
print "Invalid history entry\n";
return;
}
$lastcommand = "$history[$_[0]]\n";
print "$lastcommand";
}
sub SIGPIPE {
close(LESS);
$nooutput = 1;
}
sub SIGTSTP {
print "\n";
$SIG{'TSTP'} = 'DEFAULT';
kill('TSTP', 0);
print $prompt_sig;
}
SHAR_EOF
chmod +x 'nftp'
fi # end of overwriting check
if test -f 'nftp.1'
then
echo shar: will not over-write existing file "'nftp.1'"
else
cat << \SHAR_EOF > 'nftp.1'
.TH NFTP 1 "Release 44" "Perl Version 3"
.SH NAME
nftp - a ftp client written in Perl
.SH SYNOPSIS
.B nftp
[-a] [-h hostname/IP-address] [command-file]
.SH DESCRIPTION
The \fInftp\fP program is a ftp client written in Perl. Originally
written as an exercise for Perl, it now contains almost all the
features of the BSD ftp client. More features are being added to it to
make it more versatile.
.SH OPTIONS
.PP
.IP "\fB-h\fP hostname
Specify a host to connect to by hostname, or IP address. \fInftp\fP
connects to a domain name server if it does not know the IP address of
the hostname you specify. In addition, it will also check the set of
anonymous FTP list posted in the newsgroup comp.misc. This file is in
/usr2/new/lib/ftp.list.Z and will be updated from time to time.
.IP "\fB-a\fP"
Tell \fInftp\fP to login as user ftp and password guest. This is
useful if you are connecting as a anonymous user.
.SH "EXAMPLES"
.TP8
.B "nftp"
This will run nftp and wait for input.
.TP 8
.B "nftp command"
This will run nftp and execute the commands in the file command.
.TP8
.B "nftp -a -h no9sun.csd.uwo.ca"
This will connect to the host no9sun.csd.uwo.ca as an anonymous user.
.TP 8
.SH "COMMANDS"
Since features are being added to nftp, please run nftp and then type
"help" to see the list of commands available.
.SH "SEE ALSO"
ftp(1)
.SH AUTHOR
Khun Yee Fung, Department of Computer Science, University of Western
Ontario.
The author is not responsible for the use of this program. Use at your
own risk. If you have any problems, you can mail to
clipper@csd.uwo.ca. The author will not promise to respond to them,
however.
.SH BUGS
Control C is not handled nicely.
.SH DATE
1991 February 21
SHAR_EOF
fi # end of overwriting check
if test -f 'resolver.pl'
then
echo shar: will not over-write existing file "'resolver.pl'"
else
cat << \SHAR_EOF > 'resolver.pl'
#!/usr2/new/bin/perl
# a subroutine to resolve a Internet host name to IP address
# Written by Khun Yee Fung (clipper@csd.uwo.ca)
sub resolver {
local($sockaddr) = 'S n a4 x8';
local($hostname) = $_[0];
local($server) = 'ria.ccs.uwo.ca';
local($port) = 53;
(local($name, $aliases, $type, $len, $saddr) = gethostbyname($server))
|| ((print "hostname\n"), return 0);
local($sin) = pack($sockaddr, 2, $port, $saddr);
socket(NSERVER, 2, 1, 0) || ((print "socket: $!\n"), return 0);
connect(NSERVER, $sin) || ((print "connect: $!\n"), return 0);
select(NSERVER); $| = 1; select(STDOUT); $| = 1;
local($len) = 18 + length($hostname);
local(@names) = split('\.', $hostname);
local($head) = pack('S6', 319, 256, 1, 0, 0, 0);
print NSERVER pack('S', $len), $head;
local($arg, $response);
foreach $arg (@names) {
print NSERVER pack('C', length($arg)), $arg;
}
print NSERVER pack('CS2', 0, 1, 1);
read(NSERVER, $len, 2);
read(NSERVER, $response, unpack('S', $len));
close NSERVER;
local(@RCODE) = ("No error", "Format error", "Server Failure", "Name error",
"Not implemented", "Refused");
local(@shead) = unpack('S6', $response);
($shead[1] & 0x0F) == 0 || return 0;
local($in) = 12;
local($ans) = $shead[2];
local($c);
while ($ans > 0) {
while (($c = ord(substr($response, $in++, 1))) != 0) {
$in += $c;
}
$in += 4;
$ans--;
}
$ans = $shead[3];
local($type, $rdlength, $rdata);
while ($ans > 0) {
while (($c = ord(substr($response, $in++, 1))) != 0) {
($c & 0xc0) != 0xc0 || $in++, last;
$in += $c;
}
$type = substr($response, $in, 2);
$in += 8;
$rdlength = unpack('n', substr($response, $in, 2));
$in += 2;
$rdata = substr($response, $in, $rdlength);
if (unpack('S', $type) == 1) {
return $rdata;
}
$in += $rdlength;
$ans--;
}
return 0;
}
1;
SHAR_EOF
chmod +x 'resolver.pl'
fi # end of overwriting check
if test -f 'pathname.pl'
then
echo shar: will not over-write existing file "'pathname.pl'"
else
cat << \SHAR_EOF > 'pathname.pl'
#!/usr2/new/bin/perl
# A simple subroutine to get the absolute path when two paths are
# merged. Written by Khun Yee Fung (clipper@csd.uwo.ca)
sub pathname {
local($path1) = $_[0];
local($path2) = $_[1];
local($arg, @path);
local($num) = 0;
if ($path2 eq /^~/) {
$path2 = $ENV{'HOME'} . $path2;
}
if ($path2 =~ m|^~([^/]*)|) {
if ($1 == "") {
$path2 = $ENV{'HOME'} . $path2;
}
else {
@ent = getpwnam($1) || (@ent = (""));
$path2 = $ent[7] . $path2;
}
}
if ($path2 !~ m|^/|) {
$path2 = $path1 . "/" . $path2;
}
local(@paths) = split(m|/|, $path2);
foreach $arg (@paths) {
($arg =~ /^\.\.$/) && ($num--, next);
($arg =~ /^\.$/) && next;
($arg eq "") && next;
$path[$num] = $arg;
$num++;
}
$#path = $num - 1;
$path1 = "";
foreach $arg (@path) {
$path1 = $path1 . $arg . "/";
}
chop($path1);
$path1 = "/" . $path1 if ($path1 !~ "^/");
$path1;
}
1;
SHAR_EOF
chmod +x 'pathname.pl'
fi # end of overwriting check
if test -f 'socket.h'
then
echo shar: will not over-write existing file "'socket.h'"
else
cat << \SHAR_EOF > 'socket.h'
if (!defined &_SOCKET_) {
eval 'sub _SOCKET_ {1;}';
eval 'sub SOCK_STREAM {1;}';
eval 'sub SOCK_DGRAM {2;}';
eval 'sub SOCK_RAW {3;}';
eval 'sub SOCK_RDM {4;}';
eval 'sub SOCK_SEQPACKET {5;}';
eval 'sub SO_DEBUG {0x0001;}';
eval 'sub SO_ACCEPTCONN {0x0002;}';
eval 'sub SO_REUSEADDR {0x0004;}';
eval 'sub SO_KEEPALIVE {0x0008;}';
eval 'sub SO_DONTROUTE {0x0010;}';
eval 'sub SO_BROADCAST {0x0020;}';
eval 'sub SO_USELOOPBACK {0x0040;}';
eval 'sub SO_LINGER {0x0080;}';
eval 'sub SO_OOBINLINE {0x0100;}';
eval 'sub SO_DONTLINGER {(~&SO_LINGER);}';
eval 'sub SO_SNDBUF {0x1001;}';
eval 'sub SO_RCVBUF {0x1002;}';
eval 'sub SO_SNDLOWAT {0x1003;}';
eval 'sub SO_RCVLOWAT {0x1004;}';
eval 'sub SO_SNDTIMEO {0x1005;}';
eval 'sub SO_RCVTIMEO {0x1006;}';
eval 'sub SO_ERROR {0x1007;}';
eval 'sub SO_TYPE {0x1008;}';
eval 'sub SOL_SOCKET {0xffff;}';
eval 'sub AF_UNSPEC {0;}';
eval 'sub AF_UNIX {1;}';
eval 'sub AF_INET {2;}';
eval 'sub AF_IMPLINK {3;}';
eval 'sub AF_PUP {4;}';
eval 'sub AF_CHAOS {5;}';
eval 'sub AF_NS {6;}';
eval 'sub AF_NBS {7;}';
eval 'sub AF_ECMA {8;}';
eval 'sub AF_DATAKIT {9;}';
eval 'sub AF_CCITT {10;}';
eval 'sub AF_SNA {11;}';
eval 'sub AF_DECnet {12;}';
eval 'sub AF_DLI {13;}';
eval 'sub AF_LAT {14;}';
eval 'sub AF_HYLINK {15;}';
eval 'sub AF_APPLETALK {16;}';
eval 'sub AF_NIT {17;}';
eval 'sub AF_802 {18;}';
eval 'sub AF_OSI {19;}';
eval 'sub AF_X25 {20;}';
eval 'sub AF_OSINET {21;}';
eval 'sub AF_GOSIP {22;}';
eval 'sub AF_MAX {21;}';
eval 'sub PF_UNSPEC {&AF_UNSPEC;}';
eval 'sub PF_UNIX {&AF_UNIX;}';
eval 'sub PF_INET {&AF_INET;}';
eval 'sub PF_IMPLINK {&AF_IMPLINK;}';
eval 'sub PF_PUP {&AF_PUP;}';
eval 'sub PF_CHAOS {&AF_CHAOS;}';
eval 'sub PF_NS {&AF_NS;}';
eval 'sub PF_NBS {&AF_NBS;}';
eval 'sub PF_ECMA {&AF_ECMA;}';
eval 'sub PF_DATAKIT {&AF_DATAKIT;}';
eval 'sub PF_CCITT {&AF_CCITT;}';
eval 'sub PF_SNA {&AF_SNA;}';
eval 'sub PF_DECnet {&AF_DECnet;}';
eval 'sub PF_DLI {&AF_DLI;}';
eval 'sub PF_LAT {&AF_LAT;}';
eval 'sub PF_HYLINK {&AF_HYLINK;}';
eval 'sub PF_APPLETALK {&AF_APPLETALK;}';
eval 'sub PF_NIT {&AF_NIT;}';
eval 'sub PF_802 {&AF_802;}';
eval 'sub PF_OSI {&AF_OSI;}';
eval 'sub PF_X25 {&AF_X25;}';
eval 'sub PF_OSINET {&AF_OSINET;}';
eval 'sub PF_GOSIP {&AF_GOSIP;}';
eval 'sub PF_MAX {&AF_MAX;}';
eval 'sub SOMAXCONN {5;}';
eval 'sub MSG_OOB {0x1;}';
eval 'sub MSG_PEEK {0x2;}';
eval 'sub MSG_DONTROUTE {0x4;}';
eval 'sub MSG_MAXIOVLEN {16;}';
}
1;
SHAR_EOF
chmod +x 'socket.h'
fi # end of overwriting check
if test -f 'ioctl.pl'
then
echo shar: will not over-write existing file "'ioctl.pl'"
else
cat << \SHAR_EOF > 'ioctl.pl'
$TIOCGSIZE = 0x40087468;
$TIOCSSIZE = 0x80087467;
$IOCPARM_MASK = 0x1fff;
$IOCPARM_MAX = 0x200;
$IOC_VOID = 0x20000000;
$IOC_OUT = 0x40000000;
$IOC_IN = 0x80000000;
$IOC_INOUT = 0xC0000000;
$IOC_DIRMASK = 0xe0000000;
$TIOCGETD = 0x40047400;
$TIOCSETD = 0x80047401;
$TIOCHPCL = 0x20007402;
$TIOCMODG = 0x40047403;
$TIOCMODS = 0x80047404;
$TIOCM_LE = 0001;
$TIOCM_DTR = 0002;
$TIOCM_RTS = 0004;
$TIOCM_ST = 0010;
$TIOCM_SR = 0020;
$TIOCM_CTS = 0040;
$TIOCM_CAR = 0100;
$TIOCM_CD = 0x40;
$TIOCM_RNG = 0200;
$TIOCM_RI = 0x80;
$TIOCM_DSR = 0400;
$TIOCGETP = 0x40067408;
$TIOCSETP = 0x80067409;
$TIOCSETN = 0x8006740A;
$TIOCEXCL = 0x2000740D;
$TIOCNXCL = 0x2000740E;
$TIOCFLUSH = 0x80047410;
$TIOCSETC = 0x80067411;
$TIOCGETC = 0x40067412;
$TANDEM = 0x00000001;
$CBREAK = 0x00000002;
$LCASE = 0x00000004;
$ECHO = 0x00000008;
$CRMOD = 0x00000010;
$RAW = 0x00000020;
$ODDP = 0x00000040;
$EVENP = 0x00000080;
$ANYP = 0x000000c0;
$NLDELAY = 0x00000300;
$NL0 = 0x00000000;
$NL1 = 0x00000100;
$NL2 = 0x00000200;
$NL3 = 0x00000300;
$TBDELAY = 0x00000c00;
$TAB0 = 0x00000000;
$TAB1 = 0x00000400;
$TAB2 = 0x00000800;
$XTABS = 0x00000c00;
$CRDELAY = 0x00003000;
$CR0 = 0x00000000;
$CR1 = 0x00001000;
$CR2 = 0x00002000;
$CR3 = 0x00003000;
$VTDELAY = 0x00004000;
$FF0 = 0x00000000;
$FF1 = 0x00004000;
$BSDELAY = 0x00008000;
$BS0 = 0x00000000;
$BS1 = 0x00008000;
$ALLDELAY = 0xFF00;
$CRTBS = 0x00010000;
$PRTERA = 0x00020000;
$CRTERA = 0x00040000;
$TILDE = 0x00080000;
$MDMBUF = 0x00100000;
$LITOUT = 0x00200000;
$TOSTOP = 0x00400000;
$FLUSHO = 0x00800000;
$NOHANG = 0x01000000;
$L001000 = 0x02000000;
$CRTKIL = 0x04000000;
$PASS8 = 0x08000000;
$CTLECH = 0x10000000;
$PENDIN = 0x20000000;
$DECCTQ = 0x40000000;
$NOFLSH = 0x80000000;
$TIOCLBIS = 0x8004747F;
$TIOCLBIC = 0x8004747E;
$TIOCLSET = 0x8004747D;
$TIOCLGET = 0x4004747C;
$LCRTBS = 0x1;
$LPRTERA = 0x2;
$LCRTERA = 0x4;
$LTILDE = 0x8;
$LMDMBUF = 0x10;
$LLITOUT = 0x20;
$LTOSTOP = 0x40;
$LFLUSHO = 0x80;
$LNOHANG = 0x100;
$LCRTKIL = 0x400;
$LPASS8 = 0x800;
$LCTLECH = 0x1000;
$LPENDIN = 0x2000;
$LDECCTQ = 0x4000;
$LNOFLSH = 0xFFFF8000;
$TIOCSBRK = 0x2000747B;
$TIOCCBRK = 0x2000747A;
$TIOCSDTR = 0x20007479;
$TIOCCDTR = 0x20007478;
$TIOCGPGRP = 0x40047477;
$TIOCSPGRP = 0x80047476;
$TIOCSLTC = 0x80067475;
$TIOCGLTC = 0x40067474;
$TIOCOUTQ = 0x40047473;
$TIOCSTI = 0x80017472;
$TIOCNOTTY = 0x20007471;
$TIOCPKT = 0x80047470;
$TIOCPKT_DATA = 0x00;
$TIOCPKT_FLUSHREAD = 0x01;
$TIOCPKT_FLUSHWRITE = 0x02;
$TIOCPKT_STOP = 0x04;
$TIOCPKT_START = 0x08;
$TIOCPKT_NOSTOP = 0x10;
$TIOCPKT_DOSTOP = 0x20;
$TIOCSTOP = 0x2000746F;
$TIOCSTART = 0x2000746E;
$TIOCMSET = 0x8004746D;
$TIOCMBIS = 0x8004746C;
$TIOCMBIC = 0x8004746B;
$TIOCMGET = 0x4004746A;
$TIOCREMOTE = 0x80047469;
$TIOCGWINSZ = 0x40087468;
$TIOCSWINSZ = 0x80087467;
$TIOCUCNTL = 0x80047466;
$TIOCSSOFTC = 0x80047465;
$TIOCGSOFTC = 0x40047464;
$TIOCSCARR = 0x80047463;
$TIOCWCARR = 0x20007462;
$OTTYDISC = 0;
$NETLDISC = 1;
$NTTYDISC = 2;
$TABLDISC = 3;
$SLIPDISC = 4;
$FIOCLEX = 0x20006601;
$FIONCLEX = 0x20006602;
$FIONREAD = 0x4004667F;
$FIONBIO = 0x8004667E;
$FIOASYNC = 0x8004667D;
$FIOSETOWN = 0x8004667C;
$FIOGETOWN = 0x4004667B;
$SIOCSHIWAT = 0x80047300;
$SIOCGHIWAT = 0x40047301;
$SIOCSLOWAT = 0x80047302;
$SIOCGLOWAT = 0x40047303;
$SIOCATMARK = 0x40047307;
$SIOCSPGRP = 0x80047308;
$SIOCGPGRP = 0x40047309;
$SIOCADDRT = 0x8030720A;
$SIOCDELRT = 0x8030720B;
$SIOCSIFADDR = 0x8020690C;
$SIOCGIFADDR = 0xC020690D;
$SIOCSIFDSTADDR = 0x8020690E;
$SIOCGIFDSTADDR = 0xC020690F;
$SIOCSIFFLAGS = 0x80206910;
$SIOCGIFFLAGS = 0xC0206911;
$SIOCGIFBRDADDR = 0xC0206912;
$SIOCSIFBRDADDR = 0x80206913;
$SIOCGIFCONF = 0xC0086914;
$SIOCGIFNETMASK = 0xC0206915;
$SIOCSIFNETMASK = 0x80206916;
$SIOCGIFMETRIC = 0xC0206917;
$SIOCSIFMETRIC = 0x80206918;
$SIOCSARP = 0x8024691E;
$SIOCGARP = 0xC024691F;
$SIOCDARP = 0x80246920;
SHAR_EOF
chmod +x 'ioctl.pl'
fi # end of overwriting check
if test -f 'telnet.h'
then
echo shar: will not over-write existing file "'telnet.h'"
else
cat << \SHAR_EOF > 'telnet.h'
sub IAC {255;}
sub DONT {254;}
sub DO {253;}
sub WONT {252;}
sub WILL {251;}
sub SB {250;}
sub GA {249;}
sub EL {248;}
sub EC {247;}
sub AYT {246;}
sub AO {245;}
sub IP {244;}
sub BREAK {243;}
sub DM {242;}
sub NOP {241;}
sub SE {240;}
sub EOR {239;}
sub SYNCH {242;}
if (defined &TELCMDS) {
}
sub TELOPT_BINARY {0;}
sub TELOPT_ECHO {1;}
sub TELOPT_RCP {2;}
sub TELOPT_SGA {3;}
sub TELOPT_NAMS {4;}
sub TELOPT_STATUS {5;}
sub TELOPT_TM {6;}
sub TELOPT_RCTE {7;}
sub TELOPT_NAOL {8;}
sub TELOPT_NAOP {9;}
sub TELOPT_NAOCRD {10;}
sub TELOPT_NAOHTS {11;}
sub TELOPT_NAOHTD {12;}
sub TELOPT_NAOFFD {13;}
sub TELOPT_NAOVTS {14;}
sub TELOPT_NAOVTD {15;}
sub TELOPT_NAOLFD {16;}
sub TELOPT_XASCII {17;}
sub TELOPT_LOGOUT {18;}
sub TELOPT_BM {19;}
sub TELOPT_DET {20;}
sub TELOPT_SUPDUP {21;}
sub TELOPT_SUPDUPOUTPUT {22;}
sub TELOPT_SNDLOC {23;}
sub TELOPT_TTYPE {24;}
sub TELOPT_EOR {25;}
sub TELOPT_TUID {26;}
sub TELOPT_OUTMRK {27;}
sub TELOPT_TTYLOC {28;}
sub TELOPT_3270REGIME {29;}
sub TELOPT_X3PAD {30;}
sub TELOPT_NAWS {31;}
sub TELOPT_TSPEED {32;}
sub TELOPT_LFLOW {33;}
sub TELOPT_EXOPL {255;}
if (defined &TELOPTS) {
eval 'sub NTELOPTS {(1+&TELOPT_LFLOW);}';
}
sub TELQUAL_IS {0;}
sub TELQUAL_SEND {1;}
1;
SHAR_EOF
chmod +x 'telnet.h'
fi # end of overwriting check
if test -f 'getopts.pl'
then
echo shar: will not over-write existing file "'getopts.pl'"
else
cat << \SHAR_EOF > 'getopts.pl'
;# getopts.pl - a better getopt.pl
;# Usage:
;# do Getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a
;# # side effect.
sub Getopts {
local($argumentative) = @_;
local(@args,$_,$first,$rest,$errs);
local($[) = 0;
@args = split( / */, $argumentative );
while(($_ = $ARGV[0]) =~ /^-(.)(.*)/) {
($first,$rest) = ($1,$2);
$pos = index($argumentative,$first);
if($pos >= $[) {
if($args[$pos+1] eq ':') {
shift(@ARGV);
if($rest eq '') {
$rest = shift(@ARGV);
}
eval "\$opt_$first = \$rest;";
}
else {
eval "\$opt_$first = 1";
if($rest eq '') {
shift(@ARGV);
}
else {
$ARGV[0] = "-$rest";
}
}
}
else {
print STDERR "Unknown option: $first\n";
++$errs;
if($rest ne '') {
$ARGV[0] = "-$rest";
}
else {
shift(@ARGV);
}
}
}
$errs == 0;
}
1;
SHAR_EOF
chmod +x 'getopts.pl'
fi # end of overwriting check
if test -f 'cbreak2.pl'
then
echo shar: will not over-write existing file "'cbreak2.pl'"
else
cat << \SHAR_EOF > 'cbreak2.pl'
$sgttyb_t = 'C4 S';
sub cbreak {
&set_cbreak(1);
}
sub cooked {
&set_cbreak(0);
}
sub set_cbreak {
local($on) = @_;
do 'sys/ioctl.pl' || die "Can't do sys/ioctl.pl. Stopped";
ioctl(STDIN,$TIOCGETP,$sgttyb)
|| die "Can't ioctl TIOCGETP: $!";
@ary = unpack($sgttyb_t,$sgttyb);
if ($on) {
$ary[4] |= $CBREAK;
$ary[4] &= ~$ECHO;
} else {
$ary[4] &= ~$CBREAK;
$ary[4] |= $ECHO;
}
$sgttyb = pack($sgttyb_t,@ary);
ioctl(STDIN,$TIOCSETP,$sgttyb)
|| die "Can't ioctl TIOCSETP: $!";
}
1;
SHAR_EOF
chmod +x 'cbreak2.pl'
fi # end of overwriting check
if test -f 'time.h'
then
echo shar: will not over-write existing file "'time.h'"
else
cat << \SHAR_EOF > 'time.h'
if (!defined &_TIME_) {
eval 'sub _TIME_ {1;}';
eval 'sub DST_NONE {0;}';
eval 'sub DST_USA {1;}';
eval 'sub DST_AUST {2;}';
eval 'sub DST_WET {3;}';
eval 'sub DST_MET {4;}';
eval 'sub DST_EET {5;}';
eval 'sub DST_CAN {6;}';
eval 'sub DST_GB {7;}';
eval 'sub DST_RUM {8;}';
eval 'sub DST_TUR {9;}';
eval 'sub DST_AUSTALT {10;}';
eval 'sub timerisset {
local($tvp) = @_;
eval "(($tvp)->&tv_sec || ($tvp)->&tv_usec)";
}';
eval 'sub timercmp {
local($tvp, $uvp, $cmp) = @_;
eval "(($tvp)->&tv_sec $cmp ($uvp)->&tv_sec || ($tvp)->&tv_sec == ($uvp)->&tv_sec && ($tvp)->&tv_usec $cmp ($uvp)->&tv_usec)";
}';
eval 'sub timerclear {
local($tvp) = @_;
eval "($tvp)->&tv_sec = ($tvp)->&tv_usec = 0";
}';
eval 'sub ITIMER_REAL {0;}';
eval 'sub ITIMER_VIRTUAL {1;}';
eval 'sub ITIMER_PROF {2;}';
if (!defined &KERNEL) {
do 'time.h' || die "Can't include time.h: $!";
}
}
1;
SHAR_EOF
fi # end of overwriting check
if test -f 'errno.ph'
then
echo shar: will not over-write existing file "'errno.ph'"
else
cat << \SHAR_EOF > 'errno.ph'
sub EPERM {1;}
sub ENOENT {2;}
sub ESRCH {3;}
sub EINTR {4;}
sub EIO {5;}
sub ENXIO {6;}
sub E2BIG {7;}
sub ENOEXEC {8;}
sub EBADF {9;}
sub ECHILD {10;}
sub EAGAIN {11;}
sub ENOMEM {12;}
sub EACCES {13;}
sub EFAULT {14;}
sub ENOTBLK {15;}
sub EBUSY {16;}
sub EEXIST {17;}
sub EXDEV {18;}
sub ENODEV {19;}
sub ENOTDIR {20;}
sub EISDIR {21;}
sub EINVAL {22;}
sub ENFILE {23;}
sub EMFILE {24;}
sub ENOTTY {25;}
sub ETXTBSY {26;}
sub EFBIG {27;}
sub ENOSPC {28;}
sub ESPIPE {29;}
sub EROFS {30;}
sub EMLINK {31;}
sub EPIPE {32;}
sub EDOM {33;}
sub ERANGE {34;}
sub EWOULDBLOCK {35;}
sub EINPROGRESS {36;}
sub EALREADY {37;}
sub ENOTSOCK {38;}
sub EDESTADDRREQ {39;}
sub EMSGSIZE {40;}
sub EPROTOTYPE {41;}
sub ENOPROTOOPT {42;}
sub EPROTONOSUPPORT {43;}
sub ESOCKTNOSUPPORT {44;}
sub EOPNOTSUPP {45;}
sub EPFNOSUPPORT {46;}
sub EAFNOSUPPORT {47;}
sub EADDRINUSE {48;}
sub EADDRNOTAVAIL {49;}
sub ENETDOWN {50;}
sub ENETUNREACH {51;}
sub ENETRESET {52;}
sub ECONNABORTED {53;}
sub ECONNRESET {54;}
sub ENOBUFS {55;}
sub EISCONN {56;}
sub ENOTCONN {57;}
sub ESHUTDOWN {58;}
sub ETOOMANYREFS {59;}
sub ETIMEDOUT {60;}
sub ECONNREFUSED {61;}
sub ELOOP {62;}
sub ENAMETOOLONG {63;}
sub EHOSTDOWN {64;}
sub EHOSTUNREACH {65;}
sub ENOTEMPTY {66;}
sub EPROCLIM {67;}
sub EUSERS {68;}
sub EDQUOT {69;}
sub ESTALE {70;}
sub EREMOTE {71;}
sub ENOSTR {72;}
sub ETIME {73;}
sub ENOSR {74;}
sub ENOMSG {75;}
sub EBADMSG {76;}
sub EIDRM {77;}
sub EDEADLK {78;}
sub ENOLCK {79;}
sub ENONET {80;}
sub ERREMOTE {81;}
sub ENOLINK {82;}
sub EADV {83;}
sub ESRMNT {84;}
sub ECOMM {85;}
sub EPROTO {86;}
sub EMULTIHOP {87;}
sub EDOTDOT {88;}
sub EREMCHG {89;}
1;
SHAR_EOF
fi # end of overwriting check
cd ..
# End of shell archive
exit 0