Re: FTP.pm difficulty
Andreas Koenig (k@anna.mind.de)
Thu, 16 Nov 1995 11:47:37 +0100
>>>>> "steve" == Stephen M Beckstrom-Sternberg <sbeckstr@rapd.gig.usda.gov> writes:
steve> I have been unsuccessful in attempting to retrieve a file via
steve> anonymous FTP using libwww-perl5b5 (yes, I will be getting 5b6!).
steve> My test script is below. What am I doing wrong?
the CPAN upload service uses libwww-perl5b5 successfully for http
fetches, but I was out of luck with the ftp interface. Files >~ 70k
got truncated at unpredictable thresholds.
My workaround is to use Graham Barr's Net::FTP module
(Net-FTP-1.01a.tar.gz). Get it from CPAN (see
modules/01modules.index.html)
You could do us all a favor, if you tried it with 5b6 (I don't
have time right now to switch).
And if you want, you can further hack on my implementation of
LWP::Protocol::ftp which uses Graham's Net::FTP internally at the
price, that it only does file-to-file GET, not file-to-scalar, and not
file-to-subroutine. Gisle has this version, and had no time since to
judge it. At least I *know* it works fine for CPAN.
I append the diffs below.
andreas
--- /usr/local/lib/perl5/LWP/Protocol/ftp.pm Fri Nov 3 19:13:14 1995
+++ ftp.pm Thu Sep 28 21:39:50 1995
@@ -12,7 +12,7 @@
require HTTP::Status;
require LWP::MediaTypes;
-
+require Net::FTP;
use Carp;
@ISA = qw(LWP::Protocol);
@@ -22,6 +22,10 @@
{
my($self, $request, $proxy, $arg, $size, $timeout) = @_;
+ unless (defined $arg && ref \$arg eq 'SCALAR') {
+ Carp::croak "Protocol::ftp only defined for output into a named file";
+ }
+
LWP::Debug::trace('ftp-request(' .
(defined $request ? $request : '<undef>') . ', ' .
(defined $arg ? $arg : '<undef>') . ', ' .
@@ -54,8 +58,13 @@
my $host = $url->host;
my $port = $url->port;
- my $user = $url->user;
- my $password = $url->password;
+ my $user = $url->user || "ftp";
+ unless (my $password = $url->password) {
+ require Sys::Hostname;
+ my $username = $ENV{USERNAME} || $ENV{LOGNAME} || $ENV{USER};
+ my $hostname = Sys::Hostname::hostname;
+ $password = "$username\@$hostname";
+ }
my $path = $url->full_path;
@@ -166,70 +175,92 @@
my $response;
- my $cmd_sock = new LWP::Socket;
- alarm($timeout) if $self->useAlarm and defined $timeout;
- $cmd_sock->connect($host, $port);
-
- eval {
- expect($cmd_sock, '2');
- $cmd_sock->write("user $user\r\n");
- expect($cmd_sock, '3');
- $cmd_sock->write("pass $password\r\n");
- expect($cmd_sock, '2');
- };
- if ($@) {
- return new HTTP::Response &HTTP::Status::RC_UNAUTHORIZED, $@;
- }
- eval {
- $cmd_sock->write("type i\r\n");
- expect($cmd_sock, '2');
-
- # establish a data socket
- $listen = new LWP::Socket;
- $listen->listen(1);
- my $localhost = ($cmd_sock->getsockname)[0];
- $localhost =~ s/\./,/g;
- my $port = ($listen->getsockname)[1];
- $port = join(',', $port >> 8, $port & 0xFF);
-
- $cmd_sock->write("port $localhost,$port\r\n");
- $resp = expect($cmd_sock, '2');
-
- if ($method eq 'GET') {
- $cmd_sock->write("retr $path\r\n");
- $resp = expect($cmd_sock, '1', 1);
+# my $cmd_sock = new LWP::Socket;
+# alarm($timeout) if $self->useAlarm and defined $timeout;
+# $cmd_sock->connect($host, $port);
+
+# eval {
+# expect($cmd_sock, '2');
+# $cmd_sock->write("user $user\r\n");
+# expect($cmd_sock, '3');
+# $cmd_sock->write("pass $password\r\n");
+# expect($cmd_sock, '2');
+# };
+
+ my $ftp = new Net::FTP $host; # croaks if the host is unknown
+ $ftp->timeout($timeout) if defined $timeout;
+ unless ($ftp->login($user,$password)) {
+ #not good -> RC_UNAUTHORIZED without WWW-Authenticate
+ #return new HTTP::Response &HTTP::Status::RC_UNAUTHORIZED, $@;
+ # better?
+ return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST, $@;
+ }
+ $ftp->binary;
+
+# if ($@) {
+# return new HTTP::Response &HTTP::Status::RC_UNAUTHORIZED, $@;
+# }
+# eval {
+# $cmd_sock->write("type i\r\n");
+# expect($cmd_sock, '2');
+
+# # establish a data socket
+# $listen = new LWP::Socket;
+# $listen->listen(1);
+# my $localhost = ($cmd_sock->getsockname)[0];
+# $localhost =~ s/\./,/g;
+# my $port = ($listen->getsockname)[1];
+# $port = join(',', $port >> 8, $port & 0xFF);
+#
+# $cmd_sock->write("port $localhost,$port\r\n");
+# $resp = expect($cmd_sock, '2');
+
+ my @path = split "/", $path;
+ my $remote_filename = pop @path;
+ for (@path) {
+ ##decode here
+ $ftp->cwd($_);
+ }
+
+ if ($method eq 'GET') {
+ if ($ftp->get($remote_filename, $arg)) {
+# $cmd_sock->write("retr $path\r\n");
+# $resp = expect($cmd_sock, '1', 1);
$response = new HTTP::Response &HTTP::Status::RC_OK,
- 'Document follows';
- if ($resp =~ /\((\d+)\s+bytes\)/) {
- $response->header('Content-Length', $1);
- }
+ 'Document follows';
+# if ($resp =~ /\((\d+)\s+bytes\)/) {
+# $response->header('Content-Length', $1);
+# }
my($type, @enc) = LWP::MediaTypes::guessMediaType($url);
$response->header('Content-Type', $type) if $type;
for (@enc) {
$response->pushHeader('Content-Encoding', $_);
}
-
- if ($resp =~ /^550/) {
- # 550 not a plain file, try to list instead
- $cmd_sock->write("list $path\r\n");
- expect($cmd_sock, '1');
- $response->header('Content-Type', # should be text/html
+
+ } elsif ($ftp->{Code} == 550) { ###attn, better change Net::FTP to have a code method
+# # 550 not a plain file, try to list instead
+# $cmd_sock->write("list $path\r\n");
+# expect($cmd_sock, '1');
+ $response = new HTTP::Response &HTTP::Status::RC_OK,
+ $response->header('Content-Type', # should be text/html
'text/x-dir-listing');
- } elsif ($resp !~ /^1/) {
- die "$resp";
- }
- my $data = $listen->accept;
+ $response->content(join "\n", $ftp->lsl);
+ } elsif (! $ftp->ok) {
+ die "$resp";
+ }
+# my $data = $listen->accept;
- $response = $self->collect($arg, $response, sub {
- LWP::Debug::debug('collecting');
- my $content = '';
- my $result = $data->read(\$content, $size, $timeout);
- LWP::Debug::debug("collected: $content");
- return \$content;
- } );
+# $response = $self->collect($arg, $response, sub {
+# LWP::Debug::debug('collecting');
+# my $content = '';
+# my $result = $data->read(\$content, $size, $timeout);
+# LWP::Debug::debug("collected: $content");
+# return \$content;
+# } );
- } elsif ($method eq 'PUT') {
+ } elsif ($method eq 'PUT') {
+ die "'PUT' not yet implemented";
$cmd_sock->write("stor $path\r\n");
$resp = expect($cmd_sock, '1');
$response = new HTTP::Response &HTTP::Status::RC_CREATED,
@@ -250,13 +281,13 @@
die "This should not happen\n";
}
- $cmd_sock->write("quit\r\n");
- expect($cmd_sock, '2');
- };
- if ($@) {
- return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST, $@;
- }
-
+# $cmd_sock->write("quit\r\n");
+ $ftp->quit;
+# expect($cmd_sock, '2');
+# if ($@) {
+# return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST, $@;
+# }
+
$response;
}