It is simple:
http://www.drftpd.org/index.php/Pftp_pret_patch
See my patch for add ftp pret support but without support for pret stor.
Message body is not shown because it is too large.
Net-FTPSSL Version: 0.20
Perl: 5.010001 [5.10.1], OS: MSWin32
Server (port): localhost (33333)
Keys: (Debug), (Encryption), (PreserveTimestamp), (Pret), (Port), (DebugLogFile)
Values: (1), (E), (1), (1), (33333), (myLog.txt)
SKT <<< 220 OFFLiNE
SKT >>> AUTH TLS
SKT <<< 234 AUTH TLS successful
>>> USER +++++++
<<< 331 Password required for <++++++>.
>>> PASS *******
<<< 2
<<< 30-
<<< 230- Welcome to the future of FXP:ing
<<< 230- ___ _____________ ___
<<< 230- / _ \____/ __/_ __/ _ \/ _ \
<<< 230- / // / __/ _/ / / / ___/ // /
<<< 230- /____/_/ /_/ /_/ /_/ /____/
<<< 230- DistRibuted FTP Daemon
<<< 230-
http://drftpd.org
<<< 230 <++++++> logged in successfully.
>>> HELP
<<< 5
<<< 00 No command handler for HELP
<<+ 502 Unknown command MFMT.
<<+ 502 Unknown command MDTM.
>>> CWD /XVID/
<<< 250 Directory changed to /XVID/
>>> PBSZ 0
<<< 2
<<< 00 Command okay
>>> PROT P
<<< 2
<<< 00 Command okay
>>> PASV
<<< 5
<<< 00 You need to use a client supporting PRET (PRE Transfer) to use PASV
--- Host () Port ()
>>> LIST /XVID/
<<< 5
<<< 03 Bad sequence of commands.
--- /usr/local/share/perl/5.12.4/Net/FTPSSL.pm 2012-01-01 18:48:03.000000000 +0100
+++ /root/FTPSSL.pm 2012-02-03 10:14:10.000000000 +0100
@@ -105,6 +105,7 @@
my $use_ssl = $arg->{useSSL} || 0;
my $die = $arg->{Croak} || $arg->{Die};
my $pres_ts = $arg->{PreserveTimestamp} || 0;
+ my $pret = $arg->{Pret} || 0;
my $use_logfile = $debug && (defined $arg->{DebugLogFile} &&
$arg->{DebugLogFile} ne "");
my $localaddr = $ssl_args{LocalAddr} || $arg->{LocalAddr};
@@ -273,6 +274,7 @@
${*$obj}{buf_size} = $buf_size;
${*$obj}{type} = MODE_ASCII;
${*$obj}{data_prot} = $data_prot;
+ ${*$obj}{pret} = $pret;
${*$obj}{Croak} = $die;
${*$obj}{FixPutTs} = ${*$obj}{FixGetTs} = $pres_ts;
${*$obj}{OverridePASV} = $pasvHost;
@@ -370,9 +372,15 @@
sub _pasv {
my $self = shift;
- unless ( $self->command ("PASV")->response () == CMD_OK ) {
- return $self->_croak_or_return ();
+ if ( ${*$self}{pret} ) {
+ unless ( $self->command ("PRET LIST")->response () == CMD_OK ) {
+ return $self->_croak_or_return ();
+ }
}
+ unless ( $self->command ("PASV")->response () == CMD_OK ) {
+ return $self->_croak_or_return ();
+ }
+
# [227] [Entering Passive Mode] ([h1,h2,h3,h4,p1,p2]).
my $msg = $self->last_message ();
@@ -490,7 +498,6 @@
if ( ${*$self}{data_prot} eq DATA_PROT_PRIVATE && exists (${*$self}{myContext}) ) {
my %ssl_opts = %{${*$self}{myContext}};
my $mode = $ssl_opts{SSL_version};
-
$io = IO::Socket::SSL->start_SSL ( ${*$self}{data_ch}, \%ssl_opts )
or return _croak_or_return ( $io, undef,
"$mode: " . IO::Socket::SSL::errstr () );
@@ -843,12 +850,17 @@
return undef; # Already decided not to call croak if you get here!
}
+ if ( ${*$self}{pret} ) {
+ $self->_pret_retr($file_rem);
+ $self->_pret_pasv($file_rem);
+ }
+
+
# "(caller(1))[3]" returns undef if not called by another Net::FTPSSL method!
my $c = (caller(1))[3];
my $cb_idx = ( defined $c && $c eq "Net::FTPSSL::xget" ) ? 2 : 1;
my $func = ( $cb_idx == 1 ) ? "get" : "xget";
-
# Check if the "get" failed ...
my $rest = ($offset) ? $self->_rest ($offset) : 1;
unless ( $rest && $self->_retr($file_rem) ) {
@@ -1685,6 +1697,33 @@
return ( $self->command ( "RETR", @_ )->response () == CMD_INFO );
}
+sub _pret_retr {
+ my $self = shift;
+ return ( $self->command ( "PRET RETR", @_ )->response () == CMD_INFO );
+}
+
+sub _pret_pasv {
+ my $self = shift;
+
+ unless ( $self->command ("PASV")->response () == CMD_OK ) {
+ return $self->_croak_or_return ();
+ }
+
+ my $msg = $self->last_message ();
+ unless ($msg =~ m/(\d+)\s(.*)\(((\d+,?)+)\)\.?/) {
+ return $self->_croak_or_return (0, "Can't parse the PASV response.");
+ }
+
+ my @address = split( /,/, $3 );
+
+ my $host = join( '.', @address[ 0 .. 3 ] );
+ my $port = $address[4] * 256 + $address[5];
+
+ $self->_print_DBG ("--- Host ($host) Port ($port) - PRET PASV\n");
+
+ return ( $self->_open_data_channel ($host, $port) );
+}
+
sub _stor {
my $self = shift;
return ( $self->command ( "STOR", @_ )->response () == CMD_INFO );
