ftp.pl

harvest是一个下载html网页得机器人

#-*-perl-*-
#
# ftp.pl,v 1.15 1995/08/01 19:14:58 duane Exp
#
# This is a wrapper to the chat2.pl routines that make life easier
# to do ftp type work.
# Mostly by Lee McLoughlin <[e-mail]>
# based on original version by Alan R. Martello <[e-mail]>
# And by [e-mail] for multi-homed hosts
#
# Basic usage:
#  $ftp_port = 21;
#  $retry_call = 1;
#  $attempts = 2;
#  if( &ftp'open( $site, $ftp_port, $retry_call, $attempts ) != 1 ){
#   die "failed to open ftp connection";
#  }
#  if( ! &ftp'login( $user, $pass ) ){
#   die "failed to login";
#  }
#  &ftp'type( $text_mode ? 'A' : 'I' );
#  if( ! &ftp'get( $remote_filename, $local_filename, 0 ) ){
#   die "failed to get file;
#  }
#  &ftp'quit();
#
#
# ftp.pl,v 1.15 1995/08/01 19:14:58 duane Exp
# Revision 2.4  1994/01/26  14:59:07  lmjm
# Added DG result code.
#
# Revision 2.3  1994/01/18  21:58:18  lmjm
# Reduce calls to sigset.
# Reset to old signal after use.
#
# Revision 2.2  1993/12/14  11:09:06  lmjm
# Use installed socket.ph.
# Allow for more returns.
#
# Revision 2.1  1993/06/28  15:02:00  lmjm
# Full 2.1 release
#
# Wednesday, March 8 1995  -Duane Wessels
#  - require socket before chat
#  - created $chat'errmsg to track down socket/connect errs
#
$ENV{'HARVEST_HOME'} = "/usr/local/harvest" if (!defined($ENV{'HARVEST_HOME'}));
unshift(@INC, "$ENV{'HARVEST_HOME'}/lib");	# use local installation

require 'socket.ph';	# list this first so socket subs don't go in chat2
require 'chat2.pl';

package ftp;

# Support for using an FTP proxy/gateway
#
$proxy = 0;				# off by default
$proxy_gateway = 'beta';		# proxy's hostname
$proxy_ftp_port = 4514;			# the port
%domains = (				# domains inside the firewall
	'.mydomain.com', 1,
);
@ipmasks = (				# Netmasks of addresses inside
	0xff000000,
	0xff000000,
	0xffffff00,
);
@ipaddresses = (			# IP addresses inside the firewall
	0x0d000000,
	0x7f000000,
	0x1234abcd,
);

#
# END proxy config section


$retry_pause = 60;	# Pause before retrying a login.

