ftp.pl

站点映像程序

	return $ret;
}

# &ftp'restart( byte_offset )
# Restart the next transfer from the given offset
sub ftp'restart
{
	local( $restart_point, $ret ) = @_;

	if( ! $service_open ){
		return 0;
	}

	&send( "REST $restart_point" );

	# 
	# see what they say

	$ret = &expect( $timeout, 
		3, 1 );   # restarting at $restart_point
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

# &ftp'type( 'A' or 'I' )
# set transfer type to Ascii or Image.
sub type
{
	local( $type ) = @_;

	if( ! $service_open ){
		return 0;
	}

	&send( "TYPE $type" );

	# 
	# see what they say

	$ret = &expect( $timeout, 
		2, 1 ); # file type set to $type
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

$site_command_check = 0;
@site_command_list = ();

# routine to query the remote server for 'SITE' commands supported
sub ftp'site_commands
{
	local( $ret );
	
	@site_command_list = ();
	$site_command_check = 0;

	if( ! $service_open ){
		return @site_command_list;
	}

	# if we havent sent a 'HELP SITE', send it now
	if( !$site_command_check ){
	
		$site_command_check = 1;
	
		&send( "HELP SITE" );
	
		# assume the line in the HELP SITE response with the 'HELP'
		# command is the one for us
		$keep_continuations = 1;
		$ret = &expect( $timeout,
			".*HELP.*", 1 );
		$keep_continuations = 0;
		if( $ret == 99 ){
			&service_closed();
			return @site_command_list;
		}
	
		if( $ret != 0 ){
			print $showfd "No response from HELP SITE ($ret)\n" if( $ftp_show );
		}
	
		@site_command_list = split(/\s+/, $response);
	}
	
	return @site_command_list;
}

# return the pwd, or null if we can't get the pwd
sub ftp'pwd
{
	local( $ret, $cwd );

	if( ! $service_open ){
		return 0;
	}

	&send( "PWD" );

	# 
	# see what they say

	$ret = &expect( $timeout, 
		2, 1 ); # working dir is
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	if( $ret ){
		if( $response =~ /^2\d\d\s*"(.*)"\s.*$/ ){
			$cwd = $1;
		}
		# For VMS
		elsif( $response =~ /^2\d\d\ (.*) is the current directory/ ){
			$cwd = $1;
		}
	}
	return $cwd;
}

# &ftp'mkdir( directory name )
# Create a directory on the remote site
# return 1 for success, 0 otherwise
sub mkdir
{
	local( $path ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

	if( $mapunixout ){
		$path = eval "&$mapunixout( \$path, 'f' )";
	}

	&send( "MKD $path" );

	# 
	# see what they say

	$ret = &expect( $timeout, 
		2, 1 ); # made directory $path
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

# &ftp'chmod( pathname, new mode )
# Change the mode of a file on the remote site.
# return 1 for success, 0 for failure
sub chmod
{
	local( $path, $mode ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

	if( $mapunixout ){
		$path = eval "&$mapunixout( \$path, 'f' )";
	}

	&send( sprintf( "SITE CHMOD %o $path", $mode ) );

	# 
	# see what they say

	$ret = &expect( $timeout, 
		2, 1 ); # chmod $mode $path succeeded
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

# &ftp'rename( old name, new name )
# Rename a file on the remote site.
# returns 1 if successful, 0 otherwise
sub ftp'rename
{
	local( $old_name, $new_name ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

	if( $mapunixout ){
		$old_name = eval "&$mapunixout( \$old_name, 'f' )";
	}

	&send( "RNFR $old_name" );

	# 
	# see what they say

	$ret = &expect( $timeout, 
		3, 1 ); #  OK
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	# check if the "rename from" occurred ok
	if( $ret ){
		if( $mapunixout ){
			$new_name = eval "&$mapunixout( \$new_name, 'f' )";
		}

		&send( "RNTO $new_name" );
	
		# 
		# see what they say
	
		$ret = &expect( $timeout, 
			2, 1 );  # rename $old_name to $new_name
		if( $ret == 99 ){
			&service_closed();
			$ret = 0;
		}
	}

	return $ret;
}


# &ftp'quote( site command );
sub ftp'quote
{
	local( $cmd ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

	&send( $cmd );

	$ret = &expect( $timeout, 
		2, 1 ); # Remote '$cmd' OK
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

# ------------------------------------------------------------------------------
# These are the lower level support routines

sub expectgot
{
	($resp, $fatalerror) = @_;
	if( $ftp_show ){
		print $showfd "$resp\n";
	}
	if( $keep_continuations ){
		$response .= $resp;
	}
	else {
		$response = $resp;
	}
}

#
#  create the list of parameters for chat'expect
#
#  expect( time_out, {value, return value} );
#  the last response is stored in $response
#
sub expect
{
	local( $ret );
	local( $time_out );
	local( @expect_args );
	local( $code, $pre );
	
	$response = '';
	$fatalerror = 0;

	$time_out = shift( @_ );
	
	if( $drop_on_421 ){
		# Handle 421 specially - has to go first in case a pattern
		# matches on a generic 4.. response
		push( @expect_args, "[.|\n]*^(421 .*)\\015?\\n" );
		push( @expect_args, "&expectgot( \$1, 0 ); 99" );
	}

	# Match any obvious continuations.
	push( @expect_args, "[.|\n]*^(\\d\\d\\d-.*|[^\\d].*)\\015?\\n" );
	push( @expect_args, "&expectgot( \$1, 0 ); 100" );

	while( @_ ){
		$code = shift( @_ );
		$pre = '^';
		$post = ' ';
		if( $code =~ /^\d\d+$/ ){
			$pre = "[.|\n]*^";
		}
		elsif( $code =~ /^\d$/ ){
			$pre = "[.|\n]*^";
			$post = '\d\d ';
		}
		push( @expect_args, "$pre(" . $code . $post . ".*)\\015?\\n" );
		push( @expect_args,
			"&expectgot( \$1, 0 ); " . shift( @_ ) );
	}
	# Match any numeric response codes not explicitly looked for.
	push( @expect_args, "[.|\n]*^(\\d\\d\\d .*)\\015?\\n" );
	push( @expect_args, "&expectgot( \$1, 0 ); 0" );
	
	# Treat all unrecognised lines as continuations
	push( @expect_args, "^(.*)\\015?\\n" );
	push( @expect_args, "&expectgot( \$1, 0 ); 100" );
	
	# add patterns TIMEOUT and EOF
	push( @expect_args, 'TIMEOUT' );
	push( @expect_args, "&expectgot( 'timed out', 0 ); 0" );
	push( @expect_args, 'EOF' );
	push( @expect_args, "&expectgot( 'remote server gone away', 1 ); 99" );
	
	# if we see a continuation line, wait for the real info
	$ret = 100;
	while( $ret == 100 ){
		if( $ftp_show > 9 ){
			&printargs( $time_out, @expect_args );
		}
		$ret = &chat'expect( $time_out, @expect_args );
	}

	return $ret;
}


#
#  opens NS for io
#
sub open_data_socket
{
	if( $use_pasv ){
		return 1;
	}

	local( $sockaddr, $port );
	local( $type, $myaddr, $a, $b, $c, $d );
	local( $mysockaddr, $family, $hi, $lo );
	
	$sockaddr = 'S n a4 x8';

	($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
	$this = $chat'thisproc;
	
	if( ! socket( S, $main'pf_inet, $main'sock_stream, $main'tcp_proto ) ){
		warn "socket: $!";
		return 0;
	}
	if( ! bind( S, $this ) ){
		warn "bind: $!";
		return 0;
	}
	
	# get the port number
	$mysockaddr = getsockname( S );
	($family, $port, $myaddr) = unpack( $sockaddr, $mysockaddr );
	
	$hi = ($port >> 8) & 0x00ff;
	$lo = $port & 0x00ff;
	
	#
	# we MUST do a listen before sending the port otherwise
	# the PORT may fail
	#
	if( ! listen( S, 5 ) ){
		warn "listen: $!";
		return 0;
	}
	
	&send( "PORT $a,$b,$c,$d,$hi,$lo" );
	
	return &expect( $timeout,
		2, 1 ); # PORT command successful
}
	
sub close_data_socket
{
	close( NS );
}

sub send
{
	local( $send_cmd ) = @_;

	if( $send_cmd =~ /\n/ ){
		print $showfd "ERROR, \\n in send string for $send_cmd\n";
	}
	
	if( $ftp_show ){
		local( $sc ) = $send_cmd;

		if( $send_cmd =~ /^(PASS|ACCT)/){
			$sc = "$1 <somestring>";
		}
		print $showfd "---> $sc\n";
	}
	
	&chat'print( "$send_cmd\r\n" );
}

sub accept
{
	local( $NS, $S ) = @_;
	local( $nfound, $accept_in, $accept_out, $timeleft, $to );

	vec( $accept_in, fileno( $S ), 1 ) = 1;

	($nfound, $timeleft) = select( $accept_out = $accept_in, undef, undef, $to = $timeout_read );

	if( $nfound <= 0 ){
		return -1;
	}
	
	return accept( $NS, $S );
}

sub printargs
{
	while( @_ ){
		print $showfd shift( @_ ) . "\n";
	}
}

sub filesize
{
	local( $fname ) = @_;

	if( ! -f $fname ){
		return -1;
	}

	return (stat( _ ))[ 7 ];
	
}

sub alarm
{
	local( $time_to_sig ) = @_;
	eval "alarm( $time_to_sig )";
}

# Reply codes, see RFC959:
# 1yz Positive Preliminary.  Expect another reply before proceeding
# 2yz Positive Completion.
# 3yz Positive Intermediate. More information required.
# 4yz Transient Negative Completion.  The user should try again.
# 5yz Permanent Negative Completion.
# x0z Syntax error
# x1z Information
# x2z Connection - control info.
# x3z Authentication and accounting.
# x4z Unspecified
# x5z File system.

# 110 Restart marker reply.
#     In this case, the text is exact and not left to the
#     particular implementation; it must read:
#     MARK yyyy = mmmm
#     Where yyyy is User-process data stream marker, and mmmm
#     server's equivalent marker (note the spaces between markers
#     and "=").
# 120 Service ready in nnn minutes.
# 125 Data connection already open; transfer starting.
# 150 File status okay; about to open data connection.

# 200 Command okay.
# 202 Command not implemented, superfluous at this site.
# 211 System status, or system help reply.
# 212 Directory status.
# 213 File status.
# 214 Help message.
#     On how to use the server or the meaning of a particular
#     non-standard command.  This reply is useful only to the
#     human user.
# 215 NAME system type.
#     Where NAME is an official system name from the list in the
#     Assigned Numbers document.
# 220 Service ready for new user.
# 221 Service closing control connection.
#     Logged out if appropriate.
# 225 Data connection open; no transfer in progress.
# 226 Closing data connection.
#     Requested file action successful (for example, file
#     transfer or file abort).
# 227 Entering Passive Mode (h1,h2,h3,h4,p1,p2).
# 230 User logged in, proceed.
# 250 Requested file action okay, completed.
# 257 "PATHNAME" created.

# 331 User name okay, need password.
# 332 Need account for login.
# 350 Requested file action pending further information.

# 421 Service not available, closing control connection.
#     This may be a reply to any command if the service knows it
#     must shut down.
# 425 Can't open data connection.
# 426 Connection closed; transfer aborted.
# 450 Requested file action not taken.
#     File unavailable (e.g., file busy).
# 451 Requested action aborted: local error in processing.
# 452 Requested action not taken.
#     Insufficient storage space in system.

# 500 Syntax error, command unrecognized.
#     This may include errors such as command line too long.
# 501 Syntax error in parameters or arguments.
# 502 Command not implemented.
# 503 Bad sequence of commands.
# 504 Command not implemented for that parameter.
# 530 Not logged in.
# 532 Need account for storing files.
# 550 Requested action not taken.
#     File unavailable (e.g., file not found, no access).
# 551 Requested action aborted: page type unknown.
# 552 Requested file action aborted.
#     Exceeded storage allocation (for current directory or
#     dataset).
# 553 Requested action not taken.
#     File name not allowed.


# make this package return true
1;