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
+
+
+
+ ";
+ }
+
+ $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;