if( defined( &main'PF_INET ) ){
	$pf_inet = &main'PF_INET;
	$sock_stream = &main'SOCK_STREAM;
	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
	$tcp_proto = $proto;
}
else {
	# XXX hardwired $PF_INET, $SOCK_STREAM, 'tcp'
	# but who the heck would change these anyway? (:-)
	# Answer: !@#*$# Sun.  
	$pf_inet = 2;
	$sock_stream = 1;
	$tcp_proto = 6;
}

# If the remote ftp daemon doesn't respond within this time presume its dead
# or something.
$timeout = 120;

# Timeout a read if I don't get data back within this many seconds
$timeout_read = 3 * $timeout;

# Timeout an open
$timeout_open = $timeout;

$version = '1.15';

# This is a "global" it contains the last response from the remote ftp server
# for use in error messages
$response = "";
# Also NS is the socket containing the data coming in from the remote ls
# command.

# The size of block to be read or written when talking to the remote
# ftp server
$ftpbufsize = 4096;

# How often to print a hash out, when debugging
$hashevery = 1024;
# Output a newline after this many hashes to prevent outputing very long lines
$hashnl = 70;

# Is there a connection open?
$service_open = 0;

# If a proxy connection then who am I really talking to?
$real_site = "";

# Where error/log reports are sent to
$showfd = 'STDERR';

# Name of a function to call on a pathname to map it into a remote
# pathname.
$mapunixout = '';
$manunixin = '';

# Maximum number of bytes we should transfer
$MAX_TRANSFER_SIZE = 10 * 1024 * 1024;

# This is just a tracing aid.
$ftp_show = 0;

sub ftp'debug
{
	$ftp_show = @_[0];
	if( $ftp_show > 9 ){
		$chat'debug = 1;
	}
}

sub ftp'set_timeout
{
	local( $to ) = @_;
	return if $to == $timeout;
	$timeout = $to;
	$timeout_open = $timeout;
	$timeout_read = 3 * $timeout;
	if( $ftp_show ){
		print $showfd "ftp timeout set to $timeout\n";
	}
}


sub ftp'open_alarm
{
	die "timeout: open";
}

sub ftp'timed_open
{
	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
	local( $connect_site, $connect_port );
	local( $res );

	alarm( $timeout_open );

	while( $attempts-- ){
		if( $ftp_show ){
			print $showfd "proxy connecting via $proxy_gateway [$proxy_ftp_port]\n" if $proxy;
			print $showfd "Connecting to $site";
			if( $ftp_port != 21 ){
				print $showfd " [port $ftp_port]";
			}
			print $showfd "\n";
		}
		
		if( $proxy ) {
			if( ! $proxy_gateway ) {
				# if not otherwise set
				$proxy_gateway = "internet-gateway";
			}
			if( $debug ) {
				print $showfd "using proxy services of $proxy_gateway, ";
				print $showfd "at $proxy_ftp_port\n";
			}
			$connect_site = $proxy_gateway;
			$connect_port = $proxy_ftp_port;
			$real_site = $site;
		}
		else {
			$connect_site = $site;
			$connect_port = $ftp_port;
		}
		if( ! &chat'open_port( $connect_site, $connect_port ) ){
			if( $retry_call ){
				print $showfd "Failed to connect\n" if $ftp_show;
				next;
			}
			else {
				print $showfd "proxy connection failed " if $proxy;
				print $showfd "$connect_site: $chat'errmsg\n" if $ftp_show;
				$response = $chat'errmsg
					if ($response eq '' && $chat'errmsg ne '');
				return 0;
			}
		}
		$res = &ftp'expect( $timeout,
			120, 0, # service unavailable to $site
			220, 1, # ready for login to $site
			421, 0); #service unavailable to $site closing connection
		if( ! $res ){
			&chat'close();
			next;
		}
		return 1;
	}
	continue {
		print $showfd "Pausing between retries\n";
		sleep( $retry_pause );
	}
	return 0;
}

sub main'ftp__sighandler
{
	local( $sig ) = @_;
	local( $msg ) = "Caught a SIG$sig flagging connection down";
	$service_open = 0;
	if( $ftp_logger ){
		eval "&$ftp_logger( \$msg )";
	}
}

sub ftp'set_signals
{
	$ftp_logger = @_;
	$SIG{ 'PIPE' } = "ftp__sighandler";
}

# Set the mapunixout and mapunixin functions
sub ftp'set_namemap
{
	($mapunixout, $mapunixin) = @_;
	if( $debug ) {
		print $showfd "mapunixout = $mapunixout, $mapunixin = $mapunixin\n";
	}
}

sub ftp'set_proxy {
	local($_) = @_;

	return(0) unless /\./; # proxy off for local address

	if(/^\d+\.\d+\.\d+\.\d+$/) { # check ip address aa.bb.cc.dd
		local($val) = 0;

		for(split(/\./)) {
			$val = 256 * $val + $_;
		}
		for($[ .. $#ipaddresses) {
			return(0) if ($val & $ipmasks[$_]) == $ipaddresses[$_];
		}
		return(1);
	}

	# check host name
	tr/A-Z/a-z/;
	local(@parts) = split(/\./);
	local($i);
	local($tail) = undef;

	foreach $i (($[ + 1)..$#parts) {
		$_ = $#parts + $[ - $i + 1;
		$tail = join($parts[$_], '.', $tail);
		return(0) if $domains{$tail};
	}
	return(1);
}

sub ftp'open
{
	local( $site, $ftp_port, $retry_call, $attempts ) = @_;

	# turn off proxying if site is within the firewall as determined
	# by %domains and @ipaddresses.
	$proxy = &set_proxy($site) if $proxy;

	local( $old_sig ) = $SIG{ 'ALRM' };
	$SIG{ 'ALRM' } = "ftp\'open_alarm";

	local( $ret ) = eval "&timed_open( '$site', $ftp_port, $retry_call, $attempts )";
	alarm( 0 );
	$SIG{ 'ALRM' } = $old_sig;

	if( $@ =~ /^timeout/ ){
		return -1;
	}

	if( $ret ){
		$service_open = 1;
	}

	return $ret;
}

sub ftp'login
{
	local( $remote_user, $remote_password ) = @_;
        local( $ret );

	if( ! $service_open ){
		return 0;
	}

	if( $proxy ){
		&ftp'send( "USER $remote_user\@$real_site" );
	}
	else {
		&ftp'send( "USER $remote_user" );
	}
	$ret = &ftp'expect( $timeout,
		230, 1, # $remote_user logged in
		331, 2, # send password for $remote_user

		500, 0, # syntax error
		501, 0, # syntax error
		530, 0, # not logged in
		332, 0, # account for login not supported

		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	if( $ret == 1 ){
		# Logged in no password needed
		return 1;
	}
	elsif( $ret == 2 ){
		# A password is needed
		&ftp'send( "PASS $remote_password" );

		$ret = &ftp'expect( $timeout,
			230, 1, # $remote_user logged in

			202, 0, # command not implemented
			332, 0, # account for login not supported

			530, 0, # not logged in
			500, 0, # syntax error
			501, 0, # syntax error
			503, 0, # bad sequence of commands
			550, 0, # Can't set guest privileges

			421, 99 ); # service unavailable, closing connection
		if( $ret == 99 ){
			&service_closed();
			$ret = 0;
		}
		if( $ret == 1 ){
			# Logged in
			return 1;
		}
	}
	# If I got here I failed to login
	return 0;
}

sub service_closed
{
	$service_open = 0;
	&chat'close();
}

sub ftp'close
{
	&ftp'quit();
	$service_open = 0;
	&chat'close();
}

# Change directory
# return 1 if successful
# 0 on a failure
sub ftp'cwd
{
	local( $dir ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

	if( $mapunixout ){
		$dir = eval "&$mapunixout( \$dir, 'd' )";
	}

	&ftp'send( "CWD $dir" );

	$ret = &ftp'expect( $timeout,
		200, 1, # working directory = $dir
		250, 1, # working directory = $dir
		251, 1, # working directory = $dir		# DG/UX
		257, 1, # working directory = $dir

		500, 0, # syntax error
		501, 0, # syntax error
                502, 0, # command not implemented
		530, 0, # not logged in
                550, 0, # cannot change directory
		421, 99 ); # service unavailable, closing connection

	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	return $ret;
}

# Get a full directory listing:
# &ftp'dir( remote LIST options )
# Start a list going with the given options.
# Presuming that the remote deamon uses the ls command to generate the
# data to send back then then you can send it some extra options (eg: -lRa)
# return 1 if sucessful and 0 on a failure
sub ftp'dir_open
{
	local( $options ) = @_;
	local( $ret );
	
	if( ! $service_open ){
		return 0;
	}

	if( ! &ftp'open_data_socket() ){
		return 0;
	}

	if( $options ){
		&ftp'send( "LIST $options" );
	}
	else {
		&ftp'send( "LIST" );
	}
	
	$ret = &ftp'expect( $timeout,
		150, 1, # reading directory
	
		125, 0, # data connection already open?
	
		450, 0, # file unavailable
		500, 0, # syntax error
		501, 0, # syntax error
		502, 0, # command not implemented
		530, 0, # not logged in
		550, 2, # Error executing /bin/ls, DW
	
	        421, 99 ); # service unavailable, closing connection

	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	if( $ret != 1 ) {
		if( $options ){
			&ftp'send( "NLST $options" );
		}
		else {
			&ftp'send( "NLST" );
		}
		
		$ret = &ftp'expect( $timeout,
			150, 1, # reading directory
			125, 0, # data connection already open?
			450, 0, # file unavailable
			500, 0, # syntax error
			501, 0, # syntax error
			502, 0, # command not implemented
			530, 0, # not logged in
			550, 2, # Error executing /bin/ls, DW
	        	421, 99 ); # service unavailable, closing connection
	}

	if( $ret != 1 ){
		&ftp'close_data_socket;
		return $ret;
	}
	
	accept( NS, S ) || die "accept failed $!";

	# 
	# the data should be coming at us now
	#
	
	return 1;
}


