InfoMagic Source Code 1993 July/THE_SOURCE_CODE_CD_ROM.iso/languages/perl/scripts-convex/ftp-chat2/ftpr

Text File | 1993-07-14 | 4.9 KB | 228 lines

#!/usr/bin/perl

## ftpr, last update 91/08/16
## usage: ftpr [-a] [-d] [-t timeout] [-n] hostname topdir yes-regex except-regex
## topdir may be whitespace-separated list of topdirs
## yes-regex defaults to . (meaning everything)
## except-regex defaults to ' ' (meaning no exceptions)

push(@INC, '/local/merlyn/lib/perl');

require 'chat2.pl';

$| = 1; # not much output, but we like to see it as it happens
$timeout = 60;
$dasha = "";
$nflag = 0;
$host = "localhost";
$topdir = ".";
$yesregex = ".";
$noregex = " ";
$user = "anonymous";
$pass = '[e-mail]';

{
    last unless $ARGV[0] =~ /^-/;
    $_ = shift;
    $trace++, redo if /^-d/; # debug mode
    $timeout = $1, redo if /^-t(\d+)/;
    $timeout = shift, redo if /^-t/;
    $dasha = "-a", redo if /^-a/;
    $nflag++, redo if /^-n/;
    die "bad flag: $_";
}

$host = shift if @ARGV;
$topdir = shift if @ARGV;
$yesregex = shift if @ARGV;
$noregex = shift if @ARGV;

die "extra args: @ARGV" if @ARGV;

($Control = &chat'open_port($host,21)) || die "open control: $!";
die "expected 2dd for initial banner, got $_"
    unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
&ctalk("user $user\n");
$_ = &clisten($timeout);
unless (/^2\d\d/) { # might be logged in already:
    die "expected 3dd for password query, got $_"
        unless /^3\d\d/;
    &ctalk("pass $pass\n");
    die "expected 2dd for logged in, got $_"
        unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
}
## all set up for a conversation

@list = split(/\s+/,$topdir);
while ($dir = shift list) {
    next if $seen{$dir}++;
    print "listing $dir\n";
    for (&list($dir)) {
        (warn "can't parse $_ in $dir"), next
            unless ($tag,$file) = /^(.).*\s(\S+)\s*$/;
        push(@list, "$dir/$file") if
            ($tag eq 'd') && ($file !~ /^\.\.?$/);
        if (    ($tag eq '-') &&
            ("$dir/$file" =~ /$yesregex/o) &&
            ("$dir/$file" !~ /$noregex/o) &&
            (! -e "$dir/$file")
        ) {
            print "fetching $dir/$file...\n";
            &get("$dir/$file","$dir/$file") unless $nflag;
        }
    }
}

## shutdown
&ctalk("quit\n");
&clisten(5); # for trace
&chat'close($Control);
exit(0);

sub ctalk {
    local($text) = @_;
    print "{$text}" if $trace;
    &chat'print($Control,$text);
}

sub clisten {
    local($secs) = @_;
    local($return,$tmp);
    while (1) {
        $tmp = &chat'expect($Control, $secs, '(.*)\r?\n', '"$1\n"');
        print $tmp if $trace;
        $return .= $tmp;
        return $return if !length($tmp) || $tmp =~ /^\d\d\d /;
    }
}

sub dopen {
    local($_);

    local(@ret) = &chat'open_listen();
    &ctalk("port " .
        join(",", @ret[0,1,2,3], int($ret[4]/256), $ret[4]%256) .
        "\n");
    die "expected 2dd for data open, got $_"
        unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
    $Data = $ret[5];
}

<<'END_NOT_USED';
sub dtalk {
    local($text) = @_;
    print "{D:$text}" if $trace;
    &chat'print($Data,$text);
}
END_NOT_USED

sub dlisten {
    local($secs,$forcereturn) = @_;
    local($return,$tmp);
    while (1) {
        $tmp = &chat'expect($Data, $secs,
            '(.|\n)+', '$&',
            TIMEOUT, '""',
            EOF, 'undef');
        if (defined $tmp) {
            print "[D:$tmp]" if $trace > 1;
            $return .= $tmp;
            return $return unless (!$forcereturn) && (length $tmp);
                # if timeout, return what you have
        } else { # eof
            return $return;
                # maybe undef
        }
    }
}

sub dclose {
    &chat'close($Data);
}

<<'END_NOT_USED';
sub nlst {
    local($dir) = @_;
    local(@files);
    local($_,$tmp);

    &dopen();
    &ctalk("nlst $dasha $dir/.\n");
    die "expected 1dd for nlst, got $_"
        unless ($_ = &clisten($timeout)) =~ /^1\d\d/;
    $_ = "";
    while (1) {
        $tmp = &dlisten($timeout);
        last unless defined $tmp;
        $_ .= $tmp;
    }
    @files = sort grep(!/^\.\.?$/, split(/\r?\n/))
        unless /^ls: /;
    die "expected 2dd for nlst complete, got $_"
        unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
    &dclose();
    @files;
}
END_NOT_USED

sub list {
    local($dir) = @_;
    local(@files);
    local($_,$tmp);

    &dopen();
    &ctalk("list $dasha $dir/.\n");
    die "expected 1dd for list, got $_"
        unless ($_ = &clisten($timeout)) =~ /^(.*\n)*1/;
    $_ = "";
    while (1) {
        $tmp = &dlisten($timeout);
        last unless defined $tmp;
        $_ .= $tmp;
    }
    @files = grep(/^\S[rwx\-]{8}/, split(/\r?\n/));
    die "expected 2dd for list complete, got $_"
        unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
    &dclose();
    @files;
}

sub get {
    local($from, $to) = @_;
    local($todir,*OUT);

    ($todir = "./$to") =~ s#(.*)/.*#$1#;
    system "mkdir -p $todir" unless -d $todir;
    (warn "cannot create $to.TMP: $!"), return
        unless open(OUT, ">$to.TMP");
    select((select(OUT),$|=1)[0]);
    &ctalk("type i\n");
    die "expected 2dd for type i ok, got $_"
        unless ($_ = &clisten($timeout)) =~ /^2\d\d/;
    &dopen();
    &ctalk("retr $from\n");
    unless (($_ = &clisten($timeout)) =~ /^1\d\d/) {
        warn "expected 1dd for retr, got $_";
        close(OUT);
        unlink("$to.TMP");
        &dclose();
        return;
    }
    {
        $_ = &dlisten($timeout,1);
        last unless defined $_;
        print OUT;
        redo;
    }
    close(OUT);
    unless (($_ = &clisten($timeout)) =~ /^2\d\d/) {
        warn "expected 2dd for retr complete, got $_";
        close(OUT);
        unlink("$to.TMP");
        &dclose();
        return;
    }
    &dclose();
    rename("$to.TMP","$to") || warn "cannot rename $to.TMP to $to: $!";
}