# ---------------------------------------------------------------------------
# wwwftp: A package for sending FTP requests and handling responses for the
#          World-Wide Web.  This package is designed for use by www.pl
#          for handling URL's with the "ftp" scheme designator.
#
# 05 June 1995 : Initial Version
#
# If you have any suggestions, bug reports, fixes, or enhancements,
# send them to <chetan@htilbom.ernet.in>
# ===========================================================================
require "wwwerror.pl";
require "sys/socket.ph";

package wwwftp;

%AllowedMethods = (     # Specify what FTP request methods are supported
    'GET',    'retr',   # And the commands for that method
    'PUT',    'stor',   
    'LIST',   'list'
);                      

    # format to pack to build argment for socket call
    $sockaddr = 'S n a4 x8';
 
    # fallback on BSD defaults if socket.ph wasn't loaded
    # Of course, if you're running under SYS5, this won't work for you
    # you must have run h2ph to install socket.ph.
    eval "$inet = &main'AF_INET" || ($inet=2);
    eval "$stream = &main'SOCK_STREAM" || ($stream=1);

# ===========================================================================
# request(): perform an ftp request for the $object at the FTP server
#            on the specified $host and $port, giving up after $timeout seconds.
#            Return the FTP response code along with (as named parameters)
#            the parsed response %headers and document $content.
#
sub request
{
    local($method, $host, $port, $object, *headers, *content, $timeout) = @_;
    local($fqdn, $aliases, $addrtype, $len, $thataddr);

    local($response) = 0;

    local ($user, $password);

    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");
    }

    if (!$port) { $port = 21; };   # The default FTP port is always 21

    # Get the user, password and the host if specified
    if ($host =~ /^(.*)@(\w.*)$/)
    {
	$user = $1; $host = $2;
	if ($user =~ /([\w.]*):(.*)/)
	{
	    $user = $1; $password = $2;
	}
    }
    # If no user is specified then user is anonymous
    # and let password be the mail address of calling user
    $user = "anonymous" unless $user;
    unless ($password)
    {
	chop ($domainname = `domainname`);
	$domainname =~ s/^.(.*)/$1/g;
	$password = $main'ENV{'USER'}."@".$domainname;
    }

    # Build destination address

    if ($host =~ /^\d+\.\d+\.\d+\.\d+$/)
    {
        $thataddr = pack('c4', split(/\./, $host));
    }
    else
    {
        ($fqdn, $aliases, $addrtype, $len, $thataddr) = gethostbyname($host);
        if (!$fqdn)
        {
            return &wwwerror'onrequest($wwwerror'RC_connection_failed, $method,
                         'ftp', $host, $port, $object, *headers, *content,
                         "Cannot find hostname $host");
        }
    }

    #
    # Connect socket to destination; log in
    #

    $that = pack($sockaddr, $inet, $port, $thataddr);

    if (! socket(CMD_SOC, $inet, $stream, 0))
    {
        return &wwwerror'onrequest($wwwerror'RC_connection_failed, $method,
                         'ftp', $host, $port, $object, *headers, *content,
                         "Failed bind to our local socket: $!");
    }

    local($/);
    $run_it = <<'EOF';
        $SIG{'ALRM'} = "wwwftp'timed_out";
        alarm($timeout);
        connect(CMD_SOC, $that) || die "Cannot connect to $host:$port, $! \n";

        ### This info will be used by future data connections ###
        ($family, $localport, $cmdaddr) = unpack ($sockaddr, getsockname(CMD_SOC));
        $cmdname = pack($sockaddr, $inet, 0, $cmdaddr);

        alarm($timeout);
        select((select(CMD_SOC), $| = 1)[0]); # Make CMD_SOC unbuffered
        # Send the user and login
        &ftpcmd ("3", "user $user");
        # Send the password 
        &ftpcmd ("2", "pass $password");
        # Force type of transfer to be binary
        &ftpcmd ("2", "type i");

        # Establish a data socket, send PORT command to server, and listen
        if (socket(GENERIC, $inet, $stream, 0)) 
        {
            if (bind(GENERIC, $cmdname)) 
            {
                if (listen(GENERIC, 1)) 
                {
                    select((select(GENERIC), $! = 1)[0]¨);
                    ($family, $localport, @thisaddr) = 
                          unpack("S n C C C C x8", getsockname(GENERIC));
		    push(@thisaddr, $localport >> 8, $localport & 0xff);
		    $portcmd = join(',', @thisaddr);
                    &ftpcmd ("2", "port $portcmd");
		}
                else
                {
                    close (GENERIC);
                    return &wwwerror'onrequest($wwwerror'RC_connection_failed,
                                     $method, 'ftp', $host, $port, $object, 
                                     *headers, *content, 
                                     "Listen error on data socket: $!");

                }
	    }
            else
            {
                close (GENERIC);
                return &wwwerror'onrequest($wwwerror'RC_connection_failed, 
                                 $method, 'ftp', $host, $port, $object, 
                                 *headers, *content, 
                                 "Failed to bind data socket: $!");

            }
	}
        else
        {
            return &wwwerror'onrequest($wwwerror'RC_connection_failed, $method,
                         'ftp', $host, $port, $object, *headers, *content,
                         "Failed to create data socket: $!");
        }

        # Execute the given ftp command 
        &ftpcmd ("1", "$AllowedMethods{$method} $object");

        unless (accept(DATA,GENERIC))
        {
            close (GENERIC);
            return &wwwerror'onrequest($wwwerror'RC_connection_failed, $method,
                         'ftp', $host, $port, $object, *headers, *content,
                         "Accept error on data socket: $!");

	}

        $timeout <<= 2;                  # Quadruple timeout after 1st response
        alarm($timeout);

        # Write the contents to the data socket for put command
        syswrite (DATA, $content, length ($content)) if ($method eq 'PUT');
        $/ = "\n"; 
        $_ = <CMD_SOC> unless ($method eq 'PUT');
        if (/^(\d{3})\s+.*$/)
        {
            $response = $1;
            $headers  = "FTP ".$_;       # pass real headers back to client
            undef ($/);
            $content = <DATA> unless ($method eq 'PUT');
        }
        else                             # old style server reply
        {
            $content = $_;
            $response = $wwwerror'RC_ok; # Assume it is a good response
            undef ($/);
            $_ = <DATA>;            
            $content .= $_;
        }
        $SIG{'ALRM'} = "IGNORE";
        alarm (0);
