# This library is no longer being maintained, and is included for backward
# compatibility with Perl 4 programs which may require it.
# In particular, this should not be used as an example of modern Perl
# programming techniques.
# Suggested alternative: Net::FTP
# This is a wrapper to the chat2.pl routines that make life easier
# Mostly by Lee McLoughlin <lmjm@doc.ic.ac.uk>
# based on original version by Alan R. Martello <al@ee.pitt.edu>
# And by A.Macpherson@bnr.co.uk for multi-homed hosts
# $Header: /a/swan/home/swan/staff/csg/lmjm/src/perl/mirror/RCS/ftp.pl,v 1.17 1993/04/21 10:06:54 lmjm Exp lmjm $
# Revision 1.17 1993/04/21 10:06:54 lmjm
# Send all status reports to STDERR not to STDOUT (to allow use by ftpcat).
# Allow target file to be '-' meaning STDOUT
# Revision 1.16 1993/01/28 18:59:05 lmjm
# Allow socket arguemtns to come from main.
# Minor cleanups - removed old comments.
# Revision 1.15 1992/11/25 21:09:30 lmjm
# Added another REST return code.
# Revision 1.14 1992/08/12 14:33:42 lmjm
# Fail ftp'write if out of space.
# Revision 1.13 1992/03/20 21:01:03 lmjm
# Added in the proxy ftp code from Edwards Reed <err@cinops.xerox.com>
# Added ftp'delete from Aaron Wohl <aw0g+@andrew.cmu.edu>
# Revision 1.12 1992/02/06 23:25:56 lmjm
# Moved code around so can use this as a lib for both mirror and ftpmail.
# Time out opens. In case Unix doesn't bother to.
# Revision 1.11 1991/11/27 22:05:57 lmjm
# Match the response code number at the start of a line allowing
# Revision 1.10 1991/10/23 22:42:20 lmjm
# Added better timeout code.
# Tried to optimise file transfer
# Moved open/close code to not leak file handles.
# Cleaned up the alarm code.
# Added $fatalerror to show wether the ftp link is really dead.
# Revision 1.9 1991/10/07 18:30:35 lmjm
# Made the timeout-read code work.
# Added restarting file gets.
# Be more verbose if ever have to call die.
# Revision 1.8 1991/09/17 22:53:16 lmjm
# Spot when open_data_socket fails and return a failure rather than dying.
# Revision 1.7 1991/09/12 22:40:25 lmjm
# Added Andrew Macpherson's patches for hosts without ip forwarding.
# Revision 1.6 1991/09/06 19:53:52 lmjm
# Relaid out the code the way I like it!
# Changed the debuggin to produce more "appropriate" messages
# Fixed bugs in the ordering of put and dir listing.
# Allow for hash printing when getting files (a la ftp).
# Added the new commands from Al.
# Don't print passwords in debugging.
# Revision 1.5 1991/08/29 16:23:49 lmjm
# Timeout reads from the remote ftp server.
# No longer call die expect on fatal errors. Just return fail codes.
# Changed returns so higher up routines can tell whats happening.
# Get expect/accept in correct order for dir listing.
# When ftp_show is set then print hashes every 1k transferred (like ftp).
# Allow for stripping returns out of incoming data.
# Save last error in a global string.
# Revision 1.4 1991/08/14 21:04:58 lmjm
# ftp'get now copes with ungetable files.
# ftp'expect code changed such that the string_to_print is
# ignored and the string sent back from the remote system is printed
# Implemented patches from al. Removed spuiours tracing statements.
# Revision 1.3 1991/08/09 21:32:18 lmjm
# Allow for another ok code on cwd's
# Rejigger the log levels
# Send \r\n for some odd ftp daemons
# Revision 1.2 1991/08/09 18:07:37 lmjm
# Don't print messages unless ftp_show says to.
# Revision 1.1 1991/08/08 20:31:00 lmjm
require 'chat2.pl'; # into main
eval "require 'socket.ph'" || eval "require 'sys/socket.ph'"
|| die "socket.ph missing: $!\n";
if( defined( &main
'PF_INET ) ){
$pf_inet = &main'PF_INET
;
$sock_stream = &main
'SOCK_STREAM;
local($name, $aliases, $proto) = getprotobyname( 'tcp
' );
# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp
'
# but who the heck would change these anyway? (:-)
# If the remote ftp daemon doesn't respond within this
time presume its dead
# Timeout a read if I don't get data back within this many seconds
$timeout_read = 20 * $timeout;
$timeout_open = $timeout;
# This is a "global" it contains the last response from the remote ftp server
# for use in error messages
# Also ftp'NS is the
socket containing the data coming
in from the remote ls
# The size of block to be read or written when talking to the remote
# How often to print a hash out, when debugging
# Output a newline after this many hashes to prevent outputing very long lines
# If a proxy connection then who am I really talking to?
# This is just a tracing aid.
# print STDERR "ftp debugging on\n";
$timeout_open = $timeout;
$timeout_read = 20 * $timeout;
print STDERR "ftp timeout set to $timeout\n";
local( $site, $ftp_port, $retry_call, $attempts ) = @_;
local( $connect_site, $connect_port );
print STDERR "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
print STDERR "Connecting to $site";
print STDERR " [port $ftp_port]";
$proxy_gateway = "internet-gateway";
print STDERR "using proxy services of $proxy_gateway, ";
print STDERR "at $proxy_ftp_port\n";
$connect_site = $proxy_gateway;
$connect_port = $proxy_ftp_port;
$connect_port = $ftp_port;
if( ! &chat'open_port
( $connect_site, $connect_port ) ){
print STDERR
"Failed to connect\n" if $ftp_show;
print STDERR
"proxy connection failed " if $proxy;
print STDERR
"Cannot open ftp to $connect_site\n" if $ftp_show;
$res = &ftp
'expect( $timeout,
120, "service unavailable to $site", 0,
220, "ready for login to $site", 1,
421, "service unavailable to $site, closing connection", 0);
print STDERR
"Pausing between retries\n";
local( $site, $ftp_port, $retry_call, $attempts ) = @_;
$SIG{ 'ALRM
' } = "ftp\'open_alarm";
local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
local( $remote_user, $remote_password ) = @_;
&ftp
'send( "USER $remote_user\@$site" );
&ftp'send( "USER $remote_user" );
230, "$remote_user logged in", 1,
331, "send password for $remote_user", 2,
332, "account for login not supported", 0,
421, "service unavailable, closing connection", 0);
&ftp'send( "PASS $remote_password" );
$val = &ftp
'expect( $timeout,
230, "$remote_user logged in", 1,
202, "command not implemented", 0,
332, "account for login not supported", 0,
503, "bad sequence of commands", 0,
421, "service unavailable, closing connection", 0);
# If I got here I failed to login
return &ftp
'expect( $timeout,
200, "working directory = $dir", 1,
250, "working directory = $dir", 1,
502, "command not implemented", 0,
550, "cannot change directory", 0,
421, "service unavailable, closing connection", 0 );
# Get a full directory listing:
# &ftp'dir
( remote LIST options
)
# Start a list goin with the given options.
# Presuming that the remote deamon uses the ls command to generate the
# data to send back then you can send it some extra options (eg: -lRa)
# return 1 if sucessful and 0 on a failure
if( ! &ftp'open_data_socket
() ){
&ftp
'send( "LIST $options" );
$ret = &ftp
'expect( $timeout,
150, "reading directory", 1,
125, "data connection already open?", 0,
450, "file unavailable", 0,
502, "command not implemented", 0,
421, "service unavailable, closing connection", 0 );
# the data should be coming at us now
accept(NS
,S
) || die "accept failed $!";
# Close down reading the result of a remote ls command
# return 1 if successful and 0 on failure
$ret = &ftp'expect
($timeout,
226, "", 1, # transfer complete, closing connection
250, "", 1, # action completed
425, "can't open data connection", 0,
426, "connection closed, transfer aborted", 0,
451, "action aborted, local error", 0,
421, "service unavailable, closing connection", 0);
# shut down our end of the socket
# Quit from the remote ftp server
# return 1 if successful and 0 on failure
return &ftp'expect
($timeout,
221, "Goodbye", 1, # transfer complete, closing connection
500, "error quitting??", 0);
return sysread( NS
, $buf, $ftpbufsize );
$SIG{ 'ALRM
' } = "ftp\'read_alarm";
local( $ret ) = eval '&timed_read
()';
# Get a remote file back into a local file.
# If no loc_fname passed then uses rem_fname.
# returns 1 on success and 0 on failure
local($rem_fname, $loc_fname, $restart ) = @_;
if( ! &ftp
'open_data_socket() ){
print STDERR "Cannot open data socket\n";
# Find the size of the target file
local( $restart_at ) = &ftp'filesize
( $loc_fname );
if( $restart && $restart_at > 0 && &ftp
'restart( $restart_at ) ){
# Make sure the file can be updated
chmod( 0644, $loc_fname );
&ftp'send( "RETR $rem_fname" );
150, "receiving $rem_fname", 1,
125, "data connection already open?", 0,
450, "file unavailable", 2,
550, "file unavailable", 2,
421, "service unavailable, closing connection", 0);
print STDERR "Failure on RETR command\n";
# shut down our end of the socket
# the data should be coming at us now
accept(NS
,S
) || die "accept failed: $!";
# concatenate on the end if restarting, else just overwrite
if( !open(FH
, ($restart ?
'>>' : '>') . $loc_fname) ){
print STDERR
"Cannot create local file $loc_fname\n";
# shut down our end of the socket
local( $start_time ) = time;
local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
while( ($len = &ftp'read()) > 0 ){
while( $bytes > ($lasthash + $ftp'hashevery
) ){
$lasthash += $ftp'hashevery;
if( ($hashes % $ftp'hashnl
) == 0 ){
if( ! print FH
$ftp'buf ){
print STDERR "\nfailed to write data";
# shut down our end of the socket
print STDERR
"\ntimed out reading data!\n";
if( $hashes && ($hashes % $ftp'hashnl) != 0 ){
local( $secs ) = (time - $start_time);
$secs = 1; # To avoid a divide by zero;
local( $rate ) = int( $bytes / $secs );
print STDERR "Got $bytes bytes ($rate bytes/sec)\n";
$ret = &ftp'expect
($timeout,
226, "Got file", 1, # transfer complete, closing connection
250, "Got file", 1, # action completed
110, "restart not supported", 0,
425, "can't open data connection", 0,
426, "connection closed, transfer aborted", 0,
451, "action aborted, local error", 0,
421, "service unavailable, closing connection", 0);
local( $rem_fname, $val ) = @_;
&ftp'send("DELE $rem_fname" );
$val = &ftp
'expect( $timeout,
250,"Deleted $rem_fname", 1,
550,"Permission denied",0
# Add in the hash printing and newline conversion
local( $loc_fname, $rem_fname ) = @_;
if( ! &ftp'open_data_socket
() ){
&ftp
'send("STOR $rem_fname");
# the data should be coming at us now
150, "sending $loc_fname", 1,
125, "data connection already open?", 0,
450, "file unavailable", 0,
532, "need account for storing files", 0,
452, "insufficient storage on system", 0,
553, "file name not allowed", 0,
421, "service unavailable, closing connection", 0);
# shut down our end of the socket
# the data should be coming at us now
accept(NS,S) || die "accept failed: $!";
if( !open(FH, "<$loc_fname") ){
print STDERR "Cannot open local file $loc_fname\n";
# shut down our end of the socket
# shut down our end of the socket to signal EOF
$ret = &ftp'expect
($timeout,
226, "file put", 1, # transfer complete, closing connection
250, "file put", 1, # action completed
110, "restart not supported", 0,
425, "can't open data connection", 0,
426, "connection closed, transfer aborted", 0,
451, "action aborted, local error", 0,
551, "page type unknown", 0,
552, "storage allocation exceeded", 0,
421, "service unavailable, closing connection", 0);
print STDERR
"error putting $loc_fname\n";
local( $restart_point, $ret ) = @_;
&ftp'send("REST $restart_point");
$ret = &ftp
'expect($timeout,
350, "restarting at $restart_point", 1,
502, "REST not implemented", 2,
554, "REST not implemented", 2,
421, "service unavailable, closing connection", 0);
# Set the file transfer type
$ret = &ftp'expect
($timeout,
200, "file type set to $type", 1,
504, "Invalid form or byte size for type $type", 0,
421, "service unavailable, closing connection", 0);
# routine to query the remote server for 'SITE' commands supported
# if we havent sent a 'HELP SITE
', send it now
if( !$site_command_check ){
&ftp'send( "HELP SITE" );
# assume the line in the HELP SITE response with the 'HELP'
# command is the one for us
$ret = &ftp
'expect( $timeout,
print STDERR "No response from HELP SITE\n" if( $ftp_show );
@site_command_list = split(/\s+/, $ret);
return @site_command_list;
# return the pwd, or null if we can't get the pwd
$ret = &ftp
'expect( $timeout,
257, "working dir is", 1,
502, "PWD not implemented", 0,
550, "file unavailable", 0,
421, "service unavailable, closing connection", 0 );
if( $ftp'response
=~ /^257\s"(.*)"\s.*$/ ){
# return 1 for success, 0 for failure
&ftp'send( "MKD $path" );
$ret = &ftp
'expect( $timeout,
257, "made directory $path", 1,
502, "MKD not implemented", 0,
550, "file unavailable", 0,
421, "service unavailable, closing connection", 0 );
# return 1 for success, 0 for failure
local( $path, $mode ) = @_;
&ftp
'send( sprintf( "SITE CHMOD %o $path", $mode ) );
$ret = &ftp'expect
( $timeout,
200, "chmod $mode $path succeeded", 1,
502, "CHMOD not implemented", 0,
550, "file unavailable", 0,
421, "service unavailable, closing connection", 0 );
local( $old_name, $new_name ) = @_;
&ftp'send( "RNFR $old_name" );
$ret = &ftp
'expect( $timeout,
502, "RNFR not implemented", 0,
550, "file unavailable", 0,
450, "file unavailable", 0,
421, "service unavailable, closing connection", 0);
# check if the "rename from" occurred ok
&ftp'send( "RNTO $new_name" );
$ret = &ftp
'expect( $timeout,
250, "rename $old_name to $new_name", 1,
502, "RNTO not implemented", 0,
503, "bad sequence of commands", 0,
532, "need account for storing files", 0,
553, "file name not allowed", 0,
421, "service unavailable, closing connection", 0);
return &ftp'expect
( $timeout,
200, "Remote '$cmd' OK", 1,
500, "error in remote '$cmd'", 0 );
# ------------------------------------------------------------------------------
# These are the lower level support routines
($ftp'response
, $ftp'fatalerror) = @_;
print STDERR "$ftp'response
\n";
# create the list of parameters for chat'expect
# ftp'expect(time_out, {value, string_to_print, return value});
# if the string_to_print is "" then nothing is printed
# the last response is stored in $ftp'response
# NOTE: lmjm has changed this code such that the string_to_print is
# ignored and the string sent back from the remote system is printed
local( $code ) = shift( @_ );
push( @expect_args, "$pre(" . $code . " .*)\\015\\n
" );
"&ftp
'expectgot( \$1, 0 ); " . shift( @_ ) );
# Treat all unrecognised lines as continuations
push( @expect_args, "^(.*)\\015\\n" );
push( @expect_args, "&ftp'expectgot
( \
$1, 0 ); 100" );
# add patterns TIMEOUT and EOF
push( @expect_args, 'TIMEOUT' );
push( @expect_args, "&ftp
'expectgot( \"timed out\", 1 ); 0" );
push( @expect_args, 'EOF
' );
push( @expect_args, "&ftp'expectgot
( \"remote server gone away
\", 1 ); 0" );
&printargs( $time_out, @expect_args );
$ret = &chat'expect( $time_out, @expect_args );
# we saw a continuation line, wait for the end
push( @expect_args, "^.*\n" );
push( @expect_args, "100" );
$ret = &chat'expect( $time_out, @expect_args );
local( $sockaddr, $name, $aliases, $proto, $port );
local( $type, $len, $thisaddr, $myaddr, $a, $b, $c, $d );
local( $mysockaddr, $family, $hi, $lo );
chop( $hostname = `hostname` );
($name, $aliases, $proto) = getprotobyname( 'tcp' );
($name, $aliases, $port) = getservbyname( $port, 'tcp' );
# ($name, $aliases, $type, $len, $thisaddr) =
# gethostbyname( $hostname );
($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
# $this = pack( $sockaddr, &main'AF_INET, 0, $thisaddr );
socket(S, $pf_inet, $sock_stream, $proto ) || die "socket: $!";
bind(S, $this) || die "bind: $!";
$mysockaddr = getsockname(S);
($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
$hi = ($port >> 8) & 0x00ff;
# we MUST do a listen before sending the port otherwise
listen( S, 5 ) || die "listen";
&ftp'send( "PORT
$a,$b,$c,$d,$hi,$lo" );
return &ftp'expect($timeout,
200, "PORT command successful
", 1,
250, "PORT command successful
", 1 ,
421, "service unavailable
, closing connection
", 0);
sub ftp'close_data_socket
print STDERR "ERROR
, \\n
in send string
for $send_cmd\n";
local( $sc ) = $send_cmd;
if( $send_cmd =~ /^PASS/){
$sc = "PASS
<somestring
>";
print STDERR "---> $sc\n";
&chat'print( "$send_cmd\r\n" );
print STDERR shift( @_ ) . "\n";
# make this package return true