ftp.pl

站点映像程序

		&service_closed();
		$ret = 0;
	}

	if( ! $ret ){
		&close_data_socket;
		return 0;
	}
	
	# if using PASV, no need to accept on this S, just use S2.
	if( $use_pasv ){
		*NS = S2;
	}
	else {
		if( &accept( 'NS', 'S' ) < 0 ){
			&close_data_socket;
			return 0;
		}
	}

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


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

	if( ! $service_open ){
		return 0;
	}

	# read the close
	#
	$ret = &expect($timeout,
        	2, 1 ); # transfer complete, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	# shut down our end of the socket
	&close_data_socket;

	if( ! $ret ){
		return 0;
	}

	return 1;
}

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

	$site_command_check = 0;
	@site_command_list = ();

	if( ! $service_open ){
		return 0;
	}

	&send( "QUIT" );

	$ret = &expect( $timeout, 
		2, 1 ); # transfer complete, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	return $ret;
}

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

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

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

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

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

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

sub read
{
	if( ! $service_open ){
		return -1;
	}

	vec( $read_in, fileno( NS ), 1 ) = 1;

	($nfound, $timeleft) = select( $read_out = $read_in, undef, undef, $to = $timeout_read );

	if( $nfound <= 0 ){
		return -1;
	}
	return sysread( NS, $ftpbuf, $ftpbufsize );
}

sub write
{
	if( ! $service_open ){
		return -1;
	}

	vec( $write_out, fileno( NS ), 1 ) = 1;

	($nfound, $timeleft) = select( undef, $write_in = $write_out, undef, $to = $timeout_read );

	if( $nfound <= 0 ){
		return -1;
	}
	return syswrite( NS, $ftpbuf, $ftpbufsize );
}

# &ftp'dostrip( true or false )
# Turn on or off stripping of incoming carriage returns.
sub ftp'dostrip
{
	($strip_cr ) = @_;
}

# &ftp'get( remote file, local file, try restarting where last xfer failed )
# Get a remote file back into a local file.
# If no loc_fname passed then uses rem_fname.
# If $restart set and the remote site supports it then restart where
# last xfer left off.
# returns 1 on success, 0 otherwise
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( ! &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 ) = &filesize( $loc_fname );
		if( $restart && $restart_at > 0 && &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' )";
	}

	if( $use_pasv ){
		&pasv();
	}

	&send( "RETR $rem_fname" );
	
	$ret = &expect( $timeout, 
		1, 1 ); # receiving $rem_fname
	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
		&close_data_socket;

		return 0;
	}

	# if using PASV, no need to accept on this S, just use S2.
	if( $use_pasv ){
		*NS = S2;
	}
	else {
		if( &accept( 'NS', 'S' ) < 0 ){
			&close_data_socket;
			return 0;
		}
	}

	# 
	# the data should be coming at us now
	#

	# for systems that differentiate between text and binary.
	eval "binmode( NS )";

	#
	#  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
		&close_data_socket;

		return 0;
	}
	# Make sure the file can be updated - but only by me!
	chmod( 0644, $loc_fname );

	# for systems that differentiate between text and binary.
	eval "binmode( FH )";

	local( $start_time ) = time;
	local( $bytes, $lasthash, $hashes ) = (0, 0, 0);

# Use these three lines if you do not have the select() SYSTEM CALL in
# your perl.  There appears to be a memory leak in using these
# and they are usually slower - so only use if you have to!
#  Also comment back in the $SIG... line at the end of the while() loop.
#	local( $old_sig ) = $SIG{ 'ALRM' };
#	$SIG{ 'ALRM' } = "ftp\'read_alarm";
#	while( ($len = &read_nosel()) > 0 ){

# If you have select() then use the following line.
	local( $too_big ) = 0;
	while( ($len = &read()) > 0 ){

		$bytes += $len;
		if( $max_get_size > 0 && $bytes > $max_get_size ){
			$too_big = 1;
			$bytes = -1;
			last;
		}
		if( $strip_cr ){
			$ftpbuf =~ 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;
		}
	}

