From 92a5906e29d63d9bef9cf10a242d4feacdfba703 Mon Sep 17 00:00:00 2001 From: Malin Date: Sat, 1 Oct 2016 09:19:30 +0200 Subject: [PATCH] Delete 'transfer.pl' --- transfer.pl | 1974 --------------------------------------------------- 1 file changed, 1974 deletions(-) delete mode 100644 transfer.pl diff --git a/transfer.pl b/transfer.pl deleted file mode 100644 index 7c9fea6..0000000 --- a/transfer.pl +++ /dev/null @@ -1,1974 +0,0 @@ -#!/usr/bin/perl - -use Time::HiRes qw(gettimeofday tv_interval); - -$| = 1; -#my $log = substr($ENV{'SCRIPT_FILENAME'}, 0, rindex($ENV{'SCRIPT_FILENAME'}, '/public_html/')) . "/log.txt"; - -#open(STDERR, ">>$log"); -use CGI; -use CGI::Carp qw(fatalsToBrowser); -use Net::FTP; - -my $q = new CGI; -my ($ftp,$local_dir,$start_time); -my ($ftrans,$fsize,$strans,$ssize,$etrans,$esize) = 0; -my $server = url_unescape($q->param('server')); -my $username = url_unescape($q->param('username')); -my $password = url_unescape($q->param('password')); -my $remote_dir = url_unescape($q->param('remote_dir')); -my @ascii = qw(asa asp aspx c cpp cgi css hqx htaccess htm html inc ini js jsp log php php3 pl pm ps py rb shar shtm shtml sql tex txt url uu xml xsl); -my $local_root = substr($ENV{'SCRIPT_FILENAME'}, 0, rindex($ENV{'SCRIPT_FILENAME'}, '/public_html/')); -my $local_dir = url_unescape($q->param('local_dir')); - -if ($local_dir !~ /\/$/) { - $local_dir = "$local_dir/"; -} - -print "Content-type: text/html\n\n"; -print qq| - - - - - Site Transfer Script - - - -
- - - - - -}; - -if ($q->param('submit') eq 'Delete') { - my $del = unlink($ENV{'SCRIPT_FILENAME'}); - - print qq{ - - - - - }; -} - -elsif ($q->param('submit') eq 'Connect' || $q->param('submit') eq 'Transfer Selected') { - print qq{ -
- }; - if ($del) { - print '

Transfer script deleted

'; - } - else { - print '

Transfer script was not deleted, please remove manually

'; - } - print qq{ -
- - -
- Connecting to $server → - }; - my $rv = $ftp = Net::FTP->new($server, Debug => 0, Hash => \*STDOUT, Passive => 1, Timeout => 60); - if ($rv) { - print "Success"; - } - else { - print "Connection failed: $@"; - exit; - } - print qq{ -
- Logging in using username: $username and password: $password → - }; - $rv = $ftp->login($username, $password); - if ($rv) { - print "Success"; - } - else { - print "Login failed: " . $ftp->message; - } - print qq{ -
-
- - - -
- }; - $remote_dir = $ftp->pwd if !$remote_dir; - - if (defined($remote_dir) && $remote_dir !~ /\/$/) { - $remote_dir = "$remote_dir/"; - } - - my $rv = $ftp->cwd($remote_dir); - if ($rv){ - print "Current remote directory: $remote_dir"; - } - else { - print "Error accessing $remote_dir " . $ftp->message . "
"; - exit; - } - print "		Current local directory (files will be transferred here): $local_root$local_dir"; - - my @dir = sort_list('display', $ftp->dir); - print qq{ -
- - }; - foreach my $value (@dir) { - if ($value->{'type'} eq '-') { - print qq{ - - - - - - - -
{'name'}} $q->param('transfer_file'); - print qq{/> - } . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{}; - } - elsif ($value->{'type'} eq 'd') { - if ($value->{'name'} eq '.') { - print qq{ -
} . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{}; - #Transfer - } - elsif ($value->{'name'} eq '..') { - my $remote_dir = $remote_dir; - chop($remote_dir) if $remote_dir ne '/'; - print qq{ -
} . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{}; - } - else { - print qq{ -
{'name'}} $q->param('transfer_dir'); - print qq{/> - } . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{}; - #Transfer - } - } - elsif ($value->{'type'} eq 'l') { - print qq{ -
- } . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{ → } . $value->{'symlink'} . qq{}; - #Transfer - } - else { - next; - } - } - print "
"; - my @dir = sort_list('display', `ls -la $local_root$local_dir`); - print qq{ - 		- - }; - foreach my $value (@dir) { - if ($value->{'type'} eq '-') { - print qq{ - - - - - -
} . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{}; - } - elsif ($value->{'type'} eq 'd') { - if ($value->{'name'} eq '.') { - print qq{ -
} . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{}; - } - elsif ($value->{'name'} eq '..') { - my $local_dir = $local_dir; - chop($local_dir) if $local_dir ne '/'; - print qq{ -
} . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{}; - } - else { - print qq{ -
} . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{}; - } - } - elsif ($value->{'type'} eq 'l') { - print qq{ -
} . $value->{'type'} . $value->{'mode'} . qq{ - } . $value->{'nlink'} . qq{ - } . $value->{'uid'} . qq{ - } . $value->{'gid'} . qq{ - } . size_convert($value->{'size'}) . qq{ - } . $value->{'date'} . qq{ - } . $value->{'name'} . qq{ → } . $value->{'symlink'}; - } - else { - next; - } - } - print "
"; - - if ($q->param('submit') eq 'Transfer Selected') { - print "
"; - print ""; - print ""; - print ""; - print "
"; - print ""; - print " "; - print " "; - print " "; - print " "; - print " "; - print " "; - print " "; - print " "; - $start_time = [gettimeofday]; - - my @files_to_transfer = $q->param('transfer_file'); - my @dirs_to_transfer = $q->param('transfer_dir'); - foreach my $target_file (@files_to_transfer) { - $target_file = url_unescape($target_file); - my ($target_name, $target_size) = split(/=\|=/, $target_file); - transfer_file($remote_dir, $local_root . $local_dir, $target_name, $target_size); - } - foreach my $target_dir (@dirs_to_transfer) { - transfer_dir($remote_dir, $local_root . $local_dir, $target_dir); - } - - print "
"; - print " RemoteFilename"; - print " "; - print " Remote File Type"; - print " "; - print " Remote File Size"; - print " "; - print " Download Progress"; - print " "; - print " Local Permission"; - print " "; - print " Local File Size"; - print "

