##! /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: [email protected] (Randal L. Schwartz)
#Newsgroups: comp.lang.perl
#Subject: Re: Perl FTP Interface (Need Example) (Do I Use expect.pl?)
#Message-ID: <[email protected]>
#Date: 1 May 92 15:27:10 GMT
#References: <[email protected]> <[email protected]>
#Sender: [email protected]
#Reply-To: [email protected] (Randal L. Schwartz)
#Organization: Stonehenge; netaccess via Intel, Beaverton, Oregon, USA
#Lines: 277
#In-Reply-To: [email protected] (Gene Spafford)
#Nntp-Posting-Host: v.iwarp.intel.com
#
#In article <[email protected]>, 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 = '[email protected]';
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      |
| [email protected] ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
\=Cute Quote: "Intel: putting the 'backward' in 'backward compatible'..."====/

You are viewing proxied material from ftp.icm.edu.pl. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.