EOF

    eval $run_it;
    if ($@)
    { 
        $SIG{'ALRM'} = "IGNORE";
        alarm (0);
        close (DATA);
        close (GENERIC);
        close (CMD_SOC);
        if    ($@ =~ /^Time/o) { $response = $wwwerror'RC_timed_out;         }
        elsif ($@ =~ /^No r/o) { $response = $wwwerror'RC_bad_response;      }
        else                   { $response = $wwwerror'RC_connection_failed; }

        return &wwwerror'onrequest($response, $method, 'ftp', $host, $port,
                                   $object, *headers, *content, $@);
    }
    close (DATA);
    close (GENERIC);
    close (CMD_SOC);
    
    return $response;
}

sub timed_out { die "Timed Out\n"; }

# ===========================================================================
# ftpcmd () : Sends a ftp control command and gets back the response from 
#             the ftp server. $code represents the code for success
#
sub ftpcmd
{
    local ($code, @cmds) = @_;
    local ($/, $cmd);

    if (defined(@cmds))
    {
	$cmd = join (" ", @cmds);
        # Send the command to the ftp server and get response from it.
	print CMD_SOC $cmd,"\r\n";
	$/ = "\n";
	$_ = <CMD_SOC>;
	if ($cmd =~ /^user.*/)	# If cmd is user ... just read one more time to get the reply code. 
	{
	    $/ = "\n"; $_ = <CMD_SOC>;
	}
        # Check the reply code from ftp server and die if it does not match 
        # the code for success
        die $_ unless (/^$code.*$/); 
    }
}

1;