# $Id$
# ---------------------------------------------------------------------------
# wwwftp: A package for getting FTP files
#          This package is designed for use by www.pl
#          for handling URL's with the "ftp" scheme designator.
#          It uses ftplib.pl
#
#
#
# This package has been developed by Jack Shirazi <js@biu.icnet.uk>
# as part of the Arcadia project at the University of California, Irvine.
# Each routine in this package has been derived from the work of multiple
# authors -- those that are known are listed above the respective routines.
# The routines have been changed substantially, so don't blame them for bugs.
# It is distributed under the Artistic License (included with your Perl
# distribution files).
#
# 23 Oct 1994 (JS) : Initial version 
#
# If you have any suggestions, bug reports, fixes, or enhancements,
# send them to the libwww-perl mailing list at <libwww-perl@ics.uci.edu>.
# ---------------------------------------------------------------------------
# This script was developed using the wwwhttp.pl script in this library
# developed by Roy Fielding <fielding@ics.uci.edu> as a starting point.
# 
# Some of these routines are enhanced versions of those distributed by
# Oscar Nierstrasz <oscar@iam.unibe.ch> from IAM, University of Berne. 
# See <ftp://cui.unige.ch/PUBLIC/oscar/scripts/README.html> for more info.
# ===========================================================================
require "wwwerror.pl";
require "wwwurl.pl";
require "ftplib.pl";

package wwwftp;
$MAX_RANGE = 20;
%AllowedMethods = (     # Specify what FTP request methods are supported
    'GET',        1,    # 1 = Allowed without content in request
    'HEAD',       0,
    'POST',       0,    # 2 = Allowed and with content in request
);

$EXT = "aaaa";
$SAVE_DIR = "./";
;#Default type is binary (why not ascii?)
$DEFAULT_TYPE = 'i';

if (!%BINARY_FILE_EXTENSIONS) {
    foreach $ext ('gz','z','Z','arc','tar') {
	$BINARY_FILE_EXTENSIONS{$ext} = 1;
    }
}
if (!%ASCII_FILE_EXTENSIONS) {
    foreach $ext ('txt','text','doc','html','message') {
	$ASCII_FILE_EXTENSIONS{$ext} = 1;
    }
}

# ===========================================================================
# request(): perform a ftp request for the $object at the NNTP server
#            on the specified $host and $port, giving up after $timeout seconds.
#            Return the NNTP response code along with (as named parameters)
#            the parsed response %headers and document $content.
#
# This is a vastly modified version of Oscar's http'get() dated 28/3/94 in
#      <ftp://cui.unige.ch/PUBLIC/oscar/scripts/http.pl>
# including contributions from Marc van Heyningen and Martijn Koster.
#
sub request
{
    local($method, $host, $port, $object, *headers, *content, $timeout) = @_;
    local($orig_object,$real_host,$user,$pass,$ext,$ftype);

    if (!$AllowedMethods{$method})
    {
        return &wwwerror'onrequest($wwwerror'RC_bad_request_client, $method,
                          'ftp', $host, $port, $object, *headers, *content,
                          "Library does not allow that method for FTP");
    }

    $orig_object = &wwwurl'compose('ftp',$host,$port,$object);

    ;#Get the username, password and hostname packed into $host
    ;#as "[user [:password] @] host"
    if ($host =~ s/@([^@]+)$//) {
        $real_host = $1;
        if ($host =~ s/^([^:]+)://) {
	    $user = $1;
 	    $pass = $host;
        } else {
	    $user = $host;
        }
    } else {
        $real_host = $host;
    }

    ;#If type is specified, use it, but override if path ends in '/'
    if ($object =~ s/;type=([aAiIdD])$//) {$ftype = ($1 =~ tr/A-Z/a-z/);}
    if ($object =~ s#/$##) {$ftype = 'd'}

    ;#If type not specified, guess it or default to default
    if (!$ftype && ($object =~ m#\.([^/\.]+)$#)) {
            $ext = $1;
            $BINARY_FILE_EXTENSIONS{$ext} && ($ftype = 'i');
            $ASCII_FILE_EXTENSIONS{$ext} && ($ftype = 'a');
    }
    if (!$ftype) {$ftype = $DEFAULT_TYPE;}

    ;#Dump the leading '/'
    $object =~ s#^/##;

    local($response) = 0;
    local($resphead) = '';

    eval '$content = &get_ftp_request($orig_object,$object,
	        $real_host,$port,$user,$pass,$ftype,$timeout)';
    if ($@)
    {
        return &wwwerror'onrequest($response, $method, 'ftp', $host, $port,
                                   $object, *headers, *content, $@);
    }

    return $response;
}

sub get_ftp_request {
    local($orig_object,$object,$real_host,$port,
	$user,$pass,$ftype,$timeout) = @_;
    local($return,$return2);
    &ftp'timeout($timeout);
    &ftp'open($port ? "$real_host:$port" : $real_host , $user, $pass)
	 || return &htmlize_error($orig_object,&ftp'error);
    if ($ftype eq 'd') {
       $return = &htmlize_dir($orig_object,$object,
	    $object ? &ftp'dir($object) : &ftp'dir());
    } else {
        &ftp'type($ftype);
        $EXT++;
        if (&ftp'get($object,$SAVE_DIR . "tmp" . $EXT . $$)) {
	    $return = &htmlize_filename($orig_object,$object,
	        $SAVE_DIR . "tmp" . $EXT . $$);
        } else {
	    #Couldn't get file why?
warn &ftp'error,"\n";
	    $_ = &ftp'error;
	    if (m/Unexpected reply:/ || m/No\s*such\s*file/i) {
#	    if (1) {
	        #Maybe a directory?
	        $return = &htmlize_dir($orig_object,$object,&ftp'dir($object));
	    } else {
	        #No - lets just return the error
	        $return = &htmlize_error($orig_object,&ftp'error);
	    }
        }
    }
    &ftp'close;
    $return;
}

sub htmlize_dir{;#$object
    $#_ > 0 || return &htmlize_error(&ftp'error);
    $base = shift;
    $object = shift;
    local(@lines) = @_;
    local($html,$filename);
    $html = "<base href=\"$base\">\n<H1>$object Directory</H1></PRE>\n\n<MENU>\n\n";
    foreach $file_desc (@lines) {
        ;#Assume last part of each description is the filename
        if ($file_desc =~ /^\s*total/i) {
            $html .= "<LI> $file_desc\n";
        } else {
            $file_desc =~ /\s(\S*)$/;
            $filename = $1;
            $html .= "<LI> <A HREF=\"ftp:$filename\">$file_desc</A>\n";
        }
    }
    $html .= "</MENU>\n";
    $html;
}

sub htmlize_filename {
    local($base,$file,$local) = @_;
    $html = "<base href=\"$base\">\n<H1>$file</H1></PRE>\n\n";
    $html .= "<A HREF=\"file:$local\">Stored locally as $local</A>\n";
}

sub htmlize_error {die $_[0],"\n",$_[1],"\n"}

1;