ftp.pl

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

	while( ($len = &ftp'read()) > 0 ){
		$bytes += $len;
		if( $strip_cr ){
			$buf =~ s/\r//g;
		}
		if( $ftp_show ){
			while( $bytes > ($lasthash + $hashevery) ){
				print $showfd '#';
				$lasthash += $hashevery;
				$hashes++;
				if( ($hashes % $hashnl) == 0 ){
					print $showfd "\n";
				}
			}
		}
		if( ! print FH $ftpbuf ){
			print $showfd "\nfailed to write data";
			$bytes = -1;
			last;
		}
		if ($bytes > $MAX_TRANSFER_SIZE) {
			printf $showfd ("ftp.pl: WARNING!: transfer has exceeded %d bytes of data, aborting.\n", $MAX_TRANSFER_SIZE);
			last;
		}
	}
	$SIG{ 'ALRM' } = $old_sig;
	close( FH );

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

	if( $len < 0 ){
		print $showfd "\ntimed out reading data!\n";

		return 0;
	}
		
	if( $ftp_show && $bytes > 0 ){
		if( $hashes && ($hashes % $hashnl) != 0 ){
			print $showfd "\n";
		}
		local( $secs ) = (time - $start_time);
		if( $secs <= 0 ){
			$secs = 1; # To avoid a divide by zero;
		}

		local( $rate ) = int( $bytes / $secs );
		print $showfd "Got $bytes bytes ($rate bytes/sec)\n";
	}

	#
	# read the close
	#

	$ret = &ftp'expect( $timeout, 
		226, 1, # transfer complete, closing connection
	        250, 1, # action completed
	
	        110, 0, # restart not supported
	        425, 0, # can't open data connection
	        426, 0, # connection closed, transfer aborted
	        451, 0, # action aborted, local error
		550, 0, # permission denied

		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	if( $ret && $bytes < 0 ){
		$ret = 0;
	}

	return $ret;
}

sub ftp'delete
{
	local( $rem_fname ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

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

	&ftp'send( "DELE $rem_fname" );

	$ret = &ftp'expect( $timeout, 
		250, 1, # Deleted $rem_fname
		550, 0, # Permission denied

		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	return $ret == 1;
}

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

    # not yet implemented
    # RMD
}

# UPDATE ME!!!!!!
# Add in the hash printing and newline conversion
sub ftp'put
{
	local( $loc_fname, $rem_fname ) = @_;
	local( $strip_cr );
	
	if( ! $service_open ){
		return 0;
	}

	if( $loc_fname eq "" ){
		$loc_fname = $rem_fname;
	}
	
	if( ! &ftp'open_data_socket() ){
		return 0;
	}
	
	if( $mapunixout ){
		$rem_fname = eval "&$mapunixout( \$rem_fname, 'f' )";
	}

	&ftp'send( "STOR $rem_fname" );
	
	# 
	# the data should be coming at us now
	#
	
	local( $ret ) =
	&ftp'expect( $timeout, 
		150, 1, # sending $loc_fname

		125, 0, # data connection already open?
		450, 0, # file unavailable
		532, 0, # need account for storing files
		452, 0, # insufficient storage on system
		553, 0, # file name not allowed
		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 ){
		# 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
	#
	if( !open( FH, "<$loc_fname" ) ){
		print $showfd "Cannot open local file $loc_fname\n";

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

		return 0;
	}
	
	while( <FH> ){
		if( ! $service_open ){
			last;
		}
		print NS ;
	}
	close( FH );
	
	# shut down our end of the socket to signal EOF
	&ftp'close_data_socket;
	
	#
	# read the close
	#
	
	$ret = &ftp'expect( $timeout, 
		226, 1, # transfer complete, closing connection
		250, 1, # action completed
	
		110, 0, # restart not supported
		425, 0, # can't open data connection
		426, 0, # connection closed, transfer aborted
		451, 0, # action aborted, local error
		551, 0, # page type unknown
		552, 0, # storage allocation exceeded
	
		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	if( ! $ret ){
		print $showfd "Failure on 'STOR $loc_fname' command\n";
	}
	return $ret;
}

