package LWP::Protocol::ftp;
use Carp ();
use HTTP::Status ();
use HTTP::Negotiate ();
use HTTP::Response ();
use LWP::MediaTypes ();
use File::Listing ();
require LWP::Protocol;
@ISA = qw(LWP::Protocol);
use strict;
eval {
package LWP::Protocol::MyFTP;
require Net::FTP;
Net::FTP->require_version(2.00);
use vars qw(@ISA);
@ISA=qw(Net::FTP);
sub new {
my $class = shift;
LWP::Debug::trace('()');
my $self = $class->SUPER::new(@_) || return undef;
my $mess = $self->message; LWP::Debug::debug($mess);
$mess =~ s|\n.*||s; $mess =~ s|\s*ready\.?$||;
$mess =~ s|\s*\(Version\s*|/| and $mess =~ s|\)$||;
${*$self}{myftp_server} = $mess;
$self;
}
sub http_server {
my $self = shift;
${*$self}{myftp_server};
}
sub home {
my $self = shift;
my $old = ${*$self}{myftp_home};
if (@_) {
${*$self}{myftp_home} = shift;
}
$old;
}
sub go_home {
LWP::Debug::trace('');
my $self = shift;
$self->cwd(${*$self}{myftp_home});
}
sub request_count {
my $self = shift;
++${*$self}{myftp_reqcount};
}
sub ping {
LWP::Debug::trace('');
my $self = shift;
return $self->go_home;
}
};
my $init_failed = $@;
sub _connect {
my($self, $host, $port, $user, $account, $password, $timeout) = @_;
my $key;
my $conn_cache = $self->{ua}{conn_cache};
if ($conn_cache) {
$key = "$host:$port:$user";
$key .= ":$account" if defined($account);
if (my $ftp = $conn_cache->withdraw("ftp", $key)) {
if ($ftp->ping) {
LWP::Debug::debug('Reusing old connection');
$conn_cache->deposit("ftp", $key, $ftp);
return $ftp;
}
}
}
my $ftp = LWP::Protocol::MyFTP->new($host,
Port => $port,
Timeout => $timeout,
);
unless ($ftp) {
$@ =~ s/^Net::FTP: //;
return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR, $@);
}
LWP::Debug::debug("Logging in as $user (password $password)...");
unless ($ftp->login($user, $password, $account)) {
my $mess = scalar($ftp->message);
LWP::Debug::debug($mess);
$mess =~ s/\n$//;
my $res = HTTP::Response->new(&HTTP::Status::RC_UNAUTHORIZED, $mess);
$res->header("Server", $ftp->http_server);
$res->header("WWW-Authenticate", qq(Basic Realm="FTP login"));
return $res;
}
LWP::Debug::debug($ftp->message);
my $home = $ftp->pwd;
LWP::Debug::debug("home: '$home'");
$ftp->home($home);
$conn_cache->deposit("ftp", $key, $ftp) if $conn_cache;
return $ftp;
}
sub request
{
my($self, $request, $proxy, $arg, $size, $timeout) = @_;
$size = 4096 unless $size;
LWP::Debug::trace('()');
if (defined $proxy)
{
return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
'You can not proxy through the ftp');
}
my $url = $request->url;
if ($url->scheme ne 'ftp') {
my $scheme = $url->scheme;
return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
"LWP::Protocol::ftp::request called for '$scheme'");
}
my $method = $request->method;
unless ($method eq 'GET' || $method eq 'HEAD' || $method eq 'PUT') {
return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
'Library does not allow method ' .
"$method for 'ftp:' URLs");
}
if ($init_failed) {
return HTTP::Response->new(&HTTP::Status::RC_INTERNAL_SERVER_ERROR,
$init_failed);
}
my $host = $url->host;
my $port = $url->port;
my $user = $url->user;
my $password = $url->password;
{
my($u,$p) = $request->authorization_basic;
if (defined $u) {
$user = $u;
$password = $p;
}
}
my $account = $request->header('Account');
my $ftp = $self->_connect($host, $port, $user, $account, $password, $timeout);
return $ftp if ref($ftp) eq "HTTP::Response";
my $response = HTTP::Response->new(&HTTP::Status::RC_OK, "OK");
$response->header(Server => $ftp->http_server);
$response->header('Client-Request-Num' => $ftp->request_count);
$response->request($request);
my @path = grep { length } $url->path_segments;
my $remote_file = pop(@path);
$remote_file = '' unless defined $remote_file;
my $type;
if (ref $remote_file) {
my @params;
($remote_file, @params) = @$remote_file;
for (@params) {
$type = $_ if s/^type=//;
}
}
if ($type && $type eq 'a') {
$ftp->ascii;
}
else {
$ftp->binary;
}
for (@path) {
LWP::Debug::debug("CWD $_");
unless ($ftp->cwd($_)) {
return HTTP::Response->new(&HTTP::Status::RC_NOT_FOUND,
"Can't chdir to $_");
}
}
if ($method eq 'GET' || $method eq 'HEAD') {
LWP::Debug::debug("MDTM");
if (my $mod_time = $ftp->mdtm($remote_file)) {
$response->last_modified($mod_time);
if (my $ims = $request->if_modified_since) {
if ($mod_time <= $ims) {
$response->code(&HTTP::Status::RC_NOT_MODIFIED);
$response->message("Not modified");
return $response;
}
}
}
my $max_size = undef;
if ($request->header('Range') && $ftp->supported('REST'))
{
my $range_info = $request->header('Range');
my ($start_byte,$end_byte) = $range_info =~ /.*=\s*(\d+)-(\d+)?/;
if ( defined $start_byte && !defined $end_byte ) {
$ftp->restart( $start_byte );
}
elsif ( defined $start_byte && defined $end_byte &&
$start_byte >= 0 && $end_byte >= $start_byte ) {
$ftp->restart( $start_byte );
$max_size = $end_byte - $start_byte;
}
else {
return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
'Incorrect syntax for Range request');
}
}
elsif ($request->header('Range') && !$ftp->supported('REST'))
{
return HTTP::Response->new(&HTTP::Status::RC_NOT_IMPLEMENTED,
"Server does not support resume.");
}
my $data; LWP::Debug::debug("retrieve file?");
if (length($remote_file) and $data = $ftp->retr($remote_file)) {
my($type, @enc) = LWP::MediaTypes::guess_media_type($remote_file);
$response->header('Content-Type', $type) if $type;
for (@enc) {
$response->push_header('Content-Encoding', $_);
}
my $mess = $ftp->message;
LWP::Debug::debug($mess);
if ($mess =~ /\((\d+)\s+bytes\)/) {
$response->header('Content-Length', "$1");
}
if ($method ne 'HEAD') {
$response = $self->collect($arg, $response, sub {
my $content = '';
my $result = $data->read($content, $size);
if (defined $max_size)
{
my $bytes_received = $data->bytes_read();
if ($bytes_received - length($content) > $max_size)
{
$content = '';
}
elsif ($bytes_received > $max_size)
{
$content = substr($content, 0,
$max_size - ($bytes_received - length($content)) );
}
else
{
}
}
return \$content;
} );
}
unless ($data->abort) {
if ($method ne 'HEAD' || $ftp->code != 0) {
$response->code(&HTTP::Status::RC_INTERNAL_SERVER_ERROR);
$response->message("FTP close response: " . $ftp->code .
" " . $ftp->message);
}
}
}
elsif (!length($remote_file) || ( $ftp->code >= 400 && $ftp->code < 600 )) {
if (length($remote_file) && !$ftp->cwd($remote_file)) {
LWP::Debug::debug("chdir before listing failed");
return HTTP::Response->new(&HTTP::Status::RC_NOT_FOUND,
"File '$remote_file' not found");
}
LWP::Debug::debug("dir");
my @lsl = $ftp->dir;
my @variants =
(
['html', 0.60, 'text/html' ],
['dir', 1.00, 'text/ftp-dir-listing' ]
);
my $prefer = HTTP::Negotiate::choose(\@variants, $request);
my $content = '';
if (!defined($prefer)) {
return HTTP::Response->new(&HTTP::Status::RC_NOT_ACCEPTABLE,
"Neither HTML nor directory listing wanted");
}
elsif ($prefer eq 'html') {
$response->header('Content-Type' => 'text/html');
$content = "<HEAD><TITLE>File Listing</TITLE>\n";
my $base = $request->url->clone;
my $path = $base->path;
$base->path("$path/") unless $path =~ m|/$|;
$content .= qq(<BASE HREF="$base">\n</HEAD>\n);
$content .= "<BODY>\n<UL>\n";
for (File::Listing::parse_dir(\@lsl, 'GMT')) {
my($name, $type, $size, $mtime, $mode) = @$_;
$content .= qq( <LI> <a href="$name">$name</a>);
$content .= " $size bytes" if $type eq 'f';
$content .= "\n";
}
$content .= "</UL></body>\n";
}
else {
$response->header('Content-Type', 'text/ftp-dir-listing');
$content = join("\n", @lsl, '');
}
$response->header('Content-Length', length($content));
if ($method ne 'HEAD') {
$response = $self->collect_once($arg, $response, $content);
}
}
else {
my $res = HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
"FTP return code " . $ftp->code);
$res->content_type("text/plain");
$res->content($ftp->message);
return $res;
}
}
elsif ($method eq 'PUT') {
unless (length($remote_file)) {
return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
"Must have a file name to PUT to");
}
my $data;
if ($data = $ftp->stor($remote_file)) {
LWP::Debug::debug($ftp->message);
LWP::Debug::debug("$data");
my $content = $request->content;
my $bytes = 0;
if (defined $content) {
if (ref($content) eq 'SCALAR') {
$bytes = $data->write($$content, length($$content));
}
elsif (ref($content) eq 'CODE') {
my($buf, $n);
while (length($buf = &$content)) {
$n = $data->write($buf, length($buf));
last unless $n;
$bytes += $n;
}
}
elsif (!ref($content)) {
if (defined $content && length($content)) {
$bytes = $data->write($content, length($content));
}
}
else {
die "Bad content";
}
}
$data->close;
LWP::Debug::debug($ftp->message);
$response->code(&HTTP::Status::RC_CREATED);
$response->header('Content-Type', 'text/plain');
$response->content("$bytes bytes stored as $remote_file on $host\n")
}
else {
my $res = HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
"FTP return code " . $ftp->code);
$res->content_type("text/plain");
$res->content($ftp->message);
return $res;
}
}
else {
return HTTP::Response->new(&HTTP::Status::RC_BAD_REQUEST,
"Illegal method $method");
}
$response;
}
1;
__END__