##! /bin/sh
#From cs.utexas.edu!asuvax!gatech!news.byu.edu!eff!iWarp.intel.com|news Fri May 1 14:52:11 CDT 1992
#Article: 10383 of comp.lang.perl
#Path: cse.uta.edu!cs.utexas.edu!asuvax!gatech!news.byu.edu!eff!iWarp.intel.com|news
#From: merlyn@iWarp.intel.com (Randal L. Schwartz)
#Newsgroups: comp.lang.perl
#Subject: Re: Perl FTP Interface (Need Example) (Do I Use expect.pl?)
#Message-ID: <1992May1.152710.22905@iWarp.intel.com>
#Date: 1 May 92 15:27:10 GMT
#References: <3604@ucru2.ucr.edu> <18604@ector.cs.purdue.edu>
#Sender: news@iWarp.intel.com
#Reply-To: merlyn@iWarp.intel.com (Randal L. Schwartz)
#Organization: Stonehenge; netaccess via Intel, Beaverton, Oregon, USA
#Lines: 277
#In-Reply-To: spaf@cs.purdue.EDU (Gene Spafford)
#Nntp-Posting-Host: v.iwarp.intel.com
#
#In article <18604@ector.cs.purdue.edu>, spaf@cs (Gene Spafford) writes:
#| Well, I guess now is as good a time as any.
#|
#| I have put together a "ftp library package" that allows one to
#| construct fun little ftp programs. It works well for me -- I've built
#| a mirroring program and a couple of command-line ftp commands.
#|
#| None of this is documented (I got really busy just when I finished
#| testing this). I'll include the code for the library here, and
#| the code for my two example commands. One command lets you "ls" a
#| remote directory using ftp, and the other lets you get arbitrary
#| files, in either binary or ascii mode. I'm half done with one that
#| will let you fetch a remote tree, ala "rcp -r"
#
#Well, hey, since I have a little script that does kinda the same thing
#(the one you're "half done" with), I'll post it. Amazingly enough,
#it *also* uses chat2.pl :-).
#
#It presumes a BSD-like remote host, and fails miserably on any unusual
#forms of ftpd. Try it first to see, though.
# 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: ftpr
# Wrapped by merlyn@iwarpv on Fri May 1 08:22:59 1992
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'ftpr' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ftpr'\"
else
echo shar: Extracting \"'ftpr'\" \(5037 characters\)
sed "s/^X//" >'ftpr' <<'END_OF_FILE'
X#!/usr/bin/perl
X
X## ftpr, last update 91/08/16
X## usage: ftpr [-a] [-d] [-t timeout] [-n] hostname topdir yes-regex except-regex
X## topdir may be whitespace-separated list of topdirs
X## yes-regex defaults to . (meaning everything)
X## except-regex defaults to ' ' (meaning no exceptions)
X
Xpush(@INC, '/local/merlyn/lib/perl');
X
Xrequire 'chat2.pl';
X
X$| = 1; # not much output, but we like to see it as it happens
X$timeout = 60;
X$dasha = "";
X$nflag = 0;
X$host = "localhost";
X$topdir = ".";
X$yesregex = ".";
X$noregex = " ";
X$user = "anonymous";
X$pass = 'merlyn@iwarp.intel.com';
X
X{
X last unless $ARGV[0] =~ /^-/;
X $_ = shift;
X $trace++, redo if /^-d/; # debug mode
X $timeout = $1, redo if /^-t(\d+)/;
X $timeout = shift, redo if /^-t/;
X $dasha = "-a", redo if /^-a/;
X $nflag++, redo if /^-n/;
X die "bad flag: $_";
X}
X
X$host = shift if @ARGV;
X$topdir = shift if @ARGV;
X$yesregex = shift if @ARGV;
X$noregex = shift if @ARGV;
X
Xdie "extra args: @ARGV" if @ARGV;
X
X($Control = &chat'open_port($host,21)) || die "open control: $!";
Xdie "expected 2dd for initial banner, got $_"
X unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
X&ctalk("user $user\n");
X$_ = &clisten($timeout);
Xunless (/^2\d\d/) { # might be logged in already:
X die "expected 3dd for password query, got $_"
X unless /^3\d\d/;
X &ctalk("pass $pass\n");
X die "expected 2dd for logged in, got $_"
X unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
X}
X## all set up for a conversation
X
X@list = split(/\s+/,$topdir);
Xwhile ($dir = shift list) {
X next if $seen{$dir}++;
X print "listing $dir\n";
X for (&list($dir)) {
X (warn "can't parse $_ in $dir"), next
X unless ($tag,$file) = /^(.).*\s(\S+)\s*$/;
X push(@list, "$dir/$file") if
X ($tag eq 'd') && ($file !~ /^\.\.?$/);
X if ( ($tag eq '-') &&
X ("$dir/$file" =~ /$yesregex/o) &&
X ("$dir/$file" !~ /$noregex/o) &&
X (! -e "$dir/$file")
X ) {
X print "fetching $dir/$file...\n";
X &get("$dir/$file","$dir/$file") unless $nflag;
X }
X }
X}
X
X## shutdown
X&ctalk("quit\n");
X&clisten(5); # for trace
X&chat'close($Control);
Xexit(0);
X
Xsub ctalk {
X local($text) = @_;
X print "{$text}" if $trace;
X &chat'print($Control,$text);
X}
X
Xsub clisten {
X local($secs) = @_;
X local($return,$tmp);
X while (1) {
X $tmp = &chat'expect($Control, $secs, '(.*)\r?\n', '"$1\n"');
X print $tmp if $trace;
X $return .= $tmp;
X return $return if !length($tmp) || $tmp =~ /^\d\d\d /;
X }
X}
X
Xsub dopen {
X local($_);
X
X local(@ret) = &chat'open_listen();
X &ctalk("port " .
X join(",", @ret[0,1,2,3], int($ret[4]/256), $ret[4]%256) .
X "\n");
X die "expected 2dd for data open, got $_"
X unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
X $Data = $ret[5];
X}
X
X<<'END_NOT_USED';
Xsub dtalk {
X local($text) = @_;
X print "{D:$text}" if $trace;
X &chat'print($Data,$text);
X}
XEND_NOT_USED
X
Xsub dlisten {
X local($secs,$forcereturn) = @_;
X local($return,$tmp);
X while (1) {
X $tmp = &chat'expect($Data, $secs,
X '(.|\n)+', '$&',
X TIMEOUT, '""',
X EOF, 'undef');
X if (defined $tmp) {
X print "[D:$tmp]" if $trace > 1;
X $return .= $tmp;
X return $return unless (!$forcereturn) && (length $tmp);
X # if timeout, return what you have
X } else { # eof
X return $return;
X # maybe undef
X }
X }
X}
X
Xsub dclose {
X &chat'close($Data);
X}
X
X<<'END_NOT_USED';
Xsub nlst {
X local($dir) = @_;
X local(@files);
X local($_,$tmp);
X
X &dopen();
X &ctalk("nlst $dasha $dir/.\n");
X die "expected 1dd for nlst, got $_"
X unless ($_ = &clisten($timeout)) =~ /^1\d\d/;
X $_ = "";
X while (1) {
X $tmp = &dlisten($timeout);
X last unless defined $tmp;
X $_ .= $tmp;
X }
X @files = sort grep(!/^\.\.?$/, split(/\r?\n/))
X unless /^ls: /;
X die "expected 2dd for nlst complete, got $_"
X unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
X &dclose();
X @files;
X}
XEND_NOT_USED
X
Xsub list {
X local($dir) = @_;
X local(@files);
X local($_,$tmp);
X
X &dopen();
X &ctalk("list $dasha $dir/.\n");
X die "expected 1dd for list, got $_"
X unless ($_ = &clisten($timeout)) =~ /^(.*\n)*1/;
X $_ = "";
X while (1) {
X $tmp = &dlisten($timeout);
X last unless defined $tmp;
X $_ .= $tmp;
X }
X @files = grep(/^\S[rwx\-]{8}/, split(/\r?\n/));
X die "expected 2dd for list complete, got $_"
X unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
X &dclose();
X @files;
X}
X
Xsub get {
X local($from, $to) = @_;
X local($todir,*OUT);
X
X ($todir = "./$to") =~ s#(.*)/.*#$1#;
X system "mkdir -p $todir" unless -d $todir;
X (warn "cannot create $to.TMP: $!"), return
X unless open(OUT, ">$to.TMP");
X select((select(OUT),$|=1)[0]);
X &ctalk("type i\n");
X die "expected 2dd for type i ok, got $_"
X unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
X &dopen();
X &ctalk("retr $from\n");
X unless (($_ = &clisten($timeout)) =~ /^1\d\d/) {
X warn "expected 1dd for retr, got $_";
X close(OUT);
X unlink("$to.TMP");
X &dclose();
X return;
X }
X {
X $_ = &dlisten($timeout,1);
X last unless defined $_;
X print OUT;
X redo;
X }
X close(OUT);
X unless (($_ = &clisten($timeout)) =~ /^2\d\d/) {
X warn "expected 2dd for retr complete, got $_";
X close(OUT);
X unlink("$to.TMP");
X &dclose();
X return;
X }
X &dclose();
X rename("$to.TMP","$to") || warn "cannot rename $to.TMP to $to: $!";
X}
END_OF_FILE
if test 5037 -ne `wc -c <'ftpr'`; then
echo shar: \"'ftpr'\" unpacked with wrong size!
fi
chmod +x 'ftpr'
# end of 'ftpr'
fi
echo shar: End of shell archive.
exit 0
--
/=Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ==========\
| on contract to Intel's iWarp project, Beaverton, Oregon, USA, Sol III |
| merlyn@iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
\=Cute Quote: "Intel: putting the 'backward' in 'backward compatible'..."====/