sub ftp'restart
{
	local( $restart_point, $ret ) = @_;

	if( ! $service_open ){
		return 0;
	}

	&ftp'send( "REST $restart_point" );

	# 
	# see what they say

	$ret = &ftp'expect( $timeout, 
		350, 1, # restarting at $restart_point
			   
		500, 0, # syntax error
		501, 0, # syntax error
		502, 2, # REST not implemented
		530, 0, # not logged in
		545, 2, # REST not implemented
		554, 2, # REST not implemented
			   
		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

# Set the file transfer type
sub ftp'type
{
	local( $type ) = @_;

	if( ! $service_open ){
		return 0;
	}

	&ftp'send( "TYPE $type" );

	# 
	# see what they say

	$ret = &ftp'expect( $timeout, 
		200, 1, # file type set to $type
			   
		500, 0, # syntax error
		501, 0, # syntax error
		504, 0, # Invalid form or byte size for type $type
			   
		421, 99 ); # service unavailable, closing connection
	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 );
	
	if( ! $service_open ){
		return 0;
	}

	# if we havent sent a 'HELP SITE', send it now
	if( !$site_command_check ){
	
		$site_command_check = 1;
	
		&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,
			".*HELP.*", "\$1",
			214, "0",
			202, "0",
			421, "99" ); # service unavailable, closing connection
		if( $ret == 99 ){
			&service_closed();
			$ret = "0";
		}
	
		if( $ret eq "0" ){
			print $showfd "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
sub ftp'pwd
{
	local( $ret, $cwd );

	if( ! $service_open ){
		return 0;
	}

	&ftp'send( "PWD" );

	# 
	# see what they say

	$ret = &ftp'expect( $timeout, 
		251, 1, # working dir is		# DG/UX
		257, 1, # working dir is
		500, 0, # syntax error
		501, 0, # syntax error
		502, 0, # PWD not implemented
		550, 0, # file unavailable

		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	if( $ret ){
		if( $response =~ /^25[0-9]\s"(.*)"\s.*$/ ){
			$cwd = $1;
		}
	}
	return $cwd;
}

# return 1 for success, 0 for failure
sub ftp'mkdir
{
	local( $path ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

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

	&ftp'send( "MKD $path" );

	# 
	# see what they say

	$ret = &ftp'expect( $timeout, 
		257, 1, # made directory $path
			   
		500, 0, # syntax error
		501, 0, # syntax error
		502, 0, # MKD not implemented
		530, 0, # not logged in
		550, 0, # file unavailable

		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

# return 1 for success, 0 for failure
sub ftp'chmod
{
	local( $path, $mode ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

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

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

	# 
	# see what they say

	$ret = &ftp'expect( $timeout, 
		200, 1, # chmod $mode $path succeeded
			   
		500, 0, # syntax error
		501, 0, # syntax error
		502, 0, # CHMOD not implemented
		530, 0, # not logged in
		550, 0, # file unavailable

		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

# rename a file
sub ftp'rename
{
	local( $old_name, $new_name ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

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

	&ftp'send( "RNFR $old_name" );

	# 
	# see what they say

	$ret = &ftp'expect( $timeout, 
		350, 1, #  OK
			   
		500, 0, # syntax error
		501, 0, # syntax error
		502, 0, # RNFR not implemented
		530, 0, # not logged in
		550, 0, # file unavailable
		450, 0, # file unavailable
			   
		421, 99 ); # service unavailable, closing connection
	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' )";
		}

		&ftp'send( "RNTO $new_name" );
	
		# 
		# see what they say
	
		$ret = &ftp'expect( $timeout, 
			250, 1,  # rename $old_name to $new_name

			500, 0, # syntax error
			501, 0, # syntax error
			502, 0, # RNTO not implemented
			503, 0, # bad sequence of commands
			530, 0, # not logged in
			532, 0, # need account for storing files
			553, 0, # file name not allowed

			421, 99 ); # service unavailable, closing connection
		if( $ret == 99 ){
			&service_closed();
			$ret = 0;
		}
	}

	return $ret;
}


sub ftp'quote
{
	local( $cmd ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

	&ftp'send( $cmd );

	$ret = &ftp'expect( $timeout, 
		200, 1, # Remote '$cmd' OK
                213, 1, # SIZE command OK
		500, 0, # error in remote '$cmd'
		421, 99 ); # service unavailable, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

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

sub ftp'expectgot
{
	($response, $fatalerror) = @_;
	if( $ftp_show ){
		print $showfd "$response\n";
	}
}

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

	$time_out = shift( @_ );
	
	while( @_ ){
		$code = shift( @_ );
		$pre = '^';
		if( $code =~ /^\d+$/ ){
			$pre = "[.|\n]*^";
		}
		push( @expect_args, "$pre(" . $code . " .*)\\015\\n" );
		push( @expect_args, 
			"&expectgot( \$1, 0 ); " . shift( @_ ) );
	}
	
	# 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( $ftp_show > 9 ){
		&printargs( $time_out, @expect_args );
	}
	
	$ret = &chat'expect( $time_out, @expect_args );
	if( $ret == 100 ){
		# we saw a continuation line, wait for the end
		push( @expect_args, "^.*\n" );
		push( @expect_args, "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 ftp'open_data_socket
{
	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;
	
	socket( S, $pf_inet, $sock_stream, $tcp_proto ) || die "socket: $!";
	bind( S, $this ) || die "bind: $!";
	
	# 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
	#
	listen( S, 5 ) || die "listen";
	
	&ftp'send( "PORT $a,$b,$c,$d,$hi,$lo" );
	
	return &ftp'expect($timeout,
		200, 1, # PORT command successful
		250, 1, # PORT command successful

		500, 0, # syntax error
		501, 0, # syntax error
		530, 0, # not logged in

		421, 0); # service unavailable, closing connection
}
	
sub ftp'close_data_socket
{
	close( NS );
}

sub ftp'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/){
			$sc = "PASS <somestring>";
		}
		print $showfd "---> $sc\n";
	}
	
	&chat'print( "$send_cmd\r\n" );
}

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

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

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

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

# make this package return true
1;