##! /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 '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'..."====/