yukngo@obelix.gaul.csd.uwo.ca (Cheung Yukngo) (05/31/90)
When I started learning perl, I wrote two simple programs. One is a perl version of wc. The other one is a perl version of a local utility progeam called dir. Then I wrote pwebs, which is posted yesterday. But it is a simple protocol. So I decided to write a perl version of ftp. Which is tedious compared to webster. The Berkeley version of ftp is perfectly fine. I just needed the practice. I have also added a few useful (my opinion) features. This is the second version of the ftp program. It is not elegant, I am afraid; but it does the job. The command parsing loop is especially ugly. Be warned there are bugs in the program. Especially in readline.pl which I used 3 hours to finish the first phase and still don't feel like debugging and redesigning. Use -s every time, like me. When you use the program, be sure readline.pl, resolver.pl and pathname.pl are in the perl library directory. Be sure you have makelib telnet.h. There is a version ioctl.pl hat comes with the source. cbreak2.pl comes with the sources too. The pns program mentioned in nftp.doc has been posted last week here. Please send bug reports/comments/diffs/improvements to me. Khun Yee clipper@csd.uwo.ca #! /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 # nftp.doc # pathname.pl # readline.pl # resolver.pl # if test -f 'nftp' then echo shar: will not over-write existing file "'nftp'" else echo x - 'nftp' sed 's/^X//' >'nftp' << 'SHAR_EOF' X#!/u3/thesis/clipper/pl/perl X# A simple ftp client in perl. X# Copyright 1990 Khun Yee Fung (clipper@csd.uwo.ca) X# see the end of this program for warranty information X# $Id: nftp,v 1.15 90/05/23 20:14:43 clipper Exp Locker: clipper $ X# $Source: /u3/thesis/clipper/pl/RCS/nftp,v $ X X$DATA = 1; X$SUCCESS = 2; X$CONTINUE = 3; X$ERROR = 4; X$FAIL = 5; X@marks = ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9'); X$NOCR = 1; X Xdo 'sys/socket.h' || die "can\'t do sys/socket.h: $@"; Xdo 'sys/ioctl.pl' || die "Can't do sys/ioctl.pl: $@"; Xdo 'telnet.h' || die "can\'t do telnet.h: $@"; Xdo 'pathname.pl' || die "can\'t do pathname.pl: $@"; Xdo 'getopts.pl' || die "can\'t do getopts.pl: $@"; Xdo 'cbreak2.pl' || die "can't do cbreak2.pl: $@"; Xdo 'resolver.pl' || die "Can't do resolver.pl: $@"; Xdo Getopts('h:as'); X$background = 0; Xif ($#ARGV < $[) { X if (defined($opt_s)) { X $noread = 1; X } X else { X do 'termcap.pl' || die "Can't do termcap.pl: $@"; X do 'readline.pl' || die "Can't do readline.pl: $@"; X } X $interactive = 1; X} Xelsif (defined($opt_s)) { X print "-s option ignored for non-interactive ftp\n"; X} X X@prog = split("/", $0); X$sockaddr = 'S n a4 C8'; X$connecting = 0; Xif (defined($opt_h)) { X do connect($opt_h); X} Xif ($interactive && !$noread) { X do prep_terminal(); X} Xif ($interactive) { X $pwd = $ENV{'PWD'}; X $prompt = $pwd; X $prompt =~ s|$ENV{'HOME'}|~|; X} X$SIG{'INT'} = 'again'; Xwhile ($in = &getinput(":$prompt> ")) { X $in =~ s/^\s+//g; X $in =~ s/\s+/ /g; X $in =~ s/\s+$//g; X next if ($in eq ""); X study($in); X $in =~ /^LMKDIR (.+)/i && ((do domkdir($1)), next); X $in =~ /^RM (.+)/i && ((do rm($1)), next); X $in =~ /^LCD (.+)/i && ((do dochdir($1)), next); X $in =~ /^LCD/i && ((do dochdir("")), next); X $in =~ /^QUIT/i && do doquit($1); X $in =~ /^HISTORY/i && !$noread && (do printhistory(), next); X $in =~ /^OPEN (.+)/i && !$connecting && (do connect($1), next); X if (!$background) { X $in =~ /^BACK (.+)/i && (do background($1), next); X $in =~ /^BACK/i && (do background(), next); X } X if (!$connecting) { X print "Not connecting\n"; X next; X } X $in =~ /^MPUT (.+)/i && (do mput($1), next); X $in =~ /^NLST (.+)/i && (do scheme2("NLST", undef, $1), next); X $in =~ /^OPEN/i && ((print "Connected. Use close first\n"), next); X $in =~ /^LS (.+)/i && (do scheme2("LIST", undef, $1), next); X $in =~ /^LS/i && (do scheme2("LIST", undef), next); X $in =~ /^CD (.+)/i && (do scheme1("CWD", $1), next); X $in =~ /^CD/i && (do scheme1("CWD"), next); X $in =~ /^TYPE (.)/i && (do scheme1("TYPE", $1), next); X $in =~ /^GET ([^ \n]+) ([^ \n]+)/i && (do scheme2("RETR", ">$2", $1), next); X $in =~ /^GET (.+)/i && (do scheme2("RETR", ">$1", $1), next); X $in =~ /^PUT ([^ \n]+) ([^ \n]+)/i && (do scheme2("STOR", $1, $2), next); X $in =~ /^PUT ([^ \n]+)/i && (do scheme2("STOR", $1, $1), next); X $in =~ /^REGET (.+)/i && (do restoffile($1), next); X $in =~ /^MGET (.+)/i && (do mget($1), next); X $in =~ /^LOGIN (.+) (.+)/i && (do ilogin($1, $2, ""), next); X $in =~ /^LOGIN/i && (do ilogin(), next); X $in =~ /^CDUP/i && (do scheme1("CDUP"), next); X $in =~ /^CLOSE/i && (do scheme1("QUIT"), $connecting = 0, $NOCR = 1, next); X $in =~ /^RENAME (.+) (.+)/i && (do rename($1, $2), next); X $in =~ /^DEL ([^ \n]+)/i && (do scheme1("DELE", $1), next); X $in =~ /^RMDIR ([^ \n]+)/i && (do scheme1("RMD"), next); X $in =~ /^MKDIR ([^ \n]+)/i && (do scheme1("MKD", $1), next); X $in =~ /^PWD/i && (do scheme1("PWD"), next); X $in =~ /^SYST/i && (do scheme1("SYST"), next); X $in =~ /^STATUS/i && (do scheme1("STAT"), next); X $in =~ /^HELP/i && (do scheme1("HELP"), next); X $in =~ /^NOOP/i && (do scheme1("NOOP"), next); X $in =~ /^BINARY/i && (do scheme1("TYPE", "I"), $NOCR = 0, next); X $in =~ /^ASCII/i && (do scheme1("TYPE", "A"), $NOCR = 1, next); X $in =~ /^TENEX/i && (do scheme1("TYPE", "L", "8"), $NOCR = 1, next); X $in =~ /^BACK/i && (do background(), next); X if (!$interactive) { X print "Unrecognised Command: $in\n"; X do scheme1("QUIT"); X exit(255); X } X print "Unrecognised command: Pass directly to the server (y/n)? "; X $answer = <STDIN>; X if ($answer =~ /^[yY]/) { X @command = split(' ', $in); X do scheme1(@command); X } X} Xcontinue { X if ($interactive || $noread) { X $prompt = $pwd; X $prompt =~ s|$ENV{'HOME'}|~|; X } X} Xif ($connecting) { X do scheme("QUIT"); X} X&getreply(); Xclose SERVER; X Xsub getreply { X local($code); X local($answer); X $answer = <SERVER> || ((print "Lost connection\n"), close SERVER, X $connecting = 0, return $FAIL); X $answer =~ s/\r//g; X local($reply) = $answer; X while ($reply ne "") { X if ($reply =~ /^\d\d\d\-/) { X print $reply; X while ($reply = <SERVER>) { X $reply =~ s/\r//g; X $answer = $reply; X if ($reply =~ /^\d\d\d/) { last; } X print $reply; X } X } X ($reply =~ /^1/) && ($code = $DATA, last); X ($reply =~ /^2/) && ($code = $SUCCESS, last); X ($reply =~ /^3/) && ($code = $CONTINUE, last); X ($reply =~ /^4/) && ($code = $ERROR, last); X ($reply =~ /^5/) && ($code = $FAIL, last); X ($reply =~ /^&IAC&WILL(.)/) && ((print SERVER "&IAC&WONT$1"), $reply = $'); X ($reply =~ /^&IAC&DO(.)/) && ((print SERVER "&IAC&DONT$1"), $reply = $'); X $answer = "ERROR: $answer"; $code = $ERROR; X } X print $answer; X $code; X} X X Xsub scheme1 { X local($command) = $_[0]; X for ($index = 1; $index <= $#_; $index++){ X $command .= " " . $_[$index]; X } X print " $command\n"; X print SERVER $command, "\r\n"; X $code = &getreply(); X} X Xsub scheme2 { X local($command) = $_[0]; X local($hfile) = defined($_[1]); X local($file) = $_[1]; X local($index) = 2; X local($read) = !defined($_[1]) || $file =~ /^>/; X local($code) = &setup(); X local($numhash) = 0; X local($buf); X if ($code != 2) { return; } X for ($index = 2; $index <= $#_; $index++) { X $command .= " " . $_[$index]; X } X print " $command\n"; X print SERVER $command, "\r\n"; X $code = &getreply(); X if ($code != 1) { return; } X ($addr = accept(DATA1, DATA)) || ((print "accept:$!\n"), return); X if ($hfile) { X open(FILE, $file) || ((print "open:$!\n"), close(DATA1), return); X select(FILE); $| = 1; select(STDOUT); $| = 1; X $bytes = 0; $hash = 0; $numhash = 0; X } X elsif (! $read) { X close(DATA1); X return; X } X if ($read) { X $SIG{'INT'} = 'abort'; X while (read(DATA1, $buf, 1000) > 0) { X $buf =~ s/\r//g if ($NOCR); X if ($hfile) { X print FILE $buf; X if ($interactive) { X $bytes += length($buf); X if ($bytes > 1000) { X ($hash == 9) ? $hash = 0 : $hash++; X print $marks[$hash]; X $bytes -= 1000; X $numhash++; X if ($numhash > 69) { X print "\n"; X $numhash = 0; X } X } X } X } X else { X print $buf; X } X } X $SIG{'INT'} = 'again'; X if ($hfile) { X if ($interactive || $noread) { X print "\n"; X } X close FILE; X } X } X else { X $SIG{'INT'} = 'abort'; X $bytes = 0; X while (read(FILE, $buf, 1000) > 0) { X if ($interactive || $noread) { X $bytes += length($buf); X if ($bytes > 1000) { X print '%'; X $bytes -= 1000; X if ($numhash++ > 70) { X print "\n"; X $numhash = 0; X } X } X } X print DATA1 $buf; X } X if ($interactive || $noread) { X print "\n"; X } X $SIG{'INT'} = 'again'; X } X close DATA1; X $code = &getreply(); X} X Xsub rename { X local($from, $to) = @_; X local($code); X X print " RNFR $from\n"; X print SERVER "RNFR $from\r\n"; X $code = &getreply(); X if ($code != 3) { return; } X print " RNTO $to\n"; X print SERVER "RNTO $to\r\n"; X $code = &getreply(); X} X Xsub restoffile { X local($code); X local(@size) = stat($_[0]); X X print " REST $size[7]\n"; X print SERVER "REST ", $size[7], "\r\n"; X $code = &getreply(); X if ($code != 3) { return; } X do scheme2("RETR", ">>$_[0]", $_[0]); X} X Xsub ilogin { X if (defined($opt_a)) { X print "Ah, but you specified -a option.\n"; X } X else { X &login (@_); X } X} X Xsub login { X local($user, $pass, $acct) = @_; X local($code); X X if (! defined($_[0])) { X print "login:"; X $user = <>; X chop($user); X } X print " USER $user\n"; X print SERVER "USER ", $user, "\r\n"; X $code = &getreply(); X if ($code == 2) { $connecting = 1; $NOCR = 1; return; } X if ($code != 3) { return; } X $NOCR = 1; X if (! defined($_[1])) { X do set_cbreak(1); X print "Password:"; X $pass = <>; X do set_cbreak(0); X print "\n"; X chop($pass); X } X print " PASS\n"; X print SERVER "PASS ", $pass, "\r\n"; X $code = &getreply(); X if ($code == 2) { $connecting = 1; return; } X if ($code != 3) { return; } X X print " ACCT\n"; X print SERVER "ACCT ", $acct, "\r\n"; X $code = &getreply(); X if ($code == 2) { $connecting = 1; return; } X do login($user, $pass); X} X Xsub setup { X socket(DATA, &PF_INET, &SOCK_STREAM, 0) || ((print "socket:$!\n"), return 0); X $sockname = getsockname(SERVER) || ((print "getsockname:$!\n"), return 0); X ($family, $port, $addr) = unpack($sockaddr, $sockname); X @port = unpack("CC", $port); X $sout = pack($sockaddr, &AF_INET, 0, $addr); X bind(DATA, $sout) || ((print "bind:$!\n"), return $FAIL); X listen(DATA, 1) || ((print "listen:$!\n"), return $FAIL); X $sockname = getsockname(DATA) || ((print "getsockname:$!\n"), return $FAIL); X ($family, $port, $addr) = unpack($sockaddr, $sockname); X $port[0] = int($port / 256); X $port[1] = $port % 256; X print "PORT $addr[0],$addr[1],$addr[2],$addr[3],$port[0],$port[1]\n"; X print SERVER "PORT $addr[0],$addr[1],$addr[2],$addr[3],$port[0],$port[1]\r\n"; X &getreply(); X} X Xsub connect { X $port = 21; X if ($_[0] =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/) { X $saddr = pack("CCCC", $1, $2, $3, $4); X } X elsif (!(($name, $aliases, $type, $len, $saddr) = gethostbyname($_[0]))) { X $saddr = &resolver($_[0]) || ((print "No such host\n"), return); X } X $sin = pack($sockaddr, 2, $port, $saddr); X X socket(SERVER, 2, 1, 0) || ((print "socket:$!\n"), return $FAIL); X connect(SERVER, $sin) || ((print "connect:$!\n"), return $FAIL); X $sockname = getsockname(SERVER) || ((print "getsockname:$!\n"), return $FAIL); X ($family, $port, $addr) = unpack($sockaddr, $sockname); X @addr = unpack("CCCC", $addr); X X select(SERVER); $| = 1; select(STDOUT); $| = 1; X $connecting = 1; X &getreply(); X if ($opt_a) { X do login("ftp", "guest"); X } X} X Xsub domkdir { X mkdir($_[0], 0700) || ((print "lmkdir: $!\n"), return); X print "created: $_[0]\n"; X} X Xsub rm { X unlink($_[0]); X} X Xsub dochdir { X local($path2) = $_[0]; X if ($path2 eq "~") { X $path2 = $ENV{'HOME'}; X } X if ($path2 =~ m|^~([^/]*)|) { X if ($1 eq "") { X $path2 = $ENV{'HOME'} . $'; X } X else { X @ent = getpwnam($1); X $path2 = $ent[7] . $'; X } X } X if ($path2 eq "") { X $path2 = $ENV{'HOME'}; X } X chdir $path2 || ((print "lcd: $!\n"), next); X $pwd = &pathname($pwd, $path2); X} X Xsub doquit { X if ($connecting) { X do scheme1("QUIT"); X unlink ("/tmp/nftp$$"); X close SERVER; X } X print "<End of nftp session>\n"; X close STDOUT; X exit 0; X} X Xsub abort { X printf SERVER pack("CC", &IAC, &IP); X send(SERVER, pack("C", &IAC), 1, &MSG_OOB); X printf SERVER pack("%C", &DM); X do scheme1("ABOR"); X close DATA1; X $inter = 1; X $SIG{'INT'} = 'again'; X} X Xsub again { X $in = ""; X print "\n"; X} X Xsub mget { X do scheme2("NLST", ">/tmp/nftp$$", $_[0]); X open(NLIST, "/tmp/nftp$$"); X $inter = 0; X $reg = $_[0]; X $reg =~ s/\?/./g; X $reg =~ s/([^\\]*)([\*\+])/\1.\2/g; X while ($name = <NLIST>) { X chop($name); X $name =~ /$reg/ && do scheme2("RETR", ">$name", "$name"); X if ($inter) { X print "Continue with mget? "; X $c = <STDIN>; X if ($c =~ /^[yY]/) { X $inter = 0; X next; X } X else { X last; X } X } X } X unlink("/tmp/nftp$$"); X} X Xsub mput { X local($names) = $_[0]; X local($_, @file); X while (<${names}>) { X if ($inter) { X print "Continue with mget? "; X $c = <STDIN>; X if ($c =~ /^[yY]/) { X $inter = 0; X next; X } X else { X last; X } X } X @file = split('/', $_); X do scheme2("STOR", $_, $file[$#file]); X } X} X Xsub getinput { X if ($interactive) { X if ($noread) { X print $_[0]; X if ($_ = <>) { X $_; X } X else { X "quit"; X } X } X else { X &readline($_[0]); X } X } X elsif ($background) { X if ($_ = <STDIN>) { X $_; X } X else { X "quit"; X } X } X elsif ($_ = <>) { X $_; X } X else { X "quit"; X } X} X Xsub background { X $background = 1; X $interactive = 0; X $noread = 0; X open (COMM, ">/tmp/nftpback$$"); X print "Input commands. Finish by a single dot on the line.\n"; X print "> "; X $comm = <STDIN>; X while ($comm !~ /^\.$/) { X print COMM $comm; X } X continue { X print "> "; X $comm = <STDIN>; X } X close(COMM); X open(STDIN, "/tmp/nftpback$$"); X if (defined($_[0])) { X $file = "$_[0]"; X } X else { X $file = "/tmp/nftpback$$.stdout"; X } X if ($child = fork()) { X print "[nftp log file: $file process: $child]\n"; X exit(0); X } X $SIG{'HUP'} = 'IGNORE'; X open(STDOUT, ">$file"); X open(TTY, '/dev/tty'); X ioctl(TTY, $TIOCNOTTY, 0); X close(TTY); X} X X# Copyright 1990 Khun Yee Fung <clipper@csd.uwo.ca> X# X# Permission to use, copy, modify, and distribute, this software and its X# documentation for any purpose is hereby granted without fee, provided that X# the above copyright notice appear in all copies and that both that X# copyright notice and this permission notice appear in supporting X# documentation, and that the name of the copyright holders be used in X# advertising or publicity pertaining to distribution of the software with X# specific, written prior permission, and that no fee is charged for further X# distribution of this software, or any modifications thereof. The copyright X# holder make no representations about the suitability of this software for X# any purpose. It is provided "as is" without express or implied warranty. X# X# THE COPYRIGHT HOLDER DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, X# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO X# EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY SPECIAL, INDIRECT OR X# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, X# DATA, PROFITS, QPA OR GPA, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE X# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR X# PERFORMANCE OF THIS SOFTWARE. SHAR_EOF if test 14577 -ne "`wc -c < 'nftp'`" then echo shar: error transmitting "'nftp'" '(should have been 14577 characters)' fi fi if test -f 'nftp.doc' then echo shar: will not over-write existing file "'nftp.doc'" else echo x - 'nftp.doc' sed 's/^X//' >'nftp.doc' << 'SHAR_EOF' X# Copyright 1990 Khun Yee Fung <clipper@csd.uwo.ca> X# X# Permission to use, copy, modify, and distribute, this software and its X# documentation for any purpose is hereby granted without fee, provided that X# the above copyright notice appear in all copies and that both that X# copyright notice and this permission notice appear in supporting X# documentation, and that the name of the copyright holders be used in X# advertising or publicity pertaining to distribution of the software with X# specific, written prior permission, and that no fee is charged for further X# distribution of this software, or any modifications thereof. The copyright X# holder make no representations about the suitability of this software for X# any purpose. It is provided "as is" without express or implied warranty. X# X# THE COPYRIGHT HOLDER DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, X# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO X# EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY SPECIAL, INDIRECT OR X# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, X# DATA, PROFITS, QPA OR GPA, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE X# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR X# PERFORMANCE OF THIS SOFTWARE. X Xnftp [-a] [-s] [-h hostname] [filename] X Xnftp is a ftp client written in perl. Notice that not much error Xchecking is done. You are on your own in terms of what commands need Xwhat parameters. X XHere is the list of command line options: X X-h specify which host to be connected to. X X-a automatic anonymous login requested X X-s to request simple terminal handling X XYou can specify a filename and nftp will take each line of that file Xto be a nftp command. Using a command file can be very convenient, for Xexample, to use crontab to get a file at a particular time. Simply Xpipe the output to a file and you can check the file transfer later Xon. For example, you have a file containing commands, called command, Xand you want to put the logging information in nftp.log: X Xnftp command > nftp.log& X XThe default terminal handling facilities of nftp is quite sophiscated. XMany of the emacs-style editing functions are available. But be warned Xthat there are bugs in the terminal handling package and nftp is a bit Xslow getting set up if the default terminal handling is used. the Xoption -s sould be used if the default unix terminal handling is Xdesired. X XIf -a is specified, nftp will login as an anonymous user everytime a Xconnection is needed. This is useful if you use nftp for getting Xsoftware from anonymous ftp sites. X XTo specify an initial host, use -h option. The hostname does not have Xto be in the local host table. nftp comes with a simple Xhostname-to-IP-address resolver builtin. If you still have problem Xgetting your host connected, you can try the pns program posted Xearlier. You can use the following command to find the IP-address: X Xpns -a hostname X XHere is the list of commands available in nftp: X Xlmkdir dirname X create directory dirname Xrm filename X delete filename from the local machine. Xlcd [dirname] X change directory to dirname, if dirname is absent, change to X home directory. Xquit X disconnect any connection and exit nftp Xhistory X show the history list. For the default terminal handling only. Xopen hostname X open a connection. hostname can be an ip-address (e.g. X 129.100.11.2) or a domain name (e.g. odin.gaul.csd.uwo.ca). Xmput regexp X multiple put filenames matching regexp to the remote machine. Xnlst regexp X a short list of remote files matching regexp Xls [options] [regexp] X same usage as the unix ls Xcd [dirname] X similar to unix /bin/sh cd Xtype [I|A|L] X set the file type. Use binary, ascii, tenex instead. Xget filename [lfilename] X get filename from the remote machine and call it lfilename. Xput filename [rfilename] X put filename to remote machine using rfilename as the remote X filename. Xreget filename X continue file transfer terminated last time. Must be in the X same directory as the file. Xmget regexp X get all remote files matching regexp Xlogin [username password] X login as username with password password. If username and X password are absent, they will be asked. Password entered this X way cannot be seen on screen. Xcdup X same as 'cd ..' in unix machines. Xclose X close a connection Xrename old new X rename remote file from old to new Xdel file X delete remote file called file Xrmdir dirname X delete remote directory dirname Xmkdir dirname X create remote directory and call it dirname Xpwd X print current working directory Xsyst X print remote machine information Xstatus X print file transfile status Xhelp X print remote help Xnoop X no operation. Xbinary X set file type to binary. Xascii X set file type to ascii Xtenex X set file type TOP20 type Xback [filename] X set background. This is a covenient feature of nftp. X Sometimes, when you have decided to get a file, you don't want X to wait for it. But since you are using an interactive nftp, X you can't just leave and set the process in background. This X command and get the file for you quietly in the background. To X use it, type 'back'when a command is expected. nftp will X prompt you for commands to be done. Type in the commands, and X then nftp will take itself to background. Look at the example: X X uwocsd-~/_thesis [18:25] > nftp -s -a -h tut.cis.ohio-state.edu X 220 tut.cis.ohio-state.edu FTP server (Version 5.49 Tue May 9 14:01:04 EDT 1989) ready. X USER ftp X 331 Guest login ok, send ident as password. X PASS X 230 Guest login ok, access restrictions apply. X :~/_thesis> cd pub X CWD pub X 250 CWD command successful. X :~/_thesis> cd gnu X CWD gnu X 250 CWD command successful. X :~/_thesis> ls X PORT 129,100,10,254,15,152 X 200 PORT command successful. X LIST X 150 Opening ASCII mode data connection for /bin/ls. X total 162 X -rw-rw-r-- 1 482 10 30798 Apr 20 14:24 GNU.how-to-get X drwxrwxr-x 2 482 10 2048 Nov 20 08:56 awk X drwxrwxr-x 2 482 10 2048 Mar 23 15:41 bash X drwxrwxr-x 2 482 root 2048 Nov 27 12:26 binutils X drwxrwxr-x 2 482 10 2048 Oct 2 1989 bison X -rw-rw-r-- 1 482 10 1151 Mar 1 1989 bsplit.c X -rw-rw-r-- 1 482 root 22057 Jul 5 1988 button.2.00.shar X -rw-rw-r-- 1 482 10 27873 Feb 16 1989 button.3.00.shar X -rw-rw-r-- 1 482 root 6107 Feb 25 1988 button88.02.ps X drwxrwxr-x 2 482 10 2048 Aug 31 1989 c-torture-test X drwxrwxr-x 3 482 root 2048 Jan 2 14:06 chess X drwxr-xr-x 2 320 10 2048 Feb 8 09:19 cvs X drwxrwxr-x 2 482 root 2048 Jul 5 1989 diff X drwxrwxr-x 9 482 10 2048 Apr 4 08:58 emacs X drwxr-xr-x 2 482 10 2048 Apr 20 14:21 fileutils X drwxrwxr-x 2 482 10 2048 Jul 20 1989 flex X drwxrwxr-x 3 482 10 2048 Mar 3 21:36 g++ X drwxrwxr-x 2 482 10 2048 Mar 14 09:02 gas X drwxrwxr-x 4 482 10 4096 Feb 13 21:26 gcc X drwxrwxr-x 3 482 10 2048 Feb 8 08:35 gdb X drwxrwxr-x 2 482 10 2048 May 9 22:30 gdbm X drwxrwxr-x 2 482 root 2048 Oct 15 1989 ghostscript X drwxrwxr-x 2 482 10 2048 Apr 12 1989 gnews X drwxrwxr-x 2 482 10 2048 Sep 8 1989 gnuplot X drwxrwxr-x 2 482 10 2048 Apr 19 15:59 gnus X drwxrwxr-x 2 482 10 2048 Jun 2 1989 go X drwxrwxr-x 2 482 10 2048 Nov 3 1989 gperf X drwxrwxr-x 2 482 root 2048 Apr 17 1989 grep X drwxrwxr-x 2 482 10 2048 Sep 14 1989 indent X drwxrwxr-x 2 482 10 2048 Apr 23 10:02 ispell X drwxrwxr-x 4 482 root 2048 Aug 18 1989 lisp-manual X drwxrwxr-x 3 482 10 2048 Feb 9 23:22 make X drwxrwxr-x 2 482 10 2048 Dec 5 13:57 oops X drwxrwxr-x 2 482 10 2048 Jul 16 1989 plot2ps X drwxrwxr-x 2 482 10 2048 Jan 31 08:44 protoize X drwxrwxr-x 2 482 10 2048 Jul 5 1989 sed X drwxr-xr-x 2 482 10 2048 Apr 2 16:17 smalltalk X drwxrwxr-x 2 482 10 2048 Jul 5 1989 tar X drwxrwxr-x 2 482 10 2048 Jan 18 21:51 texi2roff X drwxrwxr-x 2 482 10 2048 Sep 27 1989 vm X 226 Transfer complete. X :~/_thesis> back log X Input commands. Finish by a single dot on the line. X > get GNU.how-to-get X > close X > quit X > . X [nftp log file: log process: 7304] X You have mail in /usr/spool/mail/clipper X uwocsd-~/_thesis [18:26] > X XAs you can see, nftp leaves a message saying that the log file is Xcalled log and the process number of itself is 7304. The name of the Xlogfile will be selected by nftp if it is not specified. Since the Xname of the log file can be very ugle and in directory /tmp, choose Xyour own name. X X XAny comments and suggestions are welcome. X XKhun Yee X1990 May SHAR_EOF if test 8897 -ne "`wc -c < 'nftp.doc'`" then echo shar: error transmitting "'nftp.doc'" '(should have been 8897 characters)' fi fi if test -f 'pathname.pl' then echo shar: will not over-write existing file "'pathname.pl'" else echo x - 'pathname.pl' sed 's/^X//' >'pathname.pl' << 'SHAR_EOF' X#!/u3/thesis/clipper/pl/perl X# A simple subroutine to get the absolute path when two paths are X# merged. Written by Khun Yee Fung (clipper@csd.uwo.ca) X# Copyright 1990 Khun Yee Fung X# See the end of the program for warranty information X Xsub pathname { X local($path1) = $_[0]; X local($path2) = $_[1]; X local($arg, @path); X local($num) = 0; X X if ($path2 eq /^~/) { X $path2 = $ENV{'HOME'} . $path2; X } X if ($path2 =~ m|^~([^/]*)|) { X if ($1 == "") { X $path2 = $ENV{'HOME'} . $path2; X } X else { X @ent = getpwnam($1) || (@ent = ("")); X $path2 = $ent[7] . $path2; X } X } X if ($path2 !~ m|^/|) { X $path2 = $path1 . "/" . $path2; X } X local(@paths) = split(m|/|, $path2); X foreach $arg (@paths) { X ($arg =~ /^\.\.$/) && ($num--, next); X ($arg =~ /^\.$/) && next; X ($arg eq "") && next; X $path[$num] = $arg; X $num++; X } X $#path = $num - 1; X $path1 = ""; X foreach $arg (@path) { X $path1 = $path1 . $arg . "/"; X } X chop($path1); X $path1 = "/" . $path1 if ($path1 !~ "^/"); X $path1; X} X1; X X# Copyright 1990 Khun Yee Fung <clipper@csd.uwo.ca> X# X# Permission to use, copy, modify, and distribute, this software and its X# documentation for any purpose is hereby granted without fee, provided that X# the above copyright notice appear in all copies and that both that X# copyright notice and this permission notice appear in supporting X# documentation, and that the name of the copyright holders be used in X# advertising or publicity pertaining to distribution of the software with X# specific, written prior permission, and that no fee is charged for further X# distribution of this software, or any modifications thereof. The copyright X# holder make no representations about the suitability of this software for X# any purpose. It is provided "as is" without express or implied warranty. X# X# THE COPYRIGHT HOLDER DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, X# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO X# EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY SPECIAL, INDIRECT OR X# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, X# DATA, PROFITS, QPA OR GPA, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE X# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR X# PERFORMANCE OF THIS SOFTWARE. SHAR_EOF if test 2328 -ne "`wc -c < 'pathname.pl'`" then echo shar: error transmitting "'pathname.pl'" '(should have been 2328 characters)' fi fi if test -f 'readline.pl' then echo shar: will not over-write existing file "'readline.pl'" else echo x - 'readline.pl' sed 's/^X//' >'readline.pl' << 'SHAR_EOF' X#!/u3/thesis/clipper/pl/perl X# A bash-like readline subroutine for perl X# Copyright 1990 by Khun Yee Fung (clipper@csd.uwo.ca) X# See the end of the program for warranty information X# $Source: /u3/thesis/clipper/own/lib/perl/RCS/readline.pl,v $ X# $Id: readline.pl,v 1.1 90/05/05 12:32:17 clipper Exp $ Xsub prep_terminal { X open(TTY, '/dev/tty'); X ioctl(TTY, $TIOCGETP, $foo); X ($ispeed, $ospeed) = unpack('cc', $foo); X X $term = $ENV{'TERM'}; X X if ($term eq "unknown") { X print "Can't control unknown terminal\n"; X exit 0; X } X X if (! &Tgetent($term)) { X print "Can't find terminal: $term\n"; X exit 255; X } X $history = 30; X $histart = 0; X do initkeymap(); X} X Xsub readline { X $numc = 0; X $totc = 0; X $row = 1; X $col = length($_[0]); X $hiscount = $#history + 1; X do set_cbreak(1); X $read_string = ""; X $r_prompt = $_[0]; X print $_[0]; X $done = 0; X $literal = 0; X $meta = 0; X while (! $done) { X $c = getc(STDIN); X if ($literal) { X do insert($c); X $literal = 0; X } X elsif ($meta) { X $fun = $keymap[ord($c) + 128]; X do $fun($c); X $meta = 0; X } X else { X $fun = $keymap[ord($c)]; X do $fun($c); X } X } X print "\n"; X &puthistory(); X do set_cbreak(0); X $read_string . "\n"; X} X Xsub rubout { X local($len) = length($read_string) - $numc; X if ($numc <= 0) { return; } X &Tputs($TC{'le'}, 1, 'STDOUT'); X print substr($read_string, $numc, $len), " "; X while ($len >= 0) { X &Tputs($TC{'le'}, 1, 'STDOUT'); X $len--; X } X substr($read_string, $numc-1, 1) = ""; X $numc--; X $totc--; X} X Xsub delete { X local($len) = length($read_string) - $numc - 1; X if ($numc == $totc) { return; } X print substr($read_string, $numc+1, $len), " "; X while ($len >= 0) { X &Tputs($TC{'le'}, 1, 'STDOUT'); X $len--; X } X substr($read_string, $numc, 1) = ""; X $totc--; X} X Xsub moveleft { X if ($numc <= 0) { return; } X &Tputs($TC{'le'}, 1, 'STDOUT'); X $numc--; X} X Xsub moveright { X if ($numc == $totc) { return; } X &Tputs($TC{'nd'}, 1, 'STDOUT'); X $numc++; X} X Xsub beginofline { X if ($numc <= 0) { return; } X while ($numc > 0) { X &Tputs($TC{'le'}, 1, 'STDOUT'); X } X continue { X $numc--; X } X} X Xsub endofline { X while ($numc != $totc) { X &Tputs($TC{'nd'}, 1, 'STDOUT'); X } X continue { X $numc++; X } X} X Xsub killline { X &Tputs($TC{'ce'}, 1, 'STDOUT'); X substr($read_string, $numc, $totc - $numc) = ""; X $totc = $numc; X} X Xsub clearscreen { X &Tputs($TC{'cl'}, 1, 'STDOUT'); X print "$r_prompt> ", $read_string; X} X Xsub unixkillline { X while ($numc > 0) { X &Tputs($TC{'le'}, 1, 'STDOUT'); X $numc--; X } X &Tputs($TC{'ce'}, 1, 'STDOUT'); X $read_string = ""; X $totc = 0; X} X Xsub puthistory { X if ($#history == $history) { X splice(@history, 0, 1); X $histart++; X } X $history[$#history+1] = $read_string; X} X Xsub lasthist { X if ($hiscount == 0) { return; } X $hiscount--; X do unixkillline(); X print $history[$hiscount]; X $read_string = $history[$hiscount]; X $totc = length($history[$hiscount]); X $numc = $totc; X} X Xsub nexthist { X if ($hiscount > $#history) { return; } X do unixkillline(); X $hiscount++; X print $history[$hiscount]; X $read_string = $history[$hiscount]; X $totc = length($history[$hiscount]); X $numc = $totc; X} X Xsub complete_file { X local($prefix) = $_[0]; X local($parts) = split('/', $prefix); X local($cwd) = $pwd; X X} X Xsub printhistory { X local($index); X for ($index = $histart; $index < $hiscount; $index++) { X print $index, " $history[$index - $histart]\n"; X } X} X Xsub insert { X print $_[0]; substr($read_string, $numc, 0) = $_[0]; X $numc++; X $totc++; X} X Xsub literal { X $literal = 1; X} X Xsub meta { X $meta = 1; X} X Xsub done { X $done = 1; X} X Xsub nothing { X print "In Nothing"; X 1; X} X Xsub initkeymap { X $#keymap = 256; X $keymap[0] = 'nothing'; X $keymap[1] = 'beginofline'; # ^A X $keymap[2] = 'moveleft'; # ^B X $keymap[3] = 'nothing'; X $keymap[4] = 'delete'; # ^D X $keymap[5] = 'endofline'; # ^E X $keymap[6] = 'moveright'; # ^F X $keymap[7] = 'nothing'; X $keymap[8] = 'rubout'; # ^H X $keymap[9] = 'nothing'; X $keymap[10] = 'done'; # ^J X $keymap[11] = 'killline'; # ^K X $keymap[12] = 'clearscreen';# ^L X $keymap[13] = 'done';# ^M X $keymap[14] = 'nexthist'; # ^N X $keymap[15] = 'nothing'; X $keymap[16] = 'lasthist'; # ^P X $keymap[17] = 'literal'; # ^Q X $keymap[18] = 'nothing'; X $keymap[19] = 'nothing'; X $keymap[20] = 'transpose'; # ^T X $keymap[21] = 'unixkillline'; # ^U X $keymap[22] = 'literal'; # ^V X $keymap[23] = 'nothing'; X $keymap[24] = 'nothing'; X $keymap[25] = 'nothing'; X $keymap[26] = 'nothing'; X $keymap[27] = 'meta'; # ESC X $keymap[28] = 'nothing'; X $keymap[29] = 'nothing'; X $keymap[30] = 'nothing'; X $keymap[31] = 'nothing'; X local($index); X for ($index = 32; $index < 127; $index++) { X $keymap[$index] = 'insert'; X } X $keymap[127] = 'rubout'; X for ($index = 128; $index < 256; $index++) { X $keymap[$index] = 'nothing'; X } X} X1; X X# Copyright 1990 Khun Yee Fung <clipper@csd.uwo.ca> X# X# Permission to use, copy, modify, and distribute, this software and its X# documentation for any purpose is hereby granted without fee, provided that X# the above copyright notice appear in all copies and that both that X# copyright notice and this permission notice appear in supporting X# documentation, and that the name of the copyright holders be used in X# advertising or publicity pertaining to distribution of the software with X# specific, written prior permission, and that no fee is charged for further X# distribution of this software, or any modifications thereof. The copyright X# holder make no representations about the suitability of this software for X# any purpose. It is provided "as is" without express or implied warranty. X# X# THE COPYRIGHT HOLDER DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, X# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO X# EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY SPECIAL, INDIRECT OR X# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, X# DATA, PROFITS, QPA OR GPA, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE X# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR X# PERFORMANCE OF THIS SOFTWARE. SHAR_EOF if test 6253 -ne "`wc -c < 'readline.pl'`" then echo shar: error transmitting "'readline.pl'" '(should have been 6253 characters)' fi fi if test -f 'resolver.pl' then echo shar: will not over-write existing file "'resolver.pl'" else echo x - 'resolver.pl' sed 's/^X//' >'resolver.pl' << 'SHAR_EOF' X#!/u3/thesis/clipper/pl/perl X# a subroutine to resolve a Internet host name to IP address X# Copyright 1990 by Khun Yee Fung (clipper@csd.uwo.ca) X# See the end of the program for warranty information Xsub resolver { X local($sockaddr) = 'S n a4 x8'; X local($hostname) = $_[0]; X local($server) = 'ria'; X local($port) = 53; X X (local($name, $aliases, $type, $len, $saddr) = gethostbyname($server)) X || ((print "hostname\n"), return 0); X local($sin) = pack($sockaddr, 2, $port, $saddr); X X socket(NSERVER, 2, 1, 0) || ((print "socket: $!\n"), return 0); X connect(NSERVER, $sin) || ((print "connect: $!\n"), return 0); X X select(NSERVER); $| = 1; select(STDOUT); $| = 1; X X local($len) = 18 + length($hostname); X local(@names) = split('\.', $hostname); X local($head) = pack('S6', 319, 256, 1, 0, 0, 0); X print NSERVER pack('S', $len), $head; X local($arg, $response); X foreach $arg (@names) { X print NSERVER pack('C', length($arg)), $arg; X } X print NSERVER pack('CS2', 0, 1, 1); X X read(NSERVER, $len, 2); X read(NSERVER, $response, unpack('S', $len)); X close NSERVER; X X local(@RCODE) = ("No error", "Format error", "Server Failure", "Name error", X "Not implemented", "Refused"); X local(@shead) = unpack('S6', $response); X ($shead[1] & 0x0F) == 0 || return 0; X X local($in) = 12; X local($ans) = $shead[2]; X local($c); X while ($ans > 0) { X while (($c = ord(substr($response, $in++, 1))) != 0) { X $in += $c; X } X $in += 4; X $ans--; X } X X $ans = $shead[3]; X local($type, $rdlength, $rdata); X while ($ans > 0) { X while (($c = ord(substr($response, $in++, 1))) != 0) { X ($c & 0xc0) != 0xc0 || $in++, last; X $in += $c; X } X $type = substr($response, $in, 2); X $in += 8; X $rdlength = unpack('n', substr($response, $in, 2)); X $in += 2; X $rdata = substr($response, $in, $rdlength); X if (unpack('S', $type) == 1) { X return $rdata; X } X $in += $rdlength; X $ans--; X } X return 0; X} X1; X X# Copyright 1990 Khun Yee Fung <clipper@csd.uwo.ca> X# X# Permission to use, copy, modify, and distribute, this software and its X# documentation for any purpose is hereby granted without fee, provided that X# the above copyright notice appear in all copies and that both that X# copyright notice and this permission notice appear in supporting X# documentation, and that the name of the copyright holders be used in X# advertising or publicity pertaining to distribution of the software with X# specific, written prior permission, and that no fee is charged for further X# distribution of this software, or any modifications thereof. The copyright X# holder make no representations about the suitability of this software for X# any purpose. It is provided "as is" without express or implied warranty. X# X# THE COPYRIGHT HOLDER DISCLAIM ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, X# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO X# EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY SPECIAL, INDIRECT OR X# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, X# DATA, PROFITS, QPA OR GPA, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE X# OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR X# PERFORMANCE OF THIS SOFTWARE. SHAR_EOF if test 3242 -ne "`wc -c < 'resolver.pl'`" then echo shar: error transmitting "'resolver.pl'" '(should have been 3242 characters)' fi fi echo Done exit 0
yukngo@obelix.gaul.csd.uwo.ca (Cheung Yukngo) (06/06/90)
Perhaps I should have included this piece of information: ioctl.pl is found in the root directory of the perl source tree. [Again] Please use the -s option every time you use nftp. I was just too lazy to make it the default. The readline library included is very buggy and also system specific. shan@sphunix.sph.jhu.edu: I cannot reach you via email. I tried twice and both times the emails bounced. The error message says something about unknown mailer. I don't remember the full error message. But this is an attempt: sh: cannot find /user/admin/shan/bin/mail.pl 554 unknown .... mailer ...