# Close down reading the result of a remote ls command
# return 1 if successful and 0 on failure
sub ftp'dir_close
{
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

	# shut down our end of the socket
	&ftp'close_data_socket;

	# read the close
	#
	$ret = &ftp'expect($timeout,
        	226, 1, # transfer complete, closing connection
        	250, 1, # action completed

	        425, 0, # can't open data connection
        	426, 0, # connection closed, transfer aborted
	        451, 0, # action aborted, local error
	        421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	if( ! $ret ){
		return 0;
	}

	return 1;
}

# Quit from the remote ftp server
# return 1 if successful and 0 on failure
sub ftp'quit
{
	local( $ret );

	$site_command_check = 0;
	@site_command_list = ();

	if( ! $service_open ){
		return 0;
	}

	&ftp'send( "QUIT" );

	$ret = &ftp'expect( $timeout, 
		221, 1, # transfer complete, closing connection
		500, 0, # error quitting??
		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

# Support for ftp'read
sub ftp'read_alarm
{
	die "timeout: read";
}

# Support for ftp'read
sub ftp'timed_read
{
	alarm( $timeout_read );

	return sysread( NS, $ftpbuf, $ftpbufsize );
}

# Do not use this routing use ftp'get
sub ftp'read
{
	if( ! $service_open ){
		return -1;
	}

	local( $ret ) = eval '&timed_read()';
	alarm( 0 );

	if( $@ =~ /^timeout/ ){
		return -1;
	}
	return $ret;
}

# 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
sub ftp'get
{
	local($rem_fname, $loc_fname, $restart ) = @_;
	local( $ret );
	
	if( ! $service_open ){
		return 0;
	}

	if( $loc_fname eq "" ){
		$loc_fname = $rem_fname;
	}
	
	if( ! &ftp'open_data_socket() ){
		print $showfd "Cannot open data socket\n";
		return 0;
	}

	if( $loc_fname ne '-' ){
		# Find the size of the target file
		local( $restart_at ) = &ftp'filesize( $loc_fname );
		if( $restart && $restart_at > 0 && &ftp'restart( $restart_at ) ){
			$restart = 1;
			# Make sure the file can be updated
			chmod( 0644, $loc_fname );
		}
		else {
			$restart = 0;
			unlink( $loc_fname );
		}
	}

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

	&ftp'send( "RETR $rem_fname" );
	
	$ret = &ftp'expect( $timeout, 
		150, 1, # receiving $rem_fname

		125, 0, # data connection already open?
		450, 2, # file unavailable
		550, 2, # file unavailable
		500, 0, # syntax error
		501, 0, # syntax error
		530, 0, # not logged in

		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	if( $ret != 1 ){
		print $showfd "Failure on 'RETR $rem_fname' command\n";

		# shut down our end of the socket
		&ftp'close_data_socket;

		return 0;
	}

	accept( NS, S ) || die "accept failed $!";

	# 
	# the data should be coming at us now
	#

	#
	#  open the local fname
	#  concatenate on the end if restarting, else just overwrite
	if( !open( FH, ($restart ? '>>' : '>') . $loc_fname ) ){
		print $showfd "Cannot create local file $loc_fname\n";

		# shut down our end of the socket
		&ftp'close_data_socket;

		return 0;
	}

	local( $start_time ) = time;
	local( $bytes, $lasthash, $hashes ) = (0, 0, 0);
	local( $old_sig ) = $SIG{ 'ALRM' };
	$SIG{ 'ALRM' } = "ftp\'read_alarm";