From 03b3cccfe1c104efd80ede503967a1e70bcba81b Mon Sep 17 00:00:00 2001 From: Malin Date: Thu, 22 Sep 2016 09:47:08 +0200 Subject: [PATCH] Upload files to '' --- transfer.pl | 1974 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1974 insertions(+) create mode 100644 transfer.pl diff --git a/transfer.pl b/transfer.pl new file mode 100644 index 0000000..7c9fea6 --- /dev/null +++ b/transfer.pl @@ -0,0 +1,1974 @@ +#!/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;