# Add the next line back if you don't have select().
#	$SIG{ 'ALRM' } = $old_sig;

	# shut down our end of the socket
	&close_data_socket;

	if( ! close( FH ) ){
		print $showfd "\nclose of local file failed: $!";

		return 0;
	}

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

	if( $too_big ){
		print $showfd "Transfer exceeded allowed limit of $max_get_size\
	";
	}

	#
	# read the close
	#

	$ret = &expect( $timeout, 
		2, 1 ); # transfer complete, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

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

	return $ret;
}

# &ftp'delete( remote filename )
# Delete a file from the remote site.
# returns 1 if successful, 0 otherwise
sub delete
{
	local( $rem_fname ) = @_;
	local( $ret );

	if( ! $service_open ){
		return 0;
	}

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

	&send( "DELE $rem_fname" );

	$ret = &expect( $timeout, 
		2, 1 ); # Deleted $rem_fname
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	return $ret == 1;
}

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

    # not yet implemented
    # RMD
}

# &ftp'put( local filename, remote filename, restart where left off )
# Similar to get but sends file to the remote site.
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( ! &open_data_socket() ){
		return 0;
	}
	
	if( $mapunixout ){
		$rem_fname = eval "&$mapunixout( \$rem_fname, 'f' )";
	}

	if( $use_pasv ){
		&pasv();
	}

	&send( "STOR $rem_fname" );
	
	# 
	# the data should be coming at us now
	#
	
	local( $ret ) =
	&expect( $timeout, 
		1, 1 ); # sending $loc_fname
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}

	if( $ret != 1 ){
		# shut down our end of the socket
		&close_data_socket;

		return 0;
	}

	# if using PASV, no need to accept on this S, just use S2.
	if( $use_pasv ){
		*NS = S2;
	}
	else {
		if( &accept( 'NS', 'S' ) < 0 ){
			&close_data_socket;
			return 0;
		}
	}

	# 
	# 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
		&close_data_socket;

		return 0;
	}

	# for systems that differentiate between text and binary.
	eval "binmode( FH )";

	#while( <FH> ){
	#	if( ! $service_open ){
	#		last;
	#	}
	#	print NS ;
	#}
	#close( FH );
	
	local( $bytes_written, $bytes, $lasthash, $hashes ) = (0, 0, 0, 0);

# read the data from FH
	while( ($len = sysread( FH, $ftpbuf, $ftpbufsize )) > 0 ){
		#check size?
		$bytes += $len;

	 	if( $max_get_size > 0 && $bytes > $max_get_size ){
                        $too_big = 1;
                        $bytes = -1;
                        last;
                }
		# write the data to NS checking that all data is written
		# if syswrite returns 0 - written all of file
		$left = $len ;
		while( ($len2 = &write( NS, $ftpbuf, $left )) > 0 ){
			$left = $len - $len2 ;
			$bytes_written+= $len2;
			$ftpbuf = substr( $ftpbuf, $len2, $left);
		}
		if( $len2 < 0 ){
			print "error occurred while writing to network\n";
			return 0;
		}

		# if ( $ftp_show ){ print out some hashes }
                if( $ftp_show ){
                        while( $bytes > ($lasthash + $hashevery) ){
                                print $showfd '#';
                                $lasthash += $hashevery;
                                $hashes++;
                                if( ($hashes % $hashnl) == 0 ){
                                        print $showfd "\n";
                                }
                        }
		}
	}

	if( $ret < 0 ){
		print "error occurred while reading from $loc_fname\n";
		return 0;
	}
	if( $bytes_written != $bytes ){
		# This should never happen but ...
		print "number of bytes written not equal to number read\n";
		exit 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";
        }

        if( $too_big ){
                print $showfd "Transfer exceeded allowed limit of $max_get_size\n";
        }
	
	# shut down our end of the socket to signal EOF
	&close_data_socket;
	#
	# read the close
	#
	
	$ret = &expect( $timeout, 
		2, 1 ); # transfer complete, closing connection
	if( $ret == 99 ){
		&service_closed();
		$ret = 0;
	}
	if( ! $ret ){
		print $showfd "Failure on 'STOR $loc_fname' command\n";
	}