"; - print "Transfer completed.
"; - print "Susscessfully transferred $ftrans files totalling " . size_convert($fsize) . ".
"; - print "Failed transferring $etrans files totalling " . size_convert($esize) . ".
"; - print "Skipped transferring $strans files totalling " . size_convert($ssize) . ".
"; - print "Transfer request covered " . ($ftrans + $strans + $etrans) . " files totalling " . size_convert($fsize + $ssize + $esize) . ".
"; - print "Transfer request took " . time_convert(tv_interval($start_time, [gettimeofday])) . " to complete."; - } - else { - print ""; - print ""; - print ""; - print ""; - print ""; - } - - $ftp->quit; -} - -else { - print ""; -} - -print qq{ - - -}; - -#close(STDERR); - - -sub transfer_file { - my $remote_dir = shift; - my $local_dir = shift; - my $target_file = shift; - my $target_size = shift; - my $rv = $ftp->cwd($remote_dir); - if (! $rv) { - if ($ftp->message =~ /connection closed/i || $ftp->message =~ /timeout/i) { - $ftp = Net::FTP->new($server, Debug => 0, Hash => \*STDOUT, Passive => 1, Timeout => 60); - $ftp->login($username, $password); - $ftp->cwd($remote_dir); - } - else { - print "Error accessing $remote_dir " . $ftp->message . "
"; - return; - } - } - if ($local_dir !~ /\/$/) { - $local_dir = "$local_dir/"; - } - if ($remote_dir !~ /\/$/) { - $remote_dir = "$remote_dir/"; - } - - my $rv; - my $type = 'binary'; - foreach my $asc (@ascii) { - if ($target_file =~ /\.$asc$/) { - $type = 'ascii'; - last; - } - } - - print " "; - print " "; - print " $target_file"; - print " "; - print " "; - print " $type file"; - print " "; - print " "; - print " " . size_convert($target_size); - print " "; - - if (-e $local_dir . $target_file && $target_file ne '.htaccess') { - $strans++; - $ssize += $target_size; - print " "; - print " Exists, skipping"; - print " "; - print " "; - print "
"; - print " "; - print " "; - print "
"; - print " "; - print " "; - } - else { - if ($type eq 'ascii') { - $ftp->ascii; - } - else { - $ftp->binary; - } - - print " "; - - my $bytes_out = tell(*STDOUT); - my $start_transfer = [gettimeofday]; - $ftp->hash(\*STDOUT, 2048); - my $rv = $ftp->get($target_file, $local_dir . $target_file); - - if ($rv) { - if ((tell(*STDOUT) - $bytes_out) == 1) { - print "#"; - } - my $transfer_time = tv_interval($start_transfer, [gettimeofday]) || 1; -# print "
Complete: $value->{'size'} bytes in " . sprintf("%.2f", $transfer_time) . " seconds
(". sprintf("%.2f", $value->{'size'} / $transfer_time) . " bytes per second)"; - print " "; - $ftrans++; - $fsize += $target_size; - my $rv; - if ($target_file =~ /\.pl$/ || $target_file =~ /\.cgi$/) { - print " "; - $rv = chmod(0755, "$local_dir$target_file"); - if ($rv) { - print "755"; - } - else { - print "
"; - } - print " "; - } - else { - print " "; - $rv = chmod(0644, "$local_dir$target_file"); - if ($rv) { - print "644"; - } - else { - print "
"; - } - print " "; - } - print " "; - print " " . size_convert((stat($local_dir . $target_file))[7]); - print " "; - print " "; - } - else { - if (!$ftp->message || $ftp->message =~ /connection closed/i || $ftp->message =~ /timeout/i) { - transfer_file($remote_dir, $local_dir, $target_file, $target_size); - } - else { - $etrans++; - $esize += $target_size; - print " " . $ftp->message . ""; - print " "; - print " "; - print "
"; - print " "; - print " "; - print "
"; - print " "; - print " "; - } - } - } -} - -sub transfer_dir { - my $remote_dir = shift; - my $local_dir = shift; - my $target_dir = shift; - - return if $target_dir eq '.' || $target_dir eq '..'; - - if ($local_dir !~ /\/$/) { - $local_dir = "$local_dir/"; - } - if ($remote_dir !~ /\/$/) { - $remote_dir = "$remote_dir/"; - } - - my $rv = $ftp->cwd($remote_dir . $target_dir); - if (! $rv) { - if ($ftp->message =~ /connection closed/i || $ftp->message =~ /timeout/i) { - $ftp = Net::FTP->new($server, Debug => 0, Hash => \*STDOUT, Passive => 1, Timeout => 60); - $ftp->login($username, $password); - $ftp->cwd($remote_dir . $target_dir); - } - else { - print "Error accessing $remote_dir$target_dir " . $ftp->message . "
"; - return; - } - } - - print " "; - print " "; - print "
"; - print " "; - print " "; - print " "; - print " "; - print " $target_dir"; - print " "; - print " "; - print " directory"; - print " "; - print " "; - print "
"; - print " "; - - if (-e $local_dir . $target_dir) { - print " "; - print " Exists, skipping"; - print " "; - print " "; - print "
"; - print " "; - } - else { - my $rv = mkdir($local_dir . $target_dir, 0755); - if ($rv) { - print " "; - print " Success"; - print " "; - print " "; - print " 755"; - print " "; - } - else { - print " "; - print " Failed: $!"; - print " "; - print " "; - print "
"; - print " "; - } - } - print " "; - print "
"; - print " "; - print " "; - - my @dir = sort_list('transfer', $ftp->dir); - while (@dir) { - $value = shift(@dir); - if ($value->{'type'} eq '-') { - transfer_file($remote_dir . $target_dir, $local_dir . $target_dir, $value->{'name'}, $value->{'size'}); - } - elsif ($value->{'type'} eq 'd' && $value->{'name'} !~ /^\.\.?/) { - transfer_dir($remote_dir . $target_dir, $local_dir . $target_dir, $value->{'name'}); - } - elsif ($value->{'type'} eq 'l' && $value->{'name'} !~ /^\.\.?/) { - transfer_dir($remote_dir . $target_dir, $local_dir . $target_dir, $value->{'name'}); - } - } -} - -sub size_convert { - my $size = shift; - - if ($size > 1073741824) { - $size = sprintf("%.2f", $size / 1073741824) . " GB"; - } - elsif ($size > 1048576) { - $size = sprintf("%.2f", $size / 1048576) . " MB"; - } - elsif ($size > 1024) { - $size = sprintf("%.2f", $size / 1024) . " KB"; - } - else { - if ($size) { - $size .= " bytes"; - } - else { - $size = "0 bytes"; - } - } - - return $size -} - -sub sort_list { - my $format = shift; - my @list = @_; - my (@dir, @sym, @file, @unh, @sort); - my ($current, $parent) = 0; - foreach my $value (@list) { - if ($value =~ /^(\S{1})(\S+)\s+(\d+)\s+(\S+)\s+(\S+)\s+(\d+)\s+(\w+\s+\w+\s+\S+)\s+(.+?)\s*(?:->\s*(.+))?$/) { # Linux servers - if ($1 eq '-') { - push (@file, {'type' => $1, 'mode' => $2, 'nlink' => $3, 'uid' => $4, 'gid' => $5, 'size' => $6, 'date' => $7, 'name' => $8, 'symlink' => $9}); - } - elsif ($1 eq 'd') { - push (@dir, {'type' => $1, 'mode' => $2, 'nlink' => $3, 'uid' => $4, 'gid' => $5, 'size' => $6, 'date' => $7, 'name' => $8, 'symlink' => $9}); - if ($8 eq '.') { - $current = 1; - } - if ($8 eq '..') { - $parent = 1; - } - } - elsif ($1 eq 'l') { - push (@sym, {'type' => $1, 'mode' => $2, 'nlink' => $3, 'uid' => $4, 'gid' => $5, 'size' => $6, 'date' => $7, 'name' => $8, 'symlink' => $9}); - } - } - elsif ($value =~ /^(\d{2}-\d{2}-\d{2})\s+(\S+)\s+(\)?\s+?(\d+)?\s+?(\S+)$/) { # Microsoft Servers - if ($3 eq '') { - push (@dir, {'type' => 'd', 'mode' => '', 'nlink' => '', 'uid' => '', 'gid' => '', 'size' => $4, 'date' => "$1 $2", 'name' => $5, 'symlink' => ''}); - } - else { - push (@file, {'type' => '-', 'mode' => '', 'nlink' => '', 'uid' => '', 'gid' => '', 'size' => $4, 'date' => "$1 $2", 'name' => $5, 'symlink' => ''}); - } - } - else { - push (@unh, $value); - } - } - if ((@file || @dir || @sym) && !$current) { - push(@dir, {'type' => 'd', 'mode' => '?', 'nlink' => '?', 'uid' => '?', 'gid' => '?', 'size' => '?', 'date' => '?', 'name' => '.', 'symlink' => ''}); - } - if ((@file || @dir || @sym) && !$parent) { - push(@dir, {'type' => 'd', 'mode' => '?', 'nlink' => '?', 'uid' => '?', 'gid' => '?', 'size' => '?', 'date' => '?', 'name' => '..', 'symlink' => ''}); - } - @file = sort {$a->{'name'} cmp $b->{'name'}} @file; - @dir = sort {$a->{'name'} cmp $b->{'name'}} @dir; - @sym = sort {$a->{'name'} cmp $b->{'name'}} @sym; - - if ($format eq 'display') { - @sort = (@dir, @sym, @file); - } - elsif ($format eq 'transfer') { - @sort = (@file, @dir, @sym); - } - - return @sort, @unh; -} - -sub time_convert { - my $time = shift; - my ($hour, $minute, $second); - my @ret; - - if ($time >= 3600) { - if (int($time / 3600) == 1) { - $hour = int($time / 3600) . ' hour'; - } - elsif (int($time / 3600)) { - $hour = int($time / 3600) . ' hours'; - } - - if ($hour) { - push (@ret, $hour); - } - - $time -= $hour * 3600; - } - - if ($time >= 60) { - if (int($time / 60) == 1) { - $minute = int($time / 60) . ' minute'; - } - elsif (int($time / 60)) { - $minute = int($time / 60) . ' minutes'; - } - - if ($minute) { - push (@ret, $minute); - } - - $time -= $minute * 60; - } - - if ($time < 60) { - $time = int($time); - if ($time == 1) { - $second = $time . ' second'; - } - elsif ($time) { - $second = $time . ' seconds'; - } - else { - $second = '0 seconds'; - } - if ($second) { - push (@ret, $second); - } - } - - return join(', ', @ret); -} - -sub url_escape { - my $url = shift; - - $url =~ s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/eg; - - return $url; -} - -sub url_unescape { - my $url = shift; - - $url =~ s/\%([a-fA-F0-9]{2})/pack("C", hex($1))/eg; - - return $url; -} - - - - - - - - - - - - - - - - - - - - -# Net::FTP.pm -# -# Copyright (c) 1995-2004 Graham Barr . All rights reserved. -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -# Documentation (at end) improved 1996 by Nathan Torkington . - -package Net::FTP; - -require 5.001; - -use strict; -use vars qw(@ISA $VERSION); -use Carp; - -use Socket 1.3; -use IO::Socket; -use Time::Local; -use Net::Cmd; -use Net::Config; -use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC); -# use AutoLoader qw(AUTOLOAD); - -$VERSION = "2.75"; -@ISA = qw(Exporter Net::Cmd IO::Socket::INET); - -# Someday I will "use constant", when I am not bothered to much about -# compatability with older releases of perl - -use vars qw($TELNET_IAC $TELNET_IP $TELNET_DM); -($TELNET_IAC,$TELNET_IP,$TELNET_DM) = (255,244,242); - -# Name is too long for AutoLoad, it clashes with pasv_xfer -sub pasv_xfer_unique { - my($sftp,$sfile,$dftp,$dfile) = @_; - $sftp->pasv_xfer($sfile,$dftp,$dfile,1); -} - -BEGIN { - # make a constant so code is fast'ish - my $is_os390 = $^O eq 'os390'; - *trEBCDIC = sub () { $is_os390 } -} - -1; -# Having problems with AutoLoader -#__END__ - -sub new -{ - my $pkg = shift; - my ($peer,%arg); - if (@_ % 2) { - $peer = shift ; - %arg = @_; - } else { - %arg = @_; - $peer=delete $arg{Host}; - } - - my $host = $peer; - my $fire = undef; - my $fire_type = undef; - - if(exists($arg{Firewall}) || Net::Config->requires_firewall($peer)) - { - $fire = $arg{Firewall} - || $ENV{FTP_FIREWALL} - || $NetConfig{ftp_firewall} - || undef; - - if(defined $fire) - { - $peer = $fire; - delete $arg{Port}; - $fire_type = $arg{FirewallType} - || $ENV{FTP_FIREWALL_TYPE} - || $NetConfig{firewall_type} - || undef; - } - } - - my $ftp = $pkg->SUPER::new(PeerAddr => $peer, - PeerPort => $arg{Port} || 'ftp(21)', - LocalAddr => $arg{'LocalAddr'}, - Proto => 'tcp', - Timeout => defined $arg{Timeout} - ? $arg{Timeout} - : 120 - ) or return undef; - - ${*$ftp}{'net_ftp_host'} = $host; # Remote hostname - ${*$ftp}{'net_ftp_type'} = 'A'; # ASCII/binary/etc mode - ${*$ftp}{'net_ftp_blksize'} = abs($arg{'BlockSize'} || 10240); - - ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'}; - - ${*$ftp}{'net_ftp_firewall'} = $fire - if(defined $fire); - ${*$ftp}{'net_ftp_firewall_type'} = $fire_type - if(defined $fire_type); - - ${*$ftp}{'net_ftp_passive'} = int - exists $arg{Passive} - ? $arg{Passive} - : exists $ENV{FTP_PASSIVE} - ? $ENV{FTP_PASSIVE} - : defined $fire - ? $NetConfig{ftp_ext_passive} - : $NetConfig{ftp_int_passive}; # Whew! :-) - - $ftp->hash(exists $arg{Hash} ? $arg{Hash} : 0, 10240); - - $ftp->autoflush(1); - - $ftp->debug(exists $arg{Debug} ? $arg{Debug} : undef); - - unless ($ftp->response() == CMD_OK) - { - $ftp->close(); - $@ = $ftp->message; - undef $ftp; - } - - $ftp; -} - -## -## User interface methods -## - - -sub host { - my $me = shift; - ${*$me}{'net_ftp_host'}; -} - - -sub hash { - my $ftp = shift; # self - - my($h,$b) = @_; - unless($h) { - delete ${*$ftp}{'net_ftp_hash'}; - return [\*STDERR,0]; - } - ($h,$b) = (ref($h)? $h : \*STDOUT, $b || 10240); - select((select($h), $|=1)[0]); - $b = 512 if $b < 512; - ${*$ftp}{'net_ftp_hash'} = [$h, $b]; -} - -sub quit -{ - my $ftp = shift; - - $ftp->_QUIT; - $ftp->close; -} - -sub DESTROY {} - -sub ascii { shift->type('A',@_); } -sub binary { shift->type('I',@_); } - -sub ebcdic -{ - carp "TYPE E is unsupported, shall default to I"; - shift->type('E',@_); -} - -sub byte -{ - carp "TYPE L is unsupported, shall default to I"; - shift->type('L',@_); -} - -# Allow the user to send a command directly, BE CAREFUL !! - -sub quot -{ - my $ftp = shift; - my $cmd = shift; - - $ftp->command( uc $cmd, @_); - $ftp->response(); -} - -sub site -{ - my $ftp = shift; - - $ftp->command("SITE", @_); - $ftp->response(); -} - -sub mdtm -{ - my $ftp = shift; - my $file = shift; - - # Server Y2K bug workaround - # - # sigh; some idiotic FTP servers use ("19%d",tm.tm_year) instead of - # ("%d",tm.tm_year+1900). This results in an extra digit in the - # string returned. To account for this we allow an optional extra - # digit in the year. Then if the first two digits are 19 we use the - # remainder, otherwise we subtract 1900 from the whole year. - - $ftp->_MDTM($file) && $ftp->message =~ /((\d\d)(\d\d\d?))(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/ - ? timegm($8,$7,$6,$5,$4-1,$2 eq '19' ? $3 : ($1-1900)) - : undef; -} - -sub size { - my $ftp = shift; - my $file = shift; - my $io; - if($ftp->supported("SIZE")) { - return $ftp->_SIZE($file) - ? ($ftp->message =~ /(\d+)\s*(bytes?\s*)?$/)[0] - : undef; - } - elsif($ftp->supported("STAT")) { - my @msg; - return undef - unless $ftp->_STAT($file) && (@msg = $ftp->message) == 3; - my $line; - foreach $line (@msg) { - return (split(/\s+/,$line))[4] - if $line =~ /^[-rwxSsTt]{10}/ - } - } - else { - my @files = $ftp->dir($file); - if(@files) { - return (split(/\s+/,$1))[4] - if $files[0] =~ /^([-rwxSsTt]{10}.*)$/; - } - } - undef; -} - -sub login { - my($ftp,$user,$pass,$acct) = @_; - my($ok,$ruser,$fwtype); - - unless (defined $user) { - require Net::Netrc; - - my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}); - - ($user,$pass,$acct) = $rc->lpa() - if ($rc); - } - - $user ||= "anonymous"; - $ruser = $user; - - $fwtype = ${*$ftp}{'net_ftp_firewall_type'} - || $NetConfig{'ftp_firewall_type'} - || 0; - - if ($fwtype && defined ${*$ftp}{'net_ftp_firewall'}) { - if ($fwtype == 1 || $fwtype == 7) { - $user .= '@' . ${*$ftp}{'net_ftp_host'}; - } - else { - require Net::Netrc; - - my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}); - - my($fwuser,$fwpass,$fwacct) = $rc ? $rc->lpa() : (); - - if ($fwtype == 5) { - $user = join('@',$user,$fwuser,${*$ftp}{'net_ftp_host'}); - $pass = $pass . '@' . $fwpass; - } - else { - if ($fwtype == 2) { - $user .= '@' . ${*$ftp}{'net_ftp_host'}; - } - elsif ($fwtype == 6) { - $fwuser .= '@' . ${*$ftp}{'net_ftp_host'}; - } - - $ok = $ftp->_USER($fwuser); - - return 0 unless $ok == CMD_OK || $ok == CMD_MORE; - - $ok = $ftp->_PASS($fwpass || ""); - - return 0 unless $ok == CMD_OK || $ok == CMD_MORE; - - $ok = $ftp->_ACCT($fwacct) - if defined($fwacct); - - if ($fwtype == 3) { - $ok = $ftp->command("SITE",${*$ftp}{'net_ftp_host'})->response; - } - elsif ($fwtype == 4) { - $ok = $ftp->command("OPEN",${*$ftp}{'net_ftp_host'})->response; - } - - return 0 unless $ok == CMD_OK || $ok == CMD_MORE; - } - } - } - - $ok = $ftp->_USER($user); - - # Some dumb firewalls don't prefix the connection messages - $ok = $ftp->response() - if ($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/); - - if ($ok == CMD_MORE) { - unless(defined $pass) { - require Net::Netrc; - - my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser); - - ($ruser,$pass,$acct) = $rc->lpa() - if ($rc); - - $pass = '-anonymous@' - if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o)); - } - - $ok = $ftp->_PASS($pass || ""); - } - - $ok = $ftp->_ACCT($acct) - if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK)); - - if ($fwtype == 7 && $ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}) { - my($f,$auth,$resp) = _auth_id($ftp); - $ftp->authorize($auth,$resp) if defined($resp); - } - - $ok == CMD_OK; -} - -sub account -{ - @_ == 2 or croak 'usage: $ftp->account( ACCT )'; - my $ftp = shift; - my $acct = shift; - $ftp->_ACCT($acct) == CMD_OK; -} - -sub _auth_id { - my($ftp,$auth,$resp) = @_; - - unless(defined $resp) - { - require Net::Netrc; - - $auth ||= eval { (getpwuid($>))[0] } || $ENV{NAME}; - - my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth) - || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}); - - ($auth,$resp) = $rc->lpa() - if ($rc); - } - ($ftp,$auth,$resp); -} - -sub authorize -{ - @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])'; - - my($ftp,$auth,$resp) = &_auth_id; - - my $ok = $ftp->_AUTH($auth || ""); - - $ok = $ftp->_RESP($resp || "") - if ($ok == CMD_MORE); - - $ok == CMD_OK; -} - -sub rename -{ - @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)'; - - my($ftp,$from,$to) = @_; - - $ftp->_RNFR($from) - && $ftp->_RNTO($to); -} - -sub type -{ - my $ftp = shift; - my $type = shift; - my $oldval = ${*$ftp}{'net_ftp_type'}; - - return $oldval - unless (defined $type); - - return undef - unless ($ftp->_TYPE($type,@_)); - - ${*$ftp}{'net_ftp_type'} = join(" ",$type,@_); - - $oldval; -} - -sub alloc -{ - my $ftp = shift; - my $size = shift; - my $oldval = ${*$ftp}{'net_ftp_allo'}; - - return $oldval - unless (defined $size); - - return undef - unless ($ftp->_ALLO($size,@_)); - - ${*$ftp}{'net_ftp_allo'} = join(" ",$size,@_); - - $oldval; -} - -sub abort -{ - my $ftp = shift; - - send($ftp,pack("CCC", $TELNET_IAC, $TELNET_IP, $TELNET_IAC),MSG_OOB); - - $ftp->command(pack("C",$TELNET_DM) . "ABOR"); - - ${*$ftp}{'net_ftp_dataconn'}->close() - if defined ${*$ftp}{'net_ftp_dataconn'}; - - $ftp->response(); - - $ftp->status == CMD_OK; -} - -sub get -{ - my($ftp,$remote,$local,$where) = @_; - - my($loc,$len,$buf,$resp,$data); - local *FD; - - my $localfd = ref($local) || ref(\$local) eq "GLOB"; - - ($local = $remote) =~ s#^.*/## - unless(defined $local); - - croak("Bad remote filename '$remote'\n") - if $remote =~ /[\r\n]/s; - - ${*$ftp}{'net_ftp_rest'} = $where if defined $where; - my $rest = ${*$ftp}{'net_ftp_rest'}; - - delete ${*$ftp}{'net_ftp_port'}; - delete ${*$ftp}{'net_ftp_pasv'}; - - $data = $ftp->retr($remote) or - return undef; - - if($localfd) - { - $loc = $local; - } - else - { - $loc = \*FD; - - unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($rest ? O_APPEND : O_TRUNC))) - { - carp "Cannot open Local file $local: $!\n"; - $data->abort; - return undef; - } - } - - if($ftp->type eq 'I' && !binmode($loc)) - { - carp "Cannot binmode Local file $local: $!\n"; - $data->abort; - close($loc) unless $localfd; - return undef; - } - - $buf = ''; - my($count,$hashh,$hashb,$ref) = (0); - - ($hashh,$hashb) = @$ref - if($ref = ${*$ftp}{'net_ftp_hash'}); - - my $blksize = ${*$ftp}{'net_ftp_blksize'}; - local $\; # Just in case - - while(1) - { - last unless $len = $data->read($buf,$blksize); - - if (trEBCDIC && $ftp->type ne 'I') - { - $buf = $ftp->toebcdic($buf); - $len = length($buf); - } - - if($hashh) { - $count += $len; - print $hashh "# " x (int($count / $hashb)); - $count %= $hashb; - } - unless(print $loc $buf) - { - carp "Cannot write to Local file $local: $!\n"; - $data->abort; - close($loc) - unless $localfd; - return undef; - } - } - - print $hashh "\n" if $hashh; - - unless ($localfd) - { - unless (close($loc)) - { - carp "Cannot close file $local (perhaps disk space) $!\n"; - return undef; - } - } - - unless ($data->close()) # implied $ftp->response - { - carp "Unable to close datastream"; - return undef; - } - - return $local; -} - -sub cwd -{ - @_ == 1 || @_ == 2 or croak 'usage: $ftp->cwd( [ DIR ] )'; - - my($ftp,$dir) = @_; - - $dir = "/" unless defined($dir) && $dir =~ /\S/; - - $dir eq ".." - ? $ftp->_CDUP() - : $ftp->_CWD($dir); -} - -sub cdup -{ - @_ == 1 or croak 'usage: $ftp->cdup()'; - $_[0]->_CDUP; -} - -sub pwd -{ - @_ == 1 || croak 'usage: $ftp->pwd()'; - my $ftp = shift; - - $ftp->_PWD(); - $ftp->_extract_path; -} - -# rmdir( $ftp, $dir, [ $recurse ] ) -# -# Removes $dir on remote host via FTP. -# $ftp is handle for remote host -# -# If $recurse is TRUE, the directory and deleted recursively. -# This means all of its contents and subdirectories. -# -# Initial version contributed by Dinkum Software -# -sub rmdir -{ - @_ == 2 || @_ == 3 or croak('usage: $ftp->rmdir( DIR [, RECURSE ] )'); - - # Pick off the args - my ($ftp, $dir, $recurse) = @_ ; - my $ok; - - return $ok - if $ok = $ftp->_RMD( $dir ) or !$recurse; - - # Try to delete the contents - # Get a list of all the files in the directory - my @filelist = grep { !/^\.{1,2}$/ } $ftp->ls($dir); - - return undef - unless @filelist; # failed, it is probably not a directory - - # Go thru and delete each file or the directory - my $file; - foreach $file (map { m,/, ? $_ : "$dir/$_" } @filelist) - { - next # successfully deleted the file - if $ftp->delete($file); - - # Failed to delete it, assume its a directory - # Recurse and ignore errors, the final rmdir() will - # fail on any errors here - return $ok - unless $ok = $ftp->rmdir($file, 1) ; - } - - # Directory should be empty - # Try to remove the directory again - # Pass results directly to caller - # If any of the prior deletes failed, this - # rmdir() will fail because directory is not empty - return $ftp->_RMD($dir) ; -} - -sub restart -{ - @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )'; - - my($ftp,$where) = @_; - - ${*$ftp}{'net_ftp_rest'} = $where; - - return undef; -} - - -sub mkdir -{ - @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )'; - - my($ftp,$dir,$recurse) = @_; - - $ftp->_MKD($dir) || $recurse or - return undef; - - my $path = $dir; - - unless($ftp->ok) - { - my @path = split(m#(?=/+)#, $dir); - - $path = ""; - - while(@path) - { - $path .= shift @path; - - $ftp->_MKD($path); - - $path = $ftp->_extract_path($path); - } - - # If the creation of the last element was not successful, see if we - # can cd to it, if so then return path - - unless($ftp->ok) - { - my($status,$message) = ($ftp->status,$ftp->message); - my $pwd = $ftp->pwd; - - if($pwd && $ftp->cwd($dir)) - { - $path = $dir; - $ftp->cwd($pwd); - } - else - { - undef $path; - } - $ftp->set_status($status,$message); - } - } - - $path; -} - -sub delete -{ - @_ == 2 || croak 'usage: $ftp->delete( FILENAME )'; - - $_[0]->_DELE($_[1]); -} - -sub put { shift->_store_cmd("stor",@_) } -sub put_unique { shift->_store_cmd("stou",@_) } -sub append { shift->_store_cmd("appe",@_) } - -sub nlst { shift->_data_cmd("NLST",@_) } -sub list { shift->_data_cmd("LIST",@_) } -sub retr { shift->_data_cmd("RETR",@_) } -sub stor { shift->_data_cmd("STOR",@_) } -sub stou { shift->_data_cmd("STOU",@_) } -sub appe { shift->_data_cmd("APPE",@_) } - -sub _store_cmd -{ - my($ftp,$cmd,$local,$remote) = @_; - my($loc,$sock,$len,$buf); - local *FD; - - my $localfd = ref($local) || ref(\$local) eq "GLOB"; - - unless(defined $remote) - { - croak 'Must specify remote filename with stream input' - if $localfd; - - require File::Basename; - $remote = File::Basename::basename($local); - } - if( defined ${*$ftp}{'net_ftp_allo'} ) - { - delete ${*$ftp}{'net_ftp_allo'}; - } else - { - # if the user hasn't already invoked the alloc method since the last - # _store_cmd call, figure out if the local file is a regular file(not - # a pipe, or device) and if so get the file size from stat, and send - # an ALLO command before sending the STOR, STOU, or APPE command. - my $size = do { local $^W; -f $local && -s _ }; # no ALLO if sending data from a pipe - $ftp->_ALLO($size) if $size; - } - croak("Bad remote filename '$remote'\n") - if $remote =~ /[\r\n]/s; - - if($localfd) - { - $loc = $local; - } - else - { - $loc = \*FD; - - unless(sysopen($loc, $local, O_RDONLY)) - { - carp "Cannot open Local file $local: $!\n"; - return undef; - } - } - - if($ftp->type eq 'I' && !binmode($loc)) - { - carp "Cannot binmode Local file $local: $!\n"; - return undef; - } - - delete ${*$ftp}{'net_ftp_port'}; - delete ${*$ftp}{'net_ftp_pasv'}; - - $sock = $ftp->_data_cmd($cmd, $remote) or - return undef; - - $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0] - if 'STOU' eq uc $cmd; - - my $blksize = ${*$ftp}{'net_ftp_blksize'}; - - my($count,$hashh,$hashb,$ref) = (0); - - ($hashh,$hashb) = @$ref - if($ref = ${*$ftp}{'net_ftp_hash'}); - - while(1) - { - last unless $len = read($loc,$buf="",$blksize); - - if (trEBCDIC && $ftp->type ne 'I') - { - $buf = $ftp->toascii($buf); - $len = length($buf); - } - - if($hashh) { - $count += $len; - print $hashh "# " x (int($count / $hashb)); - $count %= $hashb; - } - - my $wlen; - unless(defined($wlen = $sock->write($buf,$len)) && $wlen == $len) - { - $sock->abort; - close($loc) - unless $localfd; - print $hashh "\n" if $hashh; - return undef; - } - } - - print $hashh "\n" if $hashh; - - close($loc) - unless $localfd; - - $sock->close() or - return undef; - - if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\s+file\s*name\s*:\s*(.*)\)|"(.*)"/) - { - require File::Basename; - $remote = File::Basename::basename($+) - } - - return $remote; -} - -sub port -{ - @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])'; - - my($ftp,$port) = @_; - my $ok; - - delete ${*$ftp}{'net_ftp_intern_port'}; - - unless(defined $port) - { - # create a Listen socket at same address as the command socket - - ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(Listen => 5, - Proto => 'tcp', - Timeout => $ftp->timeout, - LocalAddr => $ftp->sockhost, - ); - - my $listen = ${*$ftp}{'net_ftp_listen'}; - - my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost)); - - $port = join(',', @myaddr, $myport >> 8, $myport & 0xff); - - ${*$ftp}{'net_ftp_intern_port'} = 1; - } - - $ok = $ftp->_PORT($port); - - ${*$ftp}{'net_ftp_port'} = $port; - - $ok; -} - -sub ls { shift->_list_cmd("NLST",@_); } -sub dir { shift->_list_cmd("LIST",@_); } - -sub pasv -{ - @_ == 1 or croak 'usage: $ftp->pasv()'; - - my $ftp = shift; - - delete ${*$ftp}{'net_ftp_intern_port'}; - - $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/ - ? ${*$ftp}{'net_ftp_pasv'} = $1 - : undef; -} - -sub unique_name -{ - my $ftp = shift; - ${*$ftp}{'net_ftp_unique'} || undef; -} - -sub supported { - @_ == 2 or croak 'usage: $ftp->supported( CMD )'; - my $ftp = shift; - my $cmd = uc shift; - my $hash = ${*$ftp}{'net_ftp_supported'} ||= {}; - - return $hash->{$cmd} - if exists $hash->{$cmd}; - - return $hash->{$cmd} = 0 - unless $ftp->_HELP($cmd); - - my $text = $ftp->message; - if($text =~ /following\s+commands/i) { - $text =~ s/^.*\n//; - while($text =~ /(\*?)(\w+)(\*?)/sg) { - $hash->{"\U$2"} = !length("$1$3"); - } - } - else { - $hash->{$cmd} = $text !~ /unimplemented/i; - } - - $hash->{$cmd} ||= 0; -} - -## -## Deprecated methods -## - -sub lsl -{ - carp "Use of Net::FTP::lsl deprecated, use 'dir'" - if $^W; - goto &dir; -} - -sub authorise -{ - carp "Use of Net::FTP::authorise deprecated, use 'authorize'" - if $^W; - goto &authorize; -} - - -## -## Private methods -## - -sub _extract_path -{ - my($ftp, $path) = @_; - - # This tries to work both with and without the quote doubling - # convention (RFC 959 requires it, but the first 3 servers I checked - # didn't implement it). It will fail on a server which uses a quote in - # the message which isn't a part of or surrounding the path. - $ftp->ok && - $ftp->message =~ /(?:^|\s)\"(.*)\"(?:$|\s)/ && - ($path = $1) =~ s/\"\"/\"/g; - - $path; -} - -## -## Communication methods -## - -sub _dataconn -{ - my $ftp = shift; - my $data = undef; - my $pkg = "Net::FTP::" . $ftp->type; - - eval "require " . $pkg; - - $pkg =~ s/ /_/g; - - delete ${*$ftp}{'net_ftp_dataconn'}; - - if(defined ${*$ftp}{'net_ftp_pasv'}) - { - my @port = map { 0+$_ } split(/,/,${*$ftp}{'net_ftp_pasv'}); - - $data = $pkg->new(PeerAddr => join(".",@port[0..3]), - PeerPort => $port[4] * 256 + $port[5], - LocalAddr => ${*$ftp}{'net_ftp_localaddr'}, - Proto => 'tcp' - ); - } - elsif(defined ${*$ftp}{'net_ftp_listen'}) - { - $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg); - close(delete ${*$ftp}{'net_ftp_listen'}); - } - - if($data) - { - ${*$data} = ""; - $data->timeout($ftp->timeout); - ${*$ftp}{'net_ftp_dataconn'} = $data; - ${*$data}{'net_ftp_cmd'} = $ftp; - ${*$data}{'net_ftp_blksize'} = ${*$ftp}{'net_ftp_blksize'}; - } - - $data; -} - -sub _list_cmd -{ - my $ftp = shift; - my $cmd = uc shift; - - delete ${*$ftp}{'net_ftp_port'}; - delete ${*$ftp}{'net_ftp_pasv'}; - - my $data = $ftp->_data_cmd($cmd,@_); - - return - unless(defined $data); - - require Net::FTP::A; - bless $data, "Net::FTP::A"; # Force ASCII mode - - my $databuf = ''; - my $buf = ''; - my $blksize = ${*$ftp}{'net_ftp_blksize'}; - - while($data->read($databuf,$blksize)) { - $buf .= $databuf; - } - - my $list = [ split(/\n/,$buf) ]; - - $data->close(); - - if (trEBCDIC) - { - for (@$list) { $_ = $ftp->toebcdic($_) } - } - - wantarray ? @{$list} - : $list; -} - -sub _data_cmd -{ - my $ftp = shift; - my $cmd = uc shift; - my $ok = 1; - my $where = delete ${*$ftp}{'net_ftp_rest'} || 0; - my $arg; - - for $arg (@_) { - croak("Bad argument '$arg'\n") - if $arg =~ /[\r\n]/s; - } - - if(${*$ftp}{'net_ftp_passive'} && - !defined ${*$ftp}{'net_ftp_pasv'} && - !defined ${*$ftp}{'net_ftp_port'}) - { - my $data = undef; - - $ok = defined $ftp->pasv; - $ok = $ftp->_REST($where) - if $ok && $where; - - if($ok) - { - $ftp->command($cmd,@_); - $data = $ftp->_dataconn(); - $ok = CMD_INFO == $ftp->response(); - if($ok) - { - $data->reading - if $data && $cmd =~ /RETR|LIST|NLST/; - return $data - } - $data->_close - if $data; - } - return undef; - } - - $ok = $ftp->port - unless (defined ${*$ftp}{'net_ftp_port'} || - defined ${*$ftp}{'net_ftp_pasv'}); - - $ok = $ftp->_REST($where) - if $ok && $where; - - return undef - unless $ok; - - $ftp->command($cmd,@_); - - return 1 - if(defined ${*$ftp}{'net_ftp_pasv'}); - - $ok = CMD_INFO == $ftp->response(); - - return $ok - unless exists ${*$ftp}{'net_ftp_intern_port'}; - - if($ok) { - my $data = $ftp->_dataconn(); - - $data->reading - if $data && $cmd =~ /RETR|LIST|NLST/; - - return $data; - } - - - close(delete ${*$ftp}{'net_ftp_listen'}); - - return undef; -} - -## -## Over-ride methods (Net::Cmd) -## - -sub debug_text { $_[2] =~ /^(pass|resp|acct)/i ? "$1 ....\n" : $_[2]; } - -sub command -{ - my $ftp = shift; - - delete ${*$ftp}{'net_ftp_port'}; - $ftp->SUPER::command(@_); -} - -sub response -{ - my $ftp = shift; - my $code = $ftp->SUPER::response(); - - delete ${*$ftp}{'net_ftp_pasv'} - if ($code != CMD_MORE && $code != CMD_INFO); - - $code; -} - -sub parse_response -{ - return ($1, $2 eq "-") - if $_[1] =~ s/^(\d\d\d)(.?)//o; - - my $ftp = shift; - - # Darn MS FTP server is a load of CRAP !!!! - return () - unless ${*$ftp}{'net_cmd_code'} + 0; - - (${*$ftp}{'net_cmd_code'},1); -} - -## -## Allow 2 servers to talk directly -## - -sub pasv_xfer { - my($sftp,$sfile,$dftp,$dfile,$unique) = @_; - - ($dfile = $sfile) =~ s#.*/## - unless(defined $dfile); - - my $port = $sftp->pasv or - return undef; - - $dftp->port($port) or - return undef; - - return undef - unless($unique ? $dftp->stou($dfile) : $dftp->stor($dfile)); - - unless($sftp->retr($sfile) && $sftp->response == CMD_INFO) { - $sftp->retr($sfile); - $dftp->abort; - $dftp->response(); - return undef; - } - - $dftp->pasv_wait($sftp); -} - -sub pasv_wait -{ - @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)'; - - my($ftp, $non_pasv) = @_; - my($file,$rin,$rout); - - vec($rin='',fileno($ftp),1) = 1; - select($rout=$rin, undef, undef, undef); - - $ftp->response(); - $non_pasv->response(); - - return undef - unless $ftp->ok() && $non_pasv->ok(); - - return $1 - if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/; - - return $1 - if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/; - - return 1; -} - -sub cmd { shift->command(@_)->response() } - -######################################## -# -# RFC959 commands -# - -sub _ABOR { shift->command("ABOR")->response() == CMD_OK } -sub _ALLO { shift->command("ALLO",@_)->response() == CMD_OK} -sub _CDUP { shift->command("CDUP")->response() == CMD_OK } -sub _NOOP { shift->command("NOOP")->response() == CMD_OK } -sub _PASV { shift->command("PASV")->response() == CMD_OK } -sub _QUIT { shift->command("QUIT")->response() == CMD_OK } -sub _DELE { shift->command("DELE",@_)->response() == CMD_OK } -sub _CWD { shift->command("CWD", @_)->response() == CMD_OK } -sub _PORT { shift->command("PORT",@_)->response() == CMD_OK } -sub _RMD { shift->command("RMD", @_)->response() == CMD_OK } -sub _MKD { shift->command("MKD", @_)->response() == CMD_OK } -sub _PWD { shift->command("PWD", @_)->response() == CMD_OK } -sub _TYPE { shift->command("TYPE",@_)->response() == CMD_OK } -sub _RNTO { shift->command("RNTO",@_)->response() == CMD_OK } -sub _RESP { shift->command("RESP",@_)->response() == CMD_OK } -sub _MDTM { shift->command("MDTM",@_)->response() == CMD_OK } -sub _SIZE { shift->command("SIZE",@_)->response() == CMD_OK } -sub _HELP { shift->command("HELP",@_)->response() == CMD_OK } -sub _STAT { shift->command("STAT",@_)->response() == CMD_OK } -sub _APPE { shift->command("APPE",@_)->response() == CMD_INFO } -sub _LIST { shift->command("LIST",@_)->response() == CMD_INFO } -sub _NLST { shift->command("NLST",@_)->response() == CMD_INFO } -sub _RETR { shift->command("RETR",@_)->response() == CMD_INFO } -sub _STOR { shift->command("STOR",@_)->response() == CMD_INFO } -sub _STOU { shift->command("STOU",@_)->response() == CMD_INFO } -sub _RNFR { shift->command("RNFR",@_)->response() == CMD_MORE } -sub _REST { shift->command("REST",@_)->response() == CMD_MORE } -sub _USER { shift->command("user",@_)->response() } # A certain brain dead firewall :-) -sub _PASS { shift->command("PASS",@_)->response() } -sub _ACCT { shift->command("ACCT",@_)->response() } -sub _AUTH { shift->command("AUTH",@_)->response() } - -sub _SMNT { shift->unsupported(@_) } -sub _MODE { shift->unsupported(@_) } -sub _SYST { shift->unsupported(@_) } -sub _STRU { shift->unsupported(@_) } -sub _REIN { shift->unsupported(@_) } - -1;