Attachment #871190 for bug #1214412

View | Details | Raw Unified | Return to bug 1214412
Collapse All | Expand All




# Allow strip_cr (from Andrew).
# More symlink handling...
# Set type for vms correctly.
# Changed response from ftp'delete, also corrected path used.
#
# Revision 2.4  1994/04/29  20:11:09  lmjm
# Use correct variable for hostname


	if( $debug ){
		# Keep the ftp debugging lower than the rest.
		&ftp'debug( $debug - 1);
	}
	else {
		&ftp'debug( $verbose );
	}

	if( $recurse_hard ){

	}

	if( ! $interactive ){
		$ftp'showfd = 'STDOUT';
	}
	&ftp'set_timeout( $timeout );
	&ftp'set_signals( "main'msg" );

	# set passive ftp mode
	if( $passive_ftp ){
		$ftp'use_pasv = 1;
	}

	# Are we using the SOCKS version of perl?
	if( $using_socks ){
		$chat'using_socks = 1;
	}

	# Useful string in prints

	if( $con == 1 ){
		&msg( "login as $remote_user\n" ) if $debug > 1;
		$curr_remote_user = $remote_user;
		if( ! &ftp'login( $remote_user, $remote_password, $remote_account ) ){
			&msg( "Cannot login, skipping package\n" );
			&disconnect();
			&msg( "\n" );
			return $exit_status;
		}
		$can_restart = (&ftp'restart(0) == 1);
		if( $debug > 1 ){
			&msg( "Can " . ($can_restart ? '' : "not ") . "do restarts\n" );


		&msg( "Already connected to site $site\n" ) if $debug;
	}

	if( ! &ftp'type( $text_mode ? 'A' : 'I' ) ){
		&msg( "Cannot set type\n" );
	}


	# setting the namemap functions.
	if( $remote_fs =~ /vms/i ){
		$vms = 1;
		&ftp'set_namemap( "main'unix2vms", "main'vms2unix" );
	}
	else {
		$vms = 0;
		# No mapping necessary
		&ftp'set_namemap( '' );
	}

	if( ! $get_file || $remote_idle ){
		local( @rhelp ) = &ftp'site_commands();
		$remote_has_chmod = grep( $_ eq 'CHMOD', @rhelp);
		$remote_has_rename = grep( $_ eq 'RNFR', @rhelp) && grep( $_ eq 'RNTO', @rhelp);
		$remote_has_idle = grep( $_ eq 'IDLE', @rhelp);

	}
	
	if( $remote_has_idle && $remote_idle ){
		if( ! &ftp'quote( "site idle $remote_idle" ) ){
			&msg( "Cannot set remote idle\n" );
		}
		elsif( $debug > 2 ){

	}

	if( $remote_group ){
		if( ! &ftp'quote( "site group $remote_group" ) ){
			&msg( "Cannot set remote group\n" );
		}
		elsif( $debug > 2 ){

	}
	
	if( $remote_gpass ){
		if( ! &ftp'quote( "site gpass $remote_gpass" ) ){
			&msg( "Cannot set remote gpass\n" );
		}
		elsif( $debug > 2 ){

{
	if( $connected ){
		&msg( "disconnecting from $connected\n" ) if $debug;
		if( ! $ftp'fatalerror ){
			&ftp'close();
		}
		else {
			&ftp'service_closed();
		}
	}
	$connected = '';

	&disconnect();

	if( $proxy ){
	    $ftp'proxy = $proxy;
	    $ftp'proxy_gateway = $proxy_gateway;
	    $ftp'proxy_ftp_port = $proxy_ftp_port;
	}
	$res = &ftp'open( $site, $ftp_port, $retry_call, $attempts );
	if( $res == 1 ){
		# Connected
		$connected = $site;

	if( $debug > 2 ){
		&msg( " prodding remote ftpd\n" );
	}
	&ftp'pwd();
}

# checkout and fixup any regexps.

	$remote_type[ 0 ] = 0;
	$remote_mode[ 0 ] = 0;

	if( $remote_fs !~ /cms/ && ! &ftp'cwd( $remote_dir ) ){
		if( $get_file ){
			# no files to get
			return 0;

		&msg( "Failed to change to remote directory ($remote_dir) trying to create it\n" );
		&mkdirs( $remote_dir );

		if( ! &ftp'cwd( $remote_dir ) ){
			&msg( "Cannot change to remote directory ($remote_dir) because: $ftp'response\n" );
			return 0;
		}
	}

			&msg( "Cannot open $dirtmp\n" );
			return 0;
		}
		$rls = "main'DIRTMP";
		# Now we don't want to overwrite our input... better test?
		if( $local_ls_lR_file eq $storename ){
			$storename = "/dev/null";

		}

		&msg( " Getting directory listing from remote file $ls_lR_file\n" ) if $debug;
		if( ! &ftp'get( $ls_lR_file, $dirtmp, 0 ) ){
			&msg( "Cannot get dir listing file\n" );
			return 0;
		}

		}

		open( DIRTMP, $dirtmp ) || die "Cannot open $dirtmp";
		$rls = "main'DIRTMP";
	}
	else {
		$use_ls = 1;
		if( ! &ftp'type( 'A' ) ){
			&msg( "Cannot set type to ascii for dir listing, ignored\n" );
			$type_changed = 0;
		}

		}
	}
	
	$lsparse'fstype = $remote_fs;
	$lsparse'name = "$site:$package";
	
	if( $use_ls ){
		local( $flags ) = $flags_nonrecursive;
		if( $recursive && ! $recurse_hard ){
			$flags = $flags_recursive;
		}
		$lsparse'report_subdirs = (! $recurse_hard && $algorithm == 0);
	 	if( !&ftp'dir_open( $flags ) ){
			&msg( "Cannot get remote directory listing because: $ftp'response\n" );
			return 0;
		}
		

		# relative to the remote_dir
		$rcwd = $remote_dir;
	}
	$dateconv'use_timelocal = $use_timelocal;
	if( !&lsparse'reset( $rcwd ) ){
		&msg( "$remote_fs: unknown fstype\n" );
		return 0;
	}

		# Could optimise this out - but it makes sure that
		# the other end gets a command straight after a possibly
		# long dir listing.
		if( ! &ftp'type( $text_mode ? 'A' : 'I' ) ){
			local( $msg ) = "Cannot reset type after dir listing, ";
			if( $type_changed ){
				# I changed it before - so I must be able to

	while( 1 ){
		while( !eof( $rls ) ){
			( $path, $size, $time, $type, $mode ) =
				&lsparse'line( $rls );
			last if $path eq '';
			if( $ls_fix_mappings ){
				local( $old_path ) = $path;

		}

		if( $use_ls ){
			if( ! &ftp'dir_close() ){
				&msg( "Failure at end of remote directory" .
				 " ($rdir) because: $ftp'response\n" );
				return 0;
			}
		}

			while( 1 ){
				if( $#dir_list < 0 ){
					# Make sure we end in the right directory.
					if( ! &ftp'cwd( $remote_dir ) ){
						&msg( "Cannot change to remote directory" .
						 " ($rdir) because: $ftp'response\n" );
						return 0;
					}
					$done = 1;

				if( $debug > 2 ){
					print "scanning: $remote_dir / $rcwd\n";
				}
				if( ! &ftp'cwd( $rdir ) ){
					&msg( "Cannot change to remote directory" .
					 " ($rdir) because: $ftp'response\n" );
					next;
				}
				last;

			if( $done ){
				last;
			}
		 	if( !&ftp'dir_open( $flags_nonrecursive ) ){
				&msg( "Cannot get remote directory" .
				  	" listing because: $ftp'response\n" );
				return 0;
			}
			&lsparse'reset( $rcwd );
			
			# round the loop again.
			next;

	
	if( $external_mapping ){
		$old_name = $name;
		local( $tmp ) = &extmap'map( $name );
		if( $tmp ne $old_name ){
			$name = $tmp;
		}

			&transfer_file( $src_path, $dest_path,
				       $attribs, $remote_time[ $srci ] );
		if( $get_file && $newpath eq '' ){
			&msg( $log, "Failed to $XFER file $ftp'response\n" );
			if( $ftp'response =~ /timeout|timed out/i ){
				$timeouts++;
			}
			if( $ftp'fatalerror || $timeouts > $max_timeouts ){
				&msg( $log, "Fatal error talking to site, skipping rest of transfers\n" );
				&disconnect();
				return;

	}
	
	if( $vms ){
		&ftp'type( ($src_path =~ /$vms_xfer_text/i) ? 'A' : 'I' );
	}
	
	if( $remote_fs eq 'macos' && ! $get_file ){
		&ftp'type( 'A' );
	}
	
	if( ! $get_file ){

			$temp = $dest_path;
		}

		if( ! &ftp'put( $src_file, $temp, $restart ) ){
			&msg( $log, "Failed to put $src_file: $ftp'response\n" );
			unlink( $comptemp ) if $comptemp;
			return '';
		}
	
		unlink( $comptemp ) if $comptemp;
		if( !$no_rename && ! &ftp'rename( $temp, $dest_path ) ){
			&msg( $log, "Failed to remote rename $temp to $dest_path: $ftp'response\n" );
			return '';
		}


	# it.

	# Get a file
	&ftp'dostrip( $strip_cr );
	$start_time = time;
	if( ! &ftp'get( $src_path, $temp, $restart ) ){
		if( !$failed_gets_excl || $ftp'response !~ /$failed_gets_excl/ ){
			&msg( $log, "Failed to get $src_path: $ftp'response\n" );
		}

		# Time stamp the temp file to allow for a restart


	# delete source file after successful transfer
	if( $delete_source ){
		if( &ftp'delete( $src_path ) ){
			&msg( $log, "Deleted remote $src_path\n");
		}
		else {

			}
			else {
				&msg( $log, "delete DIR $del\n" );
				&ftp'delete( "$del" ) ||
					&msg( $log, "ftp delete DIR $del failed\n" );
			}
		}

		}
		else {
			&msg( $log, "delete FILE $del\n" );
			&ftp'delete( "$del" ) ||
				&msg( $log, "ftp delete FILE $del failed\n" );
		}
	}

	}
	else {
		# make a remote directory
		$val = &ftp'mkdir( $dir );

		# The mkdir might have failed due to bad mode
		# So try to chmod it anyway
		if( $remote_has_chmod ){
			$val = &ftp'chmod( $dir, $mode );
		}
	}


	}
	else {
		# check if remote directory exists
		local($old_dir) = &ftp'pwd();		
		
		$val = &ftp'cwd($dir);

		# If I didn't manage to change dir should be where I was!
		if( $val ){
			# go back to the original directory
			&ftp'cwd($old_dir) || die "Cannot cd to original remote directory";
		}
	}
	return $val;

	else {
		# change the remote file
		if( $remote_has_chmod ){
			&ftp'chmod( $path, $mode );
		}
	}
}




# input date and time string from ftp "ls -l", such as Mmm dd yyyy or
# Mmm dd HH:MM,
# return $time number via gmlocal( $string ).
sub main'lstime_to_time
{
	package dateconv;


	}

	if( $use_timelocal ){
		return &'timelocal( $secs, $mins, $hours, $day, $month, $year );
	}
	else {
		return &'timegm( $secs, $mins, $hours, $day, $month, $year );
	}
}

# input time number, output GMT string as "dd Mmm YYYY HH:MM"
sub main'time_to_standard
{
	package dateconv;





# Lots of changes.  See CHANGES since 2.8 file.
#
# Revision 2.3  1994/02/03  13:45:35  lmjm
# Correct chat'read (bfriesen@simple.sat.tx.us)
#
# Revision 2.2  1993/12/14  11:09:03  lmjm
# Only include sys/socket.ph if not already there.

	eval "use Socket";
}
else {
	unless( defined &'PF_INET ){
		eval "sub ATT { 0; } sub INTEL { 0; }";
		do 'sys/socket.ph';
	}


# Get the correct magic numbers for socket work.
if( $] =~ /^5\.\d+$/ ){
	# Perl 5 has a special way of getting them via the 'use Socket'
	# above.
	$main'pf_inet = &Socket'PF_INET;
	$main'sock_stream = &Socket'SOCK_STREAM;
	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
	$main'tcp_proto = $proto;
}
elsif( defined( &'PF_INET ) ){
	# Perl 4 needs to have the socket.ph file created when perl was
	# installed.
	$main'pf_inet = &'PF_INET;
	$main'sock_stream = &'SOCK_STREAM;
	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
	$main'tcp_proto = $proto;
}
else {
	# Whoever installed perl didn't run h2ph !!!

	#  last resort
	# Use hardwired versions
	# but who the heck would change these anyway? (:-)
	$main'pf_inet = 2;
	$main'sock_stream = 1; # Sigh... On Solaris set this to 2
	$main'tcp_proto = 6;
	warn "lchat.pl: using hardwired in network constantants";
}


}


## &chat'open_port("server.address",$port_number);
## opens a named or numbered TCP server
sub open_port { ## public
	local($server, $port) = @_;

		$serveraddr = $x[4];
	}
	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
	unless (socket(S, $main'pf_inet, $main'sock_stream, $main'tcp_proto)) {
		($!) = ($!, close(S)); # close S while saving $!
		return undef;
	}

##############################################################################


## $return = &chat'expect($timeout_time,
## 	$pat1, $body1, $pat2, $body2, ... )
## $timeout_time is the time (either relative to the current time, or
## absolute, ala time(2)) at which a timeout event occurs.

		 		select($rmask, undef, undef, $endtime - time);
			if ($nfound) {
				$nread = sysread(S, $thisbuf, 1024);
				if( $chat'debug ){
					print STDERR "sysread $nread ";
					print STDERR ">>$thisbuf<<\n";
				}

	& $subname();
}

## &chat'print(@data)
sub print { ## public
	print S @_;
	if( $chat'debug ){
		print STDERR "printed:";
		print STDERR @_;
	}
}

## &chat'close()
sub close { ## public
	close(S);
}

# &chat'read(*buf, $ntoread )
# blocking read. returns no. of bytes read and puts data in $buf.
# If called with ntoread < 0 then just do the accept and return 0.
sub read { ## public




#  $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'close();
#
#
# $Id: ftp.pl,v 2.9 1998/05/29 19:02:00 lmjm Exp lmjm $


# This is a "global" it contains the last response from the remote ftp server
# for use in error messages
$ftp'response = "";

# Also ftp'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

$real_site = "";

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

# Should a 421 be treated as a connection close and return 99 from
# ftp'expect.  This is against rfc1123 recommendations but I've found
# it to be a wise default.
$ftp'drop_on_421 = 1;

# Name of a function to call on a pathname to map it into a remote
# pathname.

$ftp_show = 0;

# Global set on a error that aborts the connection
$ftp'fatalerror = 0;

# Whether to keep the continuation messages so the user can look at them
$keep_continuations = 0;

$read_in = undef;

# should we use the PASV extension to the ftp protocol?
$ftp'use_pasv = 0;    # 0=no (default), 1=yes

# Variable only used if proxying
$proxy = $proxy_gateway = $proxy_ftp_port = '';

# (Normally set elsewhere - this is just a sensible default.)
# Is expected to take count and code as arguments and prompt
# for the secret key  with 'password:' on stdout and then print the password.
$ftp'keygen_prog = '/usr/local/bin/key';

# Uncomment to turn on lots of debugging.
# &debug( 10 );

# Limit how much data any one ftp'get can pull back
# Negative values cause the size check to be skipped.
$max_get_size = -1;

# Where I am connected to.
$connect_site = '';

# &ftp'debug( debugging_level )
# Turn on debugging ranging from 1 = some to 10 = everything
sub ftp'debug
{
	$ftp_show = $_[0];
	if( $ftp_show > 9 ){
		$chat'debug = 1;
	}
}

# &ftp'set_timeout( seconds )
sub ftp'set_timeout
{
	local( $to ) = @_;
	return if $to == $timeout;

			$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;

		$ret = &expect( $timeout,
			2, 1 ); # ready for login to $site
		if( $ret != 1 ){
			&chat'close();
			next;
		}
		return 1;

}

# Setup a signal handler for possible errors.
sub ftp'set_signals
{
	$ftp_logger = @_;
	$SIG{ 'PIPE' } = "ftp'ftp__sighandler";
}

# Setup a signal handler for user interrupts.
sub ftp'set_user_signals
{
	$ftp_logger = @_;
	$SIG{ 'INT' } = "ftp'ftp__sighandler";
}

# &ftp'set_namemap( function to map outgoing name,  function to map incoming )
sub ftp'set_namemap
{
	($mapunixout, $mapunixin) = @_;
	if( $debug ) {

	}
}

# &ftp'open( hostname or address,
#            port to use,
#            retry on call failure,
#	     number of attempts to retry )
# returns 1 if connected, 0 otherwise
sub ftp'open
{
	local( $site, $ftp_port, $retry_call, $attempts ) = @_;


	return $ret;
}

# &ftp'login( user, password, account )
# the account part is optional unless the remote service requires one.
sub ftp'login
{
	local( $remote_user, $remote_password, $remote_account ) = @_;
        local( $ret );

		# check for s/key challenge - eg, [s/key 994 ph29005]
		# If we are talking to skey then use remote_password as the
		# secret to generate a real password
		if( $ftp'response =~ m#\[s/key (\d+) (\w+)\]# ){
			local( $count, $code ) = ($1, $2);

			# TODO: report open failure & remove need for echo
			open( SKEY, "echo $remote_password | $ftp'keygen_prog $count $code |" );
			while( <SKEY> ){
				if( ! /password:/ ){
					chop( $remote_password = $_ );

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

# Close down the current ftp connecting in an orderly way.
sub ftp'close
{
	&quit();
	$service_open = 0;
	&chat'close();
}

# &ftp'cwd( directory )
# Change to the given directory
# return 1 if successful, 0 otherwise
sub ftp'cwd
{
	local( $dir ) = @_;
	local( $ret );

sub pasv
{
	# At some point I need to close/free S2, no?
	unless( socket( S2, $main'pf_inet, $main'sock_stream, $main'tcp_proto ) ){
		($!) = ($!, close(S2)); # close S2 while saving $!
		return undef;
	}

	}

	# now need to connect() the new socket
	if( ! &chat'open_newport( $newhost, $newport, *S2 ) ){
		if( $retry_call ){
			print $showfd "Failed to connect newport\n" if $ftp_show;
			next;

}


# &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, 0 otherwise
sub ftp'dir_open
{
	local( $options ) = @_;
	local( $ret );


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



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

	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 );

	return $ret;
}

# &ftp'delete( remote filename )
# Delete a file from the remote site.
# returns 1 if successful, 0 otherwise
sub delete

    # 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 );

	return $ret;
}

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


	return $ret;
}

# &ftp'type( 'A' or 'I' )
# set transfer type to Ascii or Image.
sub type
{

@site_command_list = ();

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

}

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


	return $cwd;
}

# &ftp'mkdir( directory name )
# Create a directory on the remote site
# return 1 for success, 0 otherwise
sub mkdir

	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

	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 );

}


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

}

#
#  create the list of parameters for chat'expect
#
#  expect( time_out, {value, return value} );
#  the last response is stored in $response

		if( $ftp_show > 9 ){
			&printargs( $time_out, @expect_args );
		}
		$ret = &chat'expect( $time_out, @expect_args );
	}

	return $ret;

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

		print $showfd "---> $sc\n";
	}
	
	&chat'print( "$send_cmd\r\n" );
}

sub accept




# This software is provided "as is" without express or implied warranty.
#
# Parse "ls -lR" type listings
# use lsparse'reset( dirname ) repeately
#
# By Lee McLoughlin <lmjm@icparc.ic.ac.uk>
#

local( $match );

# The filestore type being scanned
$lsparse'fstype = 'unix';

# Keep whatever case is on the remote system.  Otherwise lowercase it.
$lsparse'vms_keep_case = '';

# A name to report when errors occur
$lsparse'name = 'unknown';

# Wether to report subdirs when finding them in a directory
# or when their details appear.  (If you report early then mirro might
# recreate locally remote restricted directories.)
$lsparse'report_subdir = 0;	# Report when finding details.


# Name of routine to call to parse incoming listing lines

# Set the directory that is being scanned and
# check that the scan routing for this fstype exists
# returns false if the fstype is unknown.
sub lsparse'reset
{
	$here = $currdir = $_[0];
	$now = time;

	$vms_strip =~ s,^/+,,;
	$vms_strip =~ s,/+$,,;

	$ls_line = "lsparse'line_$fstype";
	return( defined( &$ls_line ) );
}

# See line_unix following routine for call/return details.
# This calls the filestore specific parser.
sub lsparse'line
{
	local( $fh ) = @_;

	# ls_line is setup in lsparse'reset to the name of the function
	local( $path, $size, $time, $type, $mode ) =
		eval "&$ls_line( \$fh )";


# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_unix
{
	local( $fh ) = @_;
	local( $non_crud, $perm_denied );


	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		# Stomp on carriage returns
		s/\015//g;

		if( $perm_denied ){
			$perm_denied = "";
			warn "Warning: input corrupted by 'Permission denied'",
				"errors, about line $. of $lsparse'name\n";
			next;
		}
		# Not found's are like Permission denied's.  They can start part

		if( $not_found ){
			$not_found = "";
			warn "Warning: input corrupted by 'not found' errors",
				" about line $. of $lsparse'name\n";
			next;
		}
		

				next;
			}

			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = '?';
			local( $mode ) = 0;


# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_dls
{
	local( $fh ) = @_;
	local( $non_crud, $perm_denied );


	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		# Stomp on carriage returns
		s/\015//g;

			}
			else {
				# a file
				$time = &main'lstime_to_time( $lsdate );
				$type = 'f';
				$mode = 0444;
			}

# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_netware
{
	local( $fh ) = @_;



	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		# Stomp on carriage returns
		s/\015//g;

			if( $file eq '.' || $file eq '..' ){
				next;
			}
			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = '?';
			local( $mode ) = 0;


# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_vms
{
	local( $fh ) = @_;
	local( $non_crud, $perm_denied );


	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		# Stomp on carriage returns
		s/\015//g;

		}

		# Upper case is so ugly
		if( ! $lsparse'vms_keep_case ){
			tr/A-Z/a-z/;
		}


		$size = 0;
		
		if( $got ){
			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = 'f';
			local( $mode ) = 0444;


				$mode = 0555;
			}

			$lsparse'vers = $vers;

#print "file=|$file| match=|$match| vms_strip=|$vms_strip|\n";
			$file =~ s,^,/,;

# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_dosftp
{
	local( $fh ) = @_;


			$_ = <$fh>;

			# Store listing
			print main'STORE $_;

			# Ignore the summary at the end and blank lines
			if( /^\d+ files?\./ || /^\s+$/ ){


			# TODO: fix hacky 19$yr
			local( $lsdate ) = "$day-$mon-19$yr $hrs:$min";
			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = '?';
			local( $mode ) = 0;


# 03-08-94  07:17AM                 5504 article.xfiles.intro
# 02-28-94  11:44AM                 3262 article1.gillian.anderson

sub lsparse'line_dosish
{
	local( $fh ) = @_;


		$_ = <$fh>;

		# Store listing
		print main'STORE $_;

		# Ignore blank lines
		if( /^\s+$/ ){


			# TODO: fix hacky 19$yr
			local( $lsdate ) = "$day-$mon-19$yr $hrs:$min";
			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = ($dir_or_size eq '<DIR>' ? 'd' : 'f');
			local( $mode ) = 0;
			local( $size ) = 0;

# WPKIT1.EXE          960338      06/21/95        17:01
# CMT.CSV                  0      07/06/95        14:56

sub lsparse'line_supertcp
{
    local( $fh ) = @_;


	    $_ = <$fh>;

	    # Store listing
	    print main'STORE $_;

	    # Ignore the summary at the end and blank lines
	    if( /^\d+ files?\./ || /^\s+$/ ){

	    $pending = $5;

	    local( $lsdate ) = "$day-$mon-$yr $time";
	    local( $time ) = &main'lstime_to_time( $lsdate );
            local( $type ) = '?';
	    local( $mode ) = 0;


#               372      A          08-09-95   10:26  Aussie_1.bag
#            310992                 06-28-94   09:56  INSTALL.EXE

sub lsparse'line_os2
{
	local( $fh ) = @_;


		$_ = <$fh>;

		# Store listing
		print main'STORE $_;

		# Ignore blank lines
		if( /^\s+$/ ){


			# TODO: fix hacky 19$yr
			local( $lsdate ) = "$day-$mon-19$yr $hrs:$min";
			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = ($dir eq 'DIR' ? 'd' : 'f');
			local( $mode ) = 0;


# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_chameleon
{
    local( $fh ) = @_;


	    $pending = $5;

	    local( $lsdate ) = "$day-$mon-$yr $time";
	    local( $time ) = &main'lstime_to_time( $lsdate );
            local( $type ) = '?';
	    local( $mode ) = 0;


# time is a Un*x time value for the file
# type is "f" for a file, "d" for a directory and
#         "l linkname" for a symlink
sub lsparse'line_macos
{
	local( $fh ) = @_;
	local( $non_crud, $perm_denied );


	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		# Stomp on carriage returns
		s/\015//g;

		if( /^([\-rwxd]{10}).*\s(\d+\s+)?(\S+)\s+\d+\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/ ){
			local( $kind, $size, $lsdate, $file ) = ($1, $3, $4, $6);
			
			local( $time ) = &main'lstime_to_time( $lsdate );
			local( $type ) = '?';
			local( $mode ) = 0;




# --------------------- parse lsparse log file format
# lsparse'line_lsparse() is for input in lsparse's internal form,
# as it might have been written to a log file during a previous
# run of a program that uses lsparse.  The format is:
#     filename size time type mode
# where size and time are in decimal, mode is in decimal or octal,
# and type is one or two words.
sub lsparse'line_lsparse
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){


	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		if( /^(\S+)\s+(\d+)\s+(\d+)\s+((l\s+)?\S+)\s+(\d+)\n$/ ){
			# looks good.

# This is the format used at sumex-aim.stanford.edu for the info-mac area.
# (see info-mac/help/all-files.txt.gz).
#
sub lsparse'line_infomac
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){


	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		next if /^;/;
		if( /^([l-].)\s*(\d+)\s*(\w\w\w\s+\d+\s*(\d+:\d+|\d\d\d\d))\s+(.*)\n/ ){
			local( $kind, $size, $lsdate, $file ) = ($1, $2, $3, $5);
			
			local( $time ) = &main'lstime_to_time( $lsdate );

			# This should be a symlink
			if( $kind =~ /^l/ && $file =~ /(.*) -> (.*)/ ){

# +i8388621.48638,m848117771,r,s1336,     qmsmac.html
# +i8388621.88705,m850544954,/,   txt
#
sub lsparse'line_eplf
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){

		s/\015//g;

		# Store listing
		print main'STORE $_;

# +i8388621.48638,m848117771,r,s1336,     qmsmac.html
# +i8388621.88705,m850544954,/,   txt

# --------------------- CTAN files list
#    22670 Mon Jul 20 12:36:34 1992 pub/tex/biblio/bibtex/contrib/aaai-named.bst
#
sub lsparse'line_ctan
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){


	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		if( /^\s*(\d+)\s+(\w\w\w\s+\w\w\w\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(.*)\n/ ){
			local( $size, $lsdate, $file ) = ($1, $2, $3);
			
			local( $time ) = &main'lstime_to_time( $lsdate );

			return( $file, $size, $time, 'f', 0444 );
		}

# time is a Un*x time value for the file -- this is good from the m/f
# type is always "f" for a file

sub lsparse'line_cms
{
	local( $fh ) = @_;

	if( $lsparse'readtime ){
		alarm( $lsparse'readtime );
	}

	if( eof( $fh ) ){

	}
	while( <$fh> ){
		# Store listing
		print main'STORE $_;

		chop;
		next unless /\d+\/\d+\/\d+\s+\d+:\d+:\d+/;
		s/^\s+//;

		# Upper case is so ugly
		if( ! $lsparse'vms_keep_case ){
			tr/A-Z/a-z/;
		}

		local( $fname, $ftype, $fdisk, $rectype, $lrecl, $recs,
		      $blocks, $ldate, $tod ) = split(/\s+/, $_);
		return( join('.', ($fname, $ftype, $fdisk)),
		       $lrecl * $recs, &main'lstime_to_time( "$ldate $tod" ),
		       'f' );
	}
	alarm( 0 );

Return to bug 1214412

Lines 75-81 Link Here

(-)/lib/perl5/vendor_perl/5.38.2/dateconv.pl (-4 / +4 lines)
75	# input date and time string from ftp "ls -l", such as Mmm dd yyyy or	75	# input date and time string from ftp "ls -l", such as Mmm dd yyyy or
76	# Mmm dd HH:MM,	76	# Mmm dd HH:MM,
77	# return $time number via gmlocal( $string ).	77	# return $time number via gmlocal( $string ).
78	sub main::lstime_to_time	78	sub main'lstime_to_time
79	{	79	{
80	package dateconv;	80	package dateconv;
81		81
Lines 127-141 Link Here
127	}	127	}
128		128
129	if( $use_timelocal ){	129	if( $use_timelocal ){
130	return &::timelocal( $secs, $mins, $hours, $day, $month, $year );	130	return &'timelocal( $secs, $mins, $hours, $day, $month, $year );
131	}	131	}
132	else {	132	else {
133	return &::timegm( $secs, $mins, $hours, $day, $month, $year );	133	return &'timegm( $secs, $mins, $hours, $day, $month, $year );
134	}	134	}
135	}	135	}
136		136
137	# input time number, output GMT string as "dd Mmm YYYY HH:MM"	137	# input time number, output GMT string as "dd Mmm YYYY HH:MM"
138	sub main::time_to_standard	138	sub main'time_to_standard
139	{	139	{
140	package dateconv;	140	package dateconv;
141		141

Lines 51-57 Link Here

(-)/usr/bin/mirror (-73 / +73 lines)
51	# Allow strip_cr (from Andrew).	51	# Allow strip_cr (from Andrew).
52	# More symlink handling...	52	# More symlink handling...
53	# Set type for vms correctly.	53	# Set type for vms correctly.
54	# Changed response from ftp::delete, also corrected path used.	54	# Changed response from ftp'delete, also corrected path used.
55	#	55	#
56	# Revision 2.4 1994/04/29 20:11:09 lmjm	56	# Revision 2.4 1994/04/29 20:11:09 lmjm
57	# Use correct variable for hostname	57	# Use correct variable for hostname
Lines 1054-1063 Link Here
1054		1054
1055	if( $debug ){	1055	if( $debug ){
1056	# Keep the ftp debugging lower than the rest.	1056	# Keep the ftp debugging lower than the rest.
1057	&ftp::debug( $debug - 1);	1057	&ftp'debug( $debug - 1);
1058	}	1058	}
1059	else {	1059	else {
1060	&ftp::debug( $verbose );	1060	&ftp'debug( $verbose );
1061	}	1061	}
1062		1062
1063	if( $recurse_hard ){	1063	if( $recurse_hard ){
Lines 1070-1088 Link Here
1070	}	1070	}
1071		1071
1072	if( ! $interactive ){	1072	if( ! $interactive ){
1073	$ftp::showfd = 'STDOUT';	1073	$ftp'showfd = 'STDOUT';
1074	}	1074	}
1075	&ftp::set_timeout( $timeout );	1075	&ftp'set_timeout( $timeout );
1076	&ftp::set_signals( "main::msg" );	1076	&ftp'set_signals( "main'msg" );
1077		1077
1078	# set passive ftp mode	1078	# set passive ftp mode
1079	if( $passive_ftp ){	1079	if( $passive_ftp ){
1080	$ftp::use_pasv = 1;	1080	$ftp'use_pasv = 1;
1081	}	1081	}
1082		1082
1083	# Are we using the SOCKS version of perl?	1083	# Are we using the SOCKS version of perl?
1084	if( $using_socks ){	1084	if( $using_socks ){
1085	$chat::using_socks = 1;	1085	$chat'using_socks = 1;
1086	}	1086	}
1087		1087
1088	# Useful string in prints	1088	# Useful string in prints
Lines 1217-1229 Link Here
1217	if( $con == 1 ){	1217	if( $con == 1 ){
1218	&msg( "login as $remote_user\n" ) if $debug > 1;	1218	&msg( "login as $remote_user\n" ) if $debug > 1;
1219	$curr_remote_user = $remote_user;	1219	$curr_remote_user = $remote_user;
1220	if( ! &ftp::login( $remote_user, $remote_password, $remote_account ) ){	1220	if( ! &ftp'login( $remote_user, $remote_password, $remote_account ) ){
1221	&msg( "Cannot login, skipping package\n" );	1221	&msg( "Cannot login, skipping package\n" );
1222	&disconnect();	1222	&disconnect();
1223	&msg( "\n" );	1223	&msg( "\n" );
1224	return $exit_status;	1224	return $exit_status;
1225	}	1225	}
1226	$can_restart = (&ftp::restart(0) == 1);	1226	$can_restart = (&ftp'restart(0) == 1);
1227	if( $debug > 1 ){	1227	if( $debug > 1 ){
1228	&msg( "Can " . ($can_restart ? '' : "not ") . "do restarts\n" );	1228	&msg( "Can " . ($can_restart ? '' : "not ") . "do restarts\n" );
1229		1229
Lines 1234-1240 Link Here
1234	&msg( "Already connected to site $site\n" ) if $debug;	1234	&msg( "Already connected to site $site\n" ) if $debug;
1235	}	1235	}
1236		1236
1237	if( ! &ftp::type( $text_mode ? 'A' : 'I' ) ){	1237	if( ! &ftp'type( $text_mode ? 'A' : 'I' ) ){
1238	&msg( "Cannot set type\n" );	1238	&msg( "Cannot set type\n" );
1239	}	1239	}
1240		1240
Lines 1245-1260 Link Here
1245	# setting the namemap functions.	1245	# setting the namemap functions.
1246	if( $remote_fs =~ /vms/i ){	1246	if( $remote_fs =~ /vms/i ){
1247	$vms = 1;	1247	$vms = 1;
1248	&ftp::set_namemap( "main::unix2vms", "main::vms2unix" );	1248	&ftp'set_namemap( "main'unix2vms", "main'vms2unix" );
1249	}	1249	}
1250	else {	1250	else {
1251	$vms = 0;	1251	$vms = 0;
1252	# No mapping necessary	1252	# No mapping necessary
1253	&ftp::set_namemap( '' );	1253	&ftp'set_namemap( '' );
1254	}	1254	}
1255		1255
1256	if( ! $get_file \|\| $remote_idle ){	1256	if( ! $get_file \|\| $remote_idle ){
1257	local( @rhelp ) = &ftp::site_commands();	1257	local( @rhelp ) = &ftp'site_commands();
1258	$remote_has_chmod = grep( $_ eq 'CHMOD', @rhelp);	1258	$remote_has_chmod = grep( $_ eq 'CHMOD', @rhelp);
1259	$remote_has_rename = grep( $_ eq 'RNFR', @rhelp) && grep( $_ eq 'RNTO', @rhelp);	1259	$remote_has_rename = grep( $_ eq 'RNFR', @rhelp) && grep( $_ eq 'RNTO', @rhelp);
1260	$remote_has_idle = grep( $_ eq 'IDLE', @rhelp);	1260	$remote_has_idle = grep( $_ eq 'IDLE', @rhelp);
Lines 1265-1271 Link Here
1265	}	1265	}
1266		1266
1267	if( $remote_has_idle && $remote_idle ){	1267	if( $remote_has_idle && $remote_idle ){
1268	if( ! &ftp::quote( "site idle $remote_idle" ) ){	1268	if( ! &ftp'quote( "site idle $remote_idle" ) ){
1269	&msg( "Cannot set remote idle\n" );	1269	&msg( "Cannot set remote idle\n" );
1270	}	1270	}
1271	elsif( $debug > 2 ){	1271	elsif( $debug > 2 ){
Lines 1274-1280 Link Here
1274	}	1274	}
1275		1275
1276	if( $remote_group ){	1276	if( $remote_group ){
1277	if( ! &ftp::quote( "site group $remote_group" ) ){	1277	if( ! &ftp'quote( "site group $remote_group" ) ){
1278	&msg( "Cannot set remote group\n" );	1278	&msg( "Cannot set remote group\n" );
1279	}	1279	}
1280	elsif( $debug > 2 ){	1280	elsif( $debug > 2 ){
Lines 1283-1289 Link Here
1283	}	1283	}
1284		1284
1285	if( $remote_gpass ){	1285	if( $remote_gpass ){
1286	if( ! &ftp::quote( "site gpass $remote_gpass" ) ){	1286	if( ! &ftp'quote( "site gpass $remote_gpass" ) ){
1287	&msg( "Cannot set remote gpass\n" );	1287	&msg( "Cannot set remote gpass\n" );
1288	}	1288	}
1289	elsif( $debug > 2 ){	1289	elsif( $debug > 2 ){
Lines 1497-1507 Link Here
1497	{	1497	{
1498	if( $connected ){	1498	if( $connected ){
1499	&msg( "disconnecting from $connected\n" ) if $debug;	1499	&msg( "disconnecting from $connected\n" ) if $debug;
1500	if( ! $ftp::fatalerror ){	1500	if( ! $ftp'fatalerror ){
1501	&ftp::close();	1501	&ftp'close();
1502	}	1502	}
1503	else {	1503	else {
1504	&ftp::service_closed();	1504	&ftp'service_closed();
1505	}	1505	}
1506	}	1506	}
1507	$connected = '';	1507	$connected = '';
Lines 1525-1535 Link Here
1525	&disconnect();	1525	&disconnect();
1526		1526
1527	if( $proxy ){	1527	if( $proxy ){
1528	$ftp::proxy = $proxy;	1528	$ftp'proxy = $proxy;
1529	$ftp::proxy_gateway = $proxy_gateway;	1529	$ftp'proxy_gateway = $proxy_gateway;
1530	$ftp::proxy_ftp_port = $proxy_ftp_port;	1530	$ftp'proxy_ftp_port = $proxy_ftp_port;
1531	}	1531	}
1532	$res = &ftp::open( $site, $ftp_port, $retry_call, $attempts );	1532	$res = &ftp'open( $site, $ftp_port, $retry_call, $attempts );
1533	if( $res == 1 ){	1533	if( $res == 1 ){
1534	# Connected	1534	# Connected
1535	$connected = $site;	1535	$connected = $site;
Lines 1545-1551 Link Here
1545	if( $debug > 2 ){	1545	if( $debug > 2 ){
1546	&msg( " prodding remote ftpd\n" );	1546	&msg( " prodding remote ftpd\n" );
1547	}	1547	}
1548	&ftp::pwd();	1548	&ftp'pwd();
1549	}	1549	}
1550		1550
1551	# checkout and fixup any regexps.	1551	# checkout and fixup any regexps.
Lines 1775-1781 Link Here
1775	$remote_type[ 0 ] = 0;	1775	$remote_type[ 0 ] = 0;
1776	$remote_mode[ 0 ] = 0;	1776	$remote_mode[ 0 ] = 0;
1777		1777
1778	if( $remote_fs !~ /cms/ && ! &ftp::cwd( $remote_dir ) ){	1778	if( $remote_fs !~ /cms/ && ! &ftp'cwd( $remote_dir ) ){
1779	if( $get_file ){	1779	if( $get_file ){
1780	# no files to get	1780	# no files to get
1781	return 0;	1781	return 0;
Lines 1784-1791 Link Here
1784	&msg( "Failed to change to remote directory ($remote_dir) trying to create it\n" );	1784	&msg( "Failed to change to remote directory ($remote_dir) trying to create it\n" );
1785	&mkdirs( $remote_dir );	1785	&mkdirs( $remote_dir );
1786		1786
1787	if( ! &ftp::cwd( $remote_dir ) ){	1787	if( ! &ftp'cwd( $remote_dir ) ){
1788	&msg( "Cannot change to remote directory ($remote_dir) because: $ftp::response\n" );	1788	&msg( "Cannot change to remote directory ($remote_dir) because: $ftp'response\n" );
1789	return 0;	1789	return 0;
1790	}	1790	}
1791	}	1791	}
Lines 1814-1820 Link Here
1814	&msg( "Cannot open $dirtmp\n" );	1814	&msg( "Cannot open $dirtmp\n" );
1815	return 0;	1815	return 0;
1816	}	1816	}
1817	$rls = "main::DIRTMP";	1817	$rls = "main'DIRTMP";
1818	# Now we don't want to overwrite our input... better test?	1818	# Now we don't want to overwrite our input... better test?
1819	if( $local_ls_lR_file eq $storename ){	1819	if( $local_ls_lR_file eq $storename ){
1820	$storename = "/dev/null";	1820	$storename = "/dev/null";
Lines 1828-1834 Link Here
1828	}	1828	}
1829		1829
1830	&msg( " Getting directory listing from remote file $ls_lR_file\n" ) if $debug;	1830	&msg( " Getting directory listing from remote file $ls_lR_file\n" ) if $debug;
1831	if( ! &ftp::get( $ls_lR_file, $dirtmp, 0 ) ){	1831	if( ! &ftp'get( $ls_lR_file, $dirtmp, 0 ) ){
1832	&msg( "Cannot get dir listing file\n" );	1832	&msg( "Cannot get dir listing file\n" );
1833	return 0;	1833	return 0;
1834	}	1834	}
Lines 1857-1867 Link Here
1857	}	1857	}
1858		1858
1859	open( DIRTMP, $dirtmp ) \|\| die "Cannot open $dirtmp";	1859	open( DIRTMP, $dirtmp ) \|\| die "Cannot open $dirtmp";
1860	$rls = "main::DIRTMP";	1860	$rls = "main'DIRTMP";
1861	}	1861	}
1862	else {	1862	else {
1863	$use_ls = 1;	1863	$use_ls = 1;
1864	if( ! &ftp::type( 'A' ) ){	1864	if( ! &ftp'type( 'A' ) ){
1865	&msg( "Cannot set type to ascii for dir listing, ignored\n" );	1865	&msg( "Cannot set type to ascii for dir listing, ignored\n" );
1866	$type_changed = 0;	1866	$type_changed = 0;
1867	}	1867	}
Lines 1870-1886 Link Here
1870	}	1870	}
1871	}	1871	}
1872		1872
1873	$lsparse::fstype = $remote_fs;	1873	$lsparse'fstype = $remote_fs;
1874	$lsparse::name = "$site:$package";	1874	$lsparse'name = "$site:$package";
1875		1875
1876	if( $use_ls ){	1876	if( $use_ls ){
1877	local( $flags ) = $flags_nonrecursive;	1877	local( $flags ) = $flags_nonrecursive;
1878	if( $recursive && ! $recurse_hard ){	1878	if( $recursive && ! $recurse_hard ){
1879	$flags = $flags_recursive;	1879	$flags = $flags_recursive;
1880	}	1880	}
1881	$lsparse::report_subdirs = (! $recurse_hard && $algorithm == 0);	1881	$lsparse'report_subdirs = (! $recurse_hard && $algorithm == 0);
1882	if( !&ftp::dir_open( $flags ) ){	1882	if( !&ftp'dir_open( $flags ) ){
1883	&msg( "Cannot get remote directory listing because: $ftp::response\n" );	1883	&msg( "Cannot get remote directory listing because: $ftp'response\n" );
1884	return 0;	1884	return 0;
1885	}	1885	}
1886		1886
Lines 1893-1900 Link Here
1893	# relative to the remote_dir	1893	# relative to the remote_dir
1894	$rcwd = $remote_dir;	1894	$rcwd = $remote_dir;
1895	}	1895	}
1896	$dateconv::use_timelocal = $use_timelocal;	1896	$dateconv'use_timelocal = $use_timelocal;
1897	if( !&lsparse::reset( $rcwd ) ){	1897	if( !&lsparse'reset( $rcwd ) ){
1898	&msg( "$remote_fs: unknown fstype\n" );	1898	&msg( "$remote_fs: unknown fstype\n" );
1899	return 0;	1899	return 0;
1900	}	1900	}
Lines 1924-1930 Link Here
1924	# Could optimise this out - but it makes sure that	1924	# Could optimise this out - but it makes sure that
1925	# the other end gets a command straight after a possibly	1925	# the other end gets a command straight after a possibly
1926	# long dir listing.	1926	# long dir listing.
1927	if( ! &ftp::type( $text_mode ? 'A' : 'I' ) ){	1927	if( ! &ftp'type( $text_mode ? 'A' : 'I' ) ){
1928	local( $msg ) = "Cannot reset type after dir listing, ";	1928	local( $msg ) = "Cannot reset type after dir listing, ";
1929	if( $type_changed ){	1929	if( $type_changed ){
1930	# I changed it before - so I must be able to	1930	# I changed it before - so I must be able to
Lines 1996-2002 Link Here
1996	while( 1 ){	1996	while( 1 ){
1997	while( !eof( $rls ) ){	1997	while( !eof( $rls ) ){
1998	( $path, $size, $time, $type, $mode ) =	1998	( $path, $size, $time, $type, $mode ) =
1999	&lsparse::line( $rls );	1999	&lsparse'line( $rls );
2000	last if $path eq '';	2000	last if $path eq '';
2001	if( $ls_fix_mappings ){	2001	if( $ls_fix_mappings ){
2002	local( $old_path ) = $path;	2002	local( $old_path ) = $path;
Lines 2087-2095 Link Here
2087	}	2087	}
2088		2088
2089	if( $use_ls ){	2089	if( $use_ls ){
2090	if( ! &ftp::dir_close() ){	2090	if( ! &ftp'dir_close() ){
2091	&msg( "Failure at end of remote directory" .	2091	&msg( "Failure at end of remote directory" .
2092	" ($rdir) because: $ftp::response\n" );	2092	" ($rdir) because: $ftp'response\n" );
2093	return 0;	2093	return 0;
2094	}	2094	}
2095	}	2095	}
Lines 2099-2107 Link Here
2099	while( 1 ){	2099	while( 1 ){
2100	if( $#dir_list < 0 ){	2100	if( $#dir_list < 0 ){
2101	# Make sure we end in the right directory.	2101	# Make sure we end in the right directory.
2102	if( ! &ftp::cwd( $remote_dir ) ){	2102	if( ! &ftp'cwd( $remote_dir ) ){
2103	&msg( "Cannot change to remote directory" .	2103	&msg( "Cannot change to remote directory" .
2104	" ($rdir) because: $ftp::response\n" );	2104	" ($rdir) because: $ftp'response\n" );
2105	return 0;	2105	return 0;
2106	}	2106	}
2107	$done = 1;	2107	$done = 1;
Lines 2112-2120 Link Here
2112	if( $debug > 2 ){	2112	if( $debug > 2 ){
2113	print "scanning: $remote_dir / $rcwd\n";	2113	print "scanning: $remote_dir / $rcwd\n";
2114	}	2114	}
2115	if( ! &ftp::cwd( $rdir ) ){	2115	if( ! &ftp'cwd( $rdir ) ){
2116	&msg( "Cannot change to remote directory" .	2116	&msg( "Cannot change to remote directory" .
2117	" ($rdir) because: $ftp::response\n" );	2117	" ($rdir) because: $ftp'response\n" );
2118	next;	2118	next;
2119	}	2119	}
2120	last;	2120	last;
Lines 2122-2133 Link Here
2122	if( $done ){	2122	if( $done ){
2123	last;	2123	last;
2124	}	2124	}
2125	if( !&ftp::dir_open( $flags_nonrecursive ) ){	2125	if( !&ftp'dir_open( $flags_nonrecursive ) ){
2126	&msg( "Cannot get remote directory" .	2126	&msg( "Cannot get remote directory" .
2127	" listing because: $ftp::response\n" );	2127	" listing because: $ftp'response\n" );
2128	return 0;	2128	return 0;
2129	}	2129	}
2130	&lsparse::reset( $rcwd );	2130	&lsparse'reset( $rcwd );
2131		2131
2132	# round the loop again.	2132	# round the loop again.
2133	next;	2133	next;
Lines 2527-2533 Link Here
2527		2527
2528	if( $external_mapping ){	2528	if( $external_mapping ){
2529	$old_name = $name;	2529	$old_name = $name;
2530	local( $tmp ) = &extmap::map( $name );	2530	local( $tmp ) = &extmap'map( $name );
2531	if( $tmp ne $old_name ){	2531	if( $tmp ne $old_name ){
2532	$name = $tmp;	2532	$name = $tmp;
2533	}	2533	}
Lines 2688-2698 Link Here
2688	&transfer_file( $src_path, $dest_path,	2688	&transfer_file( $src_path, $dest_path,
2689	$attribs, $remote_time[ $srci ] );	2689	$attribs, $remote_time[ $srci ] );
2690	if( $get_file && $newpath eq '' ){	2690	if( $get_file && $newpath eq '' ){
2691	&msg( $log, "Failed to $XFER file $ftp::response\n" );	2691	&msg( $log, "Failed to $XFER file $ftp'response\n" );
2692	if( $ftp::response =~ /timeout\|timed out/i ){	2692	if( $ftp'response =~ /timeout\|timed out/i ){
2693	$timeouts++;	2693	$timeouts++;
2694	}	2694	}
2695	if( $ftp::fatalerror \|\| $timeouts > $max_timeouts ){	2695	if( $ftp'fatalerror \|\| $timeouts > $max_timeouts ){
2696	&msg( $log, "Fatal error talking to site, skipping rest of transfers\n" );	2696	&msg( $log, "Fatal error talking to site, skipping rest of transfers\n" );
2697	&disconnect();	2697	&disconnect();
2698	return;	2698	return;
Lines 2752-2762 Link Here
2752	}	2752	}
2753		2753
2754	if( $vms ){	2754	if( $vms ){
2755	&ftp::type( ($src_path =~ /$vms_xfer_text/i) ? 'A' : 'I' );	2755	&ftp'type( ($src_path =~ /$vms_xfer_text/i) ? 'A' : 'I' );
2756	}	2756	}
2757		2757
2758	if( $remote_fs eq 'macos' && ! $get_file ){	2758	if( $remote_fs eq 'macos' && ! $get_file ){
2759	&ftp::type( 'A' );	2759	&ftp'type( 'A' );
2760	}	2760	}
2761		2761
2762	if( ! $get_file ){	2762	if( ! $get_file ){
Lines 2778-2792 Link Here
2778	$temp = $dest_path;	2778	$temp = $dest_path;
2779	}	2779	}
2780		2780
2781	if( ! &ftp::put( $src_file, $temp, $restart ) ){	2781	if( ! &ftp'put( $src_file, $temp, $restart ) ){
2782	&msg( $log, "Failed to put $src_file: $ftp::response\n" );	2782	&msg( $log, "Failed to put $src_file: $ftp'response\n" );
2783	unlink( $comptemp ) if $comptemp;	2783	unlink( $comptemp ) if $comptemp;
2784	return '';	2784	return '';
2785	}	2785	}
2786		2786
2787	unlink( $comptemp ) if $comptemp;	2787	unlink( $comptemp ) if $comptemp;
2788	if( !$no_rename && ! &ftp::rename( $temp, $dest_path ) ){	2788	if( !$no_rename && ! &ftp'rename( $temp, $dest_path ) ){
2789	&msg( $log, "Failed to remote rename $temp to $dest_path: $ftp::response\n" );	2789	&msg( $log, "Failed to remote rename $temp to $dest_path: $ftp'response\n" );
2790	return '';	2790	return '';
2791	}	2791	}
2792		2792
Lines 2810-2820 Link Here
2810	# it.	2810	# it.
2811		2811
2812	# Get a file	2812	# Get a file
2813	&ftp::dostrip( $strip_cr );	2813	&ftp'dostrip( $strip_cr );
2814	$start_time = time;	2814	$start_time = time;
2815	if( ! &ftp::get( $src_path, $temp, $restart ) ){	2815	if( ! &ftp'get( $src_path, $temp, $restart ) ){
2816	if( !$failed_gets_excl \|\| $ftp::response !~ /$failed_gets_excl/ ){	2816	if( !$failed_gets_excl \|\| $ftp'response !~ /$failed_gets_excl/ ){
2817	&msg( $log, "Failed to get $src_path: $ftp::response\n" );	2817	&msg( $log, "Failed to get $src_path: $ftp'response\n" );
2818	}	2818	}
2819		2819
2820	# Time stamp the temp file to allow for a restart	2820	# Time stamp the temp file to allow for a restart
Lines 2833-2839 Link Here
2833		2833
2834	# delete source file after successful transfer	2834	# delete source file after successful transfer
2835	if( $delete_source ){	2835	if( $delete_source ){
2836	if( &ftp::delete( $src_path ) ){	2836	if( &ftp'delete( $src_path ) ){
2837	&msg( $log, "Deleted remote $src_path\n");	2837	&msg( $log, "Deleted remote $src_path\n");
2838	}	2838	}
2839	else {	2839	else {
Lines 3185-3191 Link Here
3185	}	3185	}
3186	else {	3186	else {
3187	&msg( $log, "delete DIR $del\n" );	3187	&msg( $log, "delete DIR $del\n" );
3188	&ftp::delete( "$del" ) \|\|	3188	&ftp'delete( "$del" ) \|\|
3189	&msg( $log, "ftp delete DIR $del failed\n" );	3189	&msg( $log, "ftp delete DIR $del failed\n" );
3190	}	3190	}
3191	}	3191	}
Lines 3209-3215 Link Here
3209	}	3209	}
3210	else {	3210	else {
3211	&msg( $log, "delete FILE $del\n" );	3211	&msg( $log, "delete FILE $del\n" );
3212	&ftp::delete( "$del" ) \|\|	3212	&ftp'delete( "$del" ) \|\|
3213	&msg( $log, "ftp delete FILE $del failed\n" );	3213	&msg( $log, "ftp delete FILE $del failed\n" );
3214	}	3214	}
3215	}	3215	}
Lines 3355-3366 Link Here
3355	}	3355	}
3356	else {	3356	else {
3357	# make a remote directory	3357	# make a remote directory
3358	$val = &ftp::mkdir( $dir );	3358	$val = &ftp'mkdir( $dir );
3359		3359
3360	# The mkdir might have failed due to bad mode	3360	# The mkdir might have failed due to bad mode
3361	# So try to chmod it anyway	3361	# So try to chmod it anyway
3362	if( $remote_has_chmod ){	3362	if( $remote_has_chmod ){
3363	$val = &ftp::chmod( $dir, $mode );	3363	$val = &ftp'chmod( $dir, $mode );
3364	}	3364	}
3365	}	3365	}
3366		3366
Lines 3379-3392 Link Here
3379	}	3379	}
3380	else {	3380	else {
3381	# check if remote directory exists	3381	# check if remote directory exists
3382	local($old_dir) = &ftp::pwd();	3382	local($old_dir) = &ftp'pwd();
3383		3383
3384	$val = &ftp::cwd($dir);	3384	$val = &ftp'cwd($dir);
3385		3385
3386	# If I didn't manage to change dir should be where I was!	3386	# If I didn't manage to change dir should be where I was!
3387	if( $val ){	3387	if( $val ){
3388	# go back to the original directory	3388	# go back to the original directory
3389	&ftp::cwd($old_dir) \|\| die "Cannot cd to original remote directory";	3389	&ftp'cwd($old_dir) \|\| die "Cannot cd to original remote directory";
3390	}	3390	}
3391	}	3391	}
3392	return $val;	3392	return $val;
Lines 3440-3446 Link Here
3440	else {	3440	else {
3441	# change the remote file	3441	# change the remote file
3442	if( $remote_has_chmod ){	3442	if( $remote_has_chmod ){
3443	&ftp::chmod( $path, $mode );	3443	&ftp'chmod( $path, $mode );
3444	}	3444	}
3445	}	3445	}
3446	}	3446	}

Lines 34-40 Link Here

(-)/lib/perl5/vendor_perl/5.38.2/lchat.pl (-21 / +21 lines)
34	# Lots of changes. See CHANGES since 2.8 file.	34	# Lots of changes. See CHANGES since 2.8 file.
35	#	35	#
36	# Revision 2.3 1994/02/03 13:45:35 lmjm	36	# Revision 2.3 1994/02/03 13:45:35 lmjm
37	# Correct chat::read (bfriesen@simple.sat.tx.us)	37	# Correct chat'read (bfriesen@simple.sat.tx.us)
38	#	38	#
39	# Revision 2.2 1993/12/14 11:09:03 lmjm	39	# Revision 2.2 1993/12/14 11:09:03 lmjm
40	# Only include sys/socket.ph if not already there.	40	# Only include sys/socket.ph if not already there.
Lines 55-61 Link Here
55	eval "use Socket";	55	eval "use Socket";
56	}	56	}
57	else {	57	else {
58	unless( defined &::PF_INET ){	58	unless( defined &'PF_INET ){
59	eval "sub ATT { 0; } sub INTEL { 0; }";	59	eval "sub ATT { 0; } sub INTEL { 0; }";
60	do 'sys/socket.ph';	60	do 'sys/socket.ph';
61	}	61	}
Lines 63-82 Link Here
63		63
64	# Get the correct magic numbers for socket work.	64	# Get the correct magic numbers for socket work.
65	if( $] =~ /^5\.\d+$/ ){	65	if( $] =~ /^5\.\d+$/ ){
66	# Perl 5 has a special way of getting them via the 'use Socket::	66	# Perl 5 has a special way of getting them via the 'use Socket'
67	# above.	67	# above.
68	$main::pf_inet = &Socket::PF_INET;	68	$main'pf_inet = &Socket'PF_INET;
69	$main::sock_stream = &Socket::SOCK_STREAM;	69	$main'sock_stream = &Socket'SOCK_STREAM;
70	local($name, $aliases, $proto) = getprotobyname( 'tcp' );	70	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
71	$main::tcp_proto = $proto;	71	$main'tcp_proto = $proto;
72	}	72	}
73	elsif( defined( &::PF_INET ) ){	73	elsif( defined( &'PF_INET ) ){
74	# Perl 4 needs to have the socket.ph file created when perl was	74	# Perl 4 needs to have the socket.ph file created when perl was
75	# installed.	75	# installed.
76	$main::pf_inet = &::PF_INET;	76	$main'pf_inet = &'PF_INET;
77	$main::sock_stream = &::SOCK_STREAM;	77	$main'sock_stream = &'SOCK_STREAM;
78	local($name, $aliases, $proto) = getprotobyname( 'tcp' );	78	local($name, $aliases, $proto) = getprotobyname( 'tcp' );
79	$main::tcp_proto = $proto;	79	$main'tcp_proto = $proto;
80	}	80	}
81	else {	81	else {
82	# Whoever installed perl didn't run h2ph !!!	82	# Whoever installed perl didn't run h2ph !!!
Lines 84-92 Link Here
84	# last resort	84	# last resort
85	# Use hardwired versions	85	# Use hardwired versions
86	# but who the heck would change these anyway? (:-)	86	# but who the heck would change these anyway? (:-)
87	$main::pf_inet = 2;	87	$main'pf_inet = 2;
88	$main::sock_stream = 1; # Sigh... On Solaris set this to 2	88	$main'sock_stream = 1; # Sigh... On Solaris set this to 2
89	$main::tcp_proto = 6;	89	$main'tcp_proto = 6;
90	warn "lchat.pl: using hardwired in network constantants";	90	warn "lchat.pl: using hardwired in network constantants";
91	}	91	}
92		92
Lines 108-114 Link Here
108	}	108	}
109		109
110		110
111	## &chat::open_port("server.address",$port_number);	111	## &chat'open_port("server.address",$port_number);
112	## opens a named or numbered TCP server	112	## opens a named or numbered TCP server
113	sub open_port { ## public	113	sub open_port { ## public
114	local($server, $port) = @_;	114	local($server, $port) = @_;
Lines 129-135 Link Here
129	$serveraddr = $x[4];	129	$serveraddr = $x[4];
130	}	130	}
131	$serverproc = pack($sockaddr, 2, $port, $serveraddr);	131	$serverproc = pack($sockaddr, 2, $port, $serveraddr);
132	unless (socket(S, $main::pf_inet, $main::sock_stream, $main::tcp_proto)) {	132	unless (socket(S, $main'pf_inet, $main'sock_stream, $main'tcp_proto)) {
133	($!) = ($!, close(S)); # close S while saving $!	133	($!) = ($!, close(S)); # close S while saving $!
134	return undef;	134	return undef;
135	}	135	}
Lines 197-203 Link Here
197	##############################################################################	197	##############################################################################
198		198
199		199
200	## $return = &chat::expect($timeout_time,	200	## $return = &chat'expect($timeout_time,
201	## $pat1, $body1, $pat2, $body2, ... )	201	## $pat1, $body1, $pat2, $body2, ... )
202	## $timeout_time is the time (either relative to the current time, or	202	## $timeout_time is the time (either relative to the current time, or
203	## absolute, ala time(2)) at which a timeout event occurs.	203	## absolute, ala time(2)) at which a timeout event occurs.
Lines 293-299 Link Here
293	select($rmask, undef, undef, $endtime - time);	293	select($rmask, undef, undef, $endtime - time);
294	if ($nfound) {	294	if ($nfound) {
295	$nread = sysread(S, $thisbuf, 1024);	295	$nread = sysread(S, $thisbuf, 1024);
296	if( $chat::debug ){	296	if( $chat'debug ){
297	print STDERR "sysread $nread ";	297	print STDERR "sysread $nread ";
298	print STDERR ">>$thisbuf<<\n";	298	print STDERR ">>$thisbuf<<\n";
299	}	299	}
Lines 316-336 Link Here
316	& $subname();	316	& $subname();
317	}	317	}
318		318
319	## &chat::print(@data)	319	## &chat'print(@data)
320	sub print { ## public	320	sub print { ## public
321	print S @_;	321	print S @_;
322	if( $chat::debug ){	322	if( $chat'debug ){
323	print STDERR "printed:";	323	print STDERR "printed:";
324	print STDERR @_;	324	print STDERR @_;
325	}	325	}
326	}	326	}
327		327
328	## &chat::close()	328	## &chat'close()
329	sub close { ## public	329	sub close { ## public
330	close(S);	330	close(S);
331	}	331	}
332		332
333	# &chat::read(*buf, $ntoread )	333	# &chat'read(*buf, $ntoread )
334	# blocking read. returns no. of bytes read and puts data in $buf.	334	# blocking read. returns no. of bytes read and puts data in $buf.
335	# If called with ntoread < 0 then just do the accept and return 0.	335	# If called with ntoread < 0 then just do the accept and return 0.
336	sub read { ## public	336	sub read { ## public

Lines 28-44 Link Here

(-)/lib/perl5/vendor_perl/5.38.2/lftp.pl (-68 / +68 lines)
28	# $ftp_port = 21;	28	# $ftp_port = 21;
29	# $retry_call = 1;	29	# $retry_call = 1;
30	# $attempts = 2;	30	# $attempts = 2;
31	# if( &ftp::open( $site, $ftp_port, $retry_call, $attempts ) != 1 ){	31	# if( &ftp'open( $site, $ftp_port, $retry_call, $attempts ) != 1 ){
32	# die "failed to open ftp connection";	32	# die "failed to open ftp connection";
33	# }	33	# }
34	# if( ! &ftp::login( $user, $pass ) ){	34	# if( ! &ftp'login( $user, $pass ) ){
35	# die "failed to login";	35	# die "failed to login";
36	# }	36	# }
37	# &ftp::type( $text_mode ? 'A' : 'I' );	37	# &ftp'type( $text_mode ? 'A' : 'I' );
38	# if( ! &ftp::get( $remote_filename, $local_filename, 0 ) ){	38	# if( ! &ftp'get( $remote_filename, $local_filename, 0 ) ){
39	# die "failed to get file";	39	# die "failed to get file";
40	# }	40	# }
41	# &ftp::close();	41	# &ftp'close();
42	#	42	#
43	#	43	#
44	# $Id: ftp.pl,v 2.9 1998/05/29 19:02:00 lmjm Exp lmjm $	44	# $Id: ftp.pl,v 2.9 1998/05/29 19:02:00 lmjm Exp lmjm $
Lines 94-102 Link Here
94		94
95	# This is a "global" it contains the last response from the remote ftp server	95	# This is a "global" it contains the last response from the remote ftp server
96	# for use in error messages	96	# for use in error messages
97	$ftp::response = "";	97	$ftp'response = "";
98		98
99	# Also ftp::NS is the socket containing the data coming in from the remote ls	99	# Also ftp'NS is the socket containing the data coming in from the remote ls
100	# command.	100	# command.
101		101
102	# The size of block to be read or written when talking to the remote	102	# The size of block to be read or written when talking to the remote
Lines 115-126 Link Here
115	$real_site = "";	115	$real_site = "";
116		116
117	# "Global" Where error/log reports are sent to	117	# "Global" Where error/log reports are sent to
118	$ftp::showfd = 'STDERR';	118	$ftp'showfd = 'STDERR';
119		119
120	# Should a 421 be treated as a connection close and return 99 from	120	# Should a 421 be treated as a connection close and return 99 from
121	# ftp::expect. This is against rfc1123 recommendations but I've found	121	# ftp'expect. This is against rfc1123 recommendations but I've found
122	# it to be a wise default.	122	# it to be a wise default.
123	$ftp::drop_on_421 = 1;	123	$ftp'drop_on_421 = 1;
124		124
125	# Name of a function to call on a pathname to map it into a remote	125	# Name of a function to call on a pathname to map it into a remote
126	# pathname.	126	# pathname.
Lines 131-137 Link Here
131	$ftp_show = 0;	131	$ftp_show = 0;
132		132
133	# Global set on a error that aborts the connection	133	# Global set on a error that aborts the connection
134	$ftp::fatalerror = 0;	134	$ftp'fatalerror = 0;
135		135
136	# Whether to keep the continuation messages so the user can look at them	136	# Whether to keep the continuation messages so the user can look at them
137	$keep_continuations = 0;	137	$keep_continuations = 0;
Lines 140-146 Link Here
140	$read_in = undef;	140	$read_in = undef;
141		141
142	# should we use the PASV extension to the ftp protocol?	142	# should we use the PASV extension to the ftp protocol?
143	$ftp::use_pasv = 0; # 0=no (default), 1=yes	143	$ftp'use_pasv = 0; # 0=no (default), 1=yes
144		144
145	# Variable only used if proxying	145	# Variable only used if proxying
146	$proxy = $proxy_gateway = $proxy_ftp_port = '';	146	$proxy = $proxy_gateway = $proxy_ftp_port = '';
Lines 150-179 Link Here
150	# (Normally set elsewhere - this is just a sensible default.)	150	# (Normally set elsewhere - this is just a sensible default.)
151	# Is expected to take count and code as arguments and prompt	151	# Is expected to take count and code as arguments and prompt
152	# for the secret key with 'password:' on stdout and then print the password.	152	# for the secret key with 'password:' on stdout and then print the password.
153	$ftp::keygen_prog = '/usr/local/bin/key';	153	$ftp'keygen_prog = '/usr/local/bin/key';
154		154
155	# Uncomment to turn on lots of debugging.	155	# Uncomment to turn on lots of debugging.
156	# &debug( 10 );	156	# &debug( 10 );
157		157
158	# Limit how much data any one ftp::get can pull back	158	# Limit how much data any one ftp'get can pull back
159	# Negative values cause the size check to be skipped.	159	# Negative values cause the size check to be skipped.
160	$max_get_size = -1;	160	$max_get_size = -1;
161		161
162	# Where I am connected to.	162	# Where I am connected to.
163	$connect_site = '';	163	$connect_site = '';
164		164
165	# &ftp::debug( debugging_level )	165	# &ftp'debug( debugging_level )
166	# Turn on debugging ranging from 1 = some to 10 = everything	166	# Turn on debugging ranging from 1 = some to 10 = everything
167	sub ftp::debug	167	sub ftp'debug
168	{	168	{
169	$ftp_show = $_[0];	169	$ftp_show = $_[0];
170	if( $ftp_show > 9 ){	170	if( $ftp_show > 9 ){
171	$chat::debug = 1;	171	$chat'debug = 1;
172	}	172	}
173	}	173	}
174		174
175	# &ftp::set_timeout( seconds )	175	# &ftp'set_timeout( seconds )
176	sub ftp::set_timeout	176	sub ftp'set_timeout
177	{	177	{
178	local( $to ) = @_;	178	local( $to ) = @_;
179	return if $to == $timeout;	179	return if $to == $timeout;
Lines 226-232 Link Here
226	$connect_site = $site;	226	$connect_site = $site;
227	$connect_port = $ftp_port;	227	$connect_port = $ftp_port;
228	}	228	}
229	if( ! &chat::open_port( $connect_site, $connect_port ) ){	229	if( ! &chat'open_port( $connect_site, $connect_port ) ){
230	if( $retry_call ){	230	if( $retry_call ){
231	print $showfd "Failed to connect\n" if $ftp_show;	231	print $showfd "Failed to connect\n" if $ftp_show;
232	next;	232	next;
Lines 240-246 Link Here
240	$ret = &expect( $timeout,	240	$ret = &expect( $timeout,
241	2, 1 ); # ready for login to $site	241	2, 1 ); # ready for login to $site
242	if( $ret != 1 ){	242	if( $ret != 1 ){
243	&chat::close();	243	&chat'close();
244	next;	244	next;
245	}	245	}
246	return 1;	246	return 1;
Lines 264-284 Link Here
264	}	264	}
265		265
266	# Setup a signal handler for possible errors.	266	# Setup a signal handler for possible errors.
267	sub ftp::set_signals	267	sub ftp'set_signals
268	{	268	{
269	$ftp_logger = @_;	269	$ftp_logger = @_;
270	$SIG{ 'PIPE' } = "ftp::ftp__sighandler";	270	$SIG{ 'PIPE' } = "ftp'ftp__sighandler";
271	}	271	}
272		272
273	# Setup a signal handler for user interrupts.	273	# Setup a signal handler for user interrupts.
274	sub ftp::set_user_signals	274	sub ftp'set_user_signals
275	{	275	{
276	$ftp_logger = @_;	276	$ftp_logger = @_;
277	$SIG{ 'INT' } = "ftp::ftp__sighandler";	277	$SIG{ 'INT' } = "ftp'ftp__sighandler";
278	}	278	}
279		279
280	# &ftp::set_namemap( function to map outgoing name, function to map incoming )	280	# &ftp'set_namemap( function to map outgoing name, function to map incoming )
281	sub ftp::set_namemap	281	sub ftp'set_namemap
282	{	282	{
283	($mapunixout, $mapunixin) = @_;	283	($mapunixout, $mapunixin) = @_;
284	if( $debug ) {	284	if( $debug ) {
Lines 286-297 Link Here
286	}	286	}
287	}	287	}
288		288
289	# &ftp::open( hostname or address,	289	# &ftp'open( hostname or address,
290	# port to use,	290	# port to use,
291	# retry on call failure,	291	# retry on call failure,
292	# number of attempts to retry )	292	# number of attempts to retry )
293	# returns 1 if connected, 0 otherwise	293	# returns 1 if connected, 0 otherwise
294	sub ftp::open	294	sub ftp'open
295	{	295	{
296	local( $site, $ftp_port, $retry_call, $attempts ) = @_;	296	local( $site, $ftp_port, $retry_call, $attempts ) = @_;
297		297
Lines 318-326 Link Here
318	return $ret;	318	return $ret;
319	}	319	}
320		320
321	# &ftp::login( user, password, account )	321	# &ftp'login( user, password, account )
322	# the account part is optional unless the remote service requires one.	322	# the account part is optional unless the remote service requires one.
323	sub ftp::login	323	sub ftp'login
324	{	324	{
325	local( $remote_user, $remote_password, $remote_account ) = @_;	325	local( $remote_user, $remote_password, $remote_account ) = @_;
326	local( $ret );	326	local( $ret );
Lines 357-367 Link Here
357	# check for s/key challenge - eg, [s/key 994 ph29005]	357	# check for s/key challenge - eg, [s/key 994 ph29005]
358	# If we are talking to skey then use remote_password as the	358	# If we are talking to skey then use remote_password as the
359	# secret to generate a real password	359	# secret to generate a real password
360	if( $ftp::response =~ m#\[s/key (\d+) (\w+)\]# ){	360	if( $ftp'response =~ m#\[s/key (\d+) (\w+)\]# ){
361	local( $count, $code ) = ($1, $2);	361	local( $count, $code ) = ($1, $2);
362		362
363	# TODO: report open failure & remove need for echo	363	# TODO: report open failure & remove need for echo
364	open( SKEY, "echo $remote_password \| $ftp::keygen_prog $count $code \|" );	364	open( SKEY, "echo $remote_password \| $ftp'keygen_prog $count $code \|" );
365	while( <SKEY> ){	365	while( <SKEY> ){
366	if( ! /password:/ ){	366	if( ! /password:/ ){
367	chop( $remote_password = $_ );	367	chop( $remote_password = $_ );
Lines 417-437 Link Here
417	sub service_closed	417	sub service_closed
418	{	418	{
419	$service_open = 0;	419	$service_open = 0;
420	&chat::close();	420	&chat'close();
421	}	421	}
422		422
423	# Close down the current ftp connecting in an orderly way.	423	# Close down the current ftp connecting in an orderly way.
424	sub ftp::close	424	sub ftp'close
425	{	425	{
426	&quit();	426	&quit();
427	$service_open = 0;	427	$service_open = 0;
428	&chat::close();	428	&chat'close();
429	}	429	}
430		430
431	# &ftp::cwd( directory )	431	# &ftp'cwd( directory )
432	# Change to the given directory	432	# Change to the given directory
433	# return 1 if successful, 0 otherwise	433	# return 1 if successful, 0 otherwise
434	sub ftp::cwd	434	sub ftp'cwd
435	{	435	{
436	local( $dir ) = @_;	436	local( $dir ) = @_;
437	local( $ret );	437	local( $ret );
Lines 466-472 Link Here
466	sub pasv	466	sub pasv
467	{	467	{
468	# At some point I need to close/free S2, no?	468	# At some point I need to close/free S2, no?
469	unless( socket( S2, $main::pf_inet, $main::sock_stream, $main::tcp_proto ) ){	469	unless( socket( S2, $main'pf_inet, $main'sock_stream, $main'tcp_proto ) ){
470	($!) = ($!, close(S2)); # close S2 while saving $!	470	($!) = ($!, close(S2)); # close S2 while saving $!
471	return undef;	471	return undef;
472	}	472	}
Lines 503-509 Link Here
503	}	503	}
504		504
505	# now need to connect() the new socket	505	# now need to connect() the new socket
506	if( ! &chat::open_newport( $newhost, $newport, *S2 ) ){	506	if( ! &chat'open_newport( $newhost, $newport, *S2 ) ){
507	if( $retry_call ){	507	if( $retry_call ){
508	print $showfd "Failed to connect newport\n" if $ftp_show;	508	print $showfd "Failed to connect newport\n" if $ftp_show;
509	next;	509	next;
Lines 517-528 Link Here
517	}	517	}
518		518
519		519
520	# &ftp::dir( remote LIST options )	520	# &ftp'dir( remote LIST options )
521	# Start a list going with the given options.	521	# Start a list going with the given options.
522	# Presuming that the remote deamon uses the ls command to generate the	522	# Presuming that the remote deamon uses the ls command to generate the
523	# data to send back then then you can send it some extra options (eg: -lRa)	523	# data to send back then then you can send it some extra options (eg: -lRa)
524	# return 1 if sucessful, 0 otherwise	524	# return 1 if sucessful, 0 otherwise
525	sub ftp::dir_open	525	sub ftp'dir_open
526	{	526	{
527	local( $options ) = @_;	527	local( $options ) = @_;
528	local( $ret );	528	local( $ret );
Lines 579-585 Link Here
579		579
580	# Close down reading the result of a remote ls command	580	# Close down reading the result of a remote ls command
581	# return 1 if successful, 0 otherwise	581	# return 1 if successful, 0 otherwise
582	sub ftp::dir_close	582	sub ftp'dir_close
583	{	583	{
584	local( $ret );	584	local( $ret );
585		585
Lines 608-614 Link Here
608		608
609	# Quit from the remote ftp server	609	# Quit from the remote ftp server
610	# return 1 if successful and 0 on failure	610	# return 1 if successful and 0 on failure
611	# Users should be calling &ftp::close();	611	# Users should be calling &ftp'close();
612	sub quit	612	sub quit
613	{	613	{
614	local( $ret );	614	local( $ret );
Lines 693-712 Link Here
693	return syswrite( NS, $ftpbuf, $ftpbufsize );	693	return syswrite( NS, $ftpbuf, $ftpbufsize );
694	}	694	}
695		695
696	# &ftp::dostrip( true or false )	696	# &ftp'dostrip( true or false )
697	# Turn on or off stripping of incoming carriage returns.	697	# Turn on or off stripping of incoming carriage returns.
698	sub ftp::dostrip	698	sub ftp'dostrip
699	{	699	{
700	($strip_cr ) = @_;	700	($strip_cr ) = @_;
701	}	701	}
702		702
703	# &ftp::get( remote file, local file, try restarting where last xfer failed )	703	# &ftp'get( remote file, local file, try restarting where last xfer failed )
704	# Get a remote file back into a local file.	704	# Get a remote file back into a local file.
705	# If no loc_fname passed then uses rem_fname.	705	# If no loc_fname passed then uses rem_fname.
706	# If $restart set and the remote site supports it then restart where	706	# If $restart set and the remote site supports it then restart where
707	# last xfer left off.	707	# last xfer left off.
708	# returns 1 on success, 0 otherwise	708	# returns 1 on success, 0 otherwise
709	sub ftp::get	709	sub ftp'get
710	{	710	{
711	local($rem_fname, $loc_fname, $restart ) = @_;	711	local($rem_fname, $loc_fname, $restart ) = @_;
712	local( $ret );	712	local( $ret );
Lines 893-899 Link Here
893	return $ret;	893	return $ret;
894	}	894	}
895		895
896	# &ftp::delete( remote filename )	896	# &ftp'delete( remote filename )
897	# Delete a file from the remote site.	897	# Delete a file from the remote site.
898	# returns 1 if successful, 0 otherwise	898	# returns 1 if successful, 0 otherwise
899	sub delete	899	sub delete
Lines 929-937 Link Here
929	# RMD	929	# RMD
930	}	930	}
931		931
932	# &ftp::put( local filename, remote filename, restart where left off )	932	# &ftp'put( local filename, remote filename, restart where left off )
933	# Similar to get but sends file to the remote site.	933	# Similar to get but sends file to the remote site.
934	sub ftp::put	934	sub ftp'put
935	{	935	{
936	local( $loc_fname, $rem_fname ) = @_;	936	local( $loc_fname, $rem_fname ) = @_;
937	local( $strip_cr );	937	local( $strip_cr );
Lines 1097-1105 Link Here
1097	return $ret;	1097	return $ret;
1098	}	1098	}
1099		1099
1100	# &ftp::restart( byte_offset )	1100	# &ftp'restart( byte_offset )
1101	# Restart the next transfer from the given offset	1101	# Restart the next transfer from the given offset
1102	sub ftp::restart	1102	sub ftp'restart
1103	{	1103	{
1104	local( $restart_point, $ret ) = @_;	1104	local( $restart_point, $ret ) = @_;
1105		1105
Lines 1121-1127 Link Here
1121	return $ret;	1121	return $ret;
1122	}	1122	}
1123		1123
1124	# &ftp::type( 'A' or 'I' )	1124	# &ftp'type( 'A' or 'I' )
1125	# set transfer type to Ascii or Image.	1125	# set transfer type to Ascii or Image.
1126	sub type	1126	sub type
1127	{	1127	{
Lines 1149-1155 Link Here
1149	@site_command_list = ();	1149	@site_command_list = ();
1150		1150
1151	# routine to query the remote server for 'SITE' commands supported	1151	# routine to query the remote server for 'SITE' commands supported
1152	sub ftp::site_commands	1152	sub ftp'site_commands
1153	{	1153	{
1154	local( $ret );	1154	local( $ret );
1155		1155
Lines 1189-1195 Link Here
1189	}	1189	}
1190		1190
1191	# return the pwd, or null if we can't get the pwd	1191	# return the pwd, or null if we can't get the pwd
1192	sub ftp::pwd	1192	sub ftp'pwd
1193	{	1193	{
1194	local( $ret, $cwd );	1194	local( $ret, $cwd );
1195		1195
Lines 1220-1226 Link Here
1220	return $cwd;	1220	return $cwd;
1221	}	1221	}
1222		1222
1223	# &ftp::mkdir( directory name )	1223	# &ftp'mkdir( directory name )
1224	# Create a directory on the remote site	1224	# Create a directory on the remote site
1225	# return 1 for success, 0 otherwise	1225	# return 1 for success, 0 otherwise
1226	sub mkdir	1226	sub mkdir
Lines 1250-1256 Link Here
1250	return $ret;	1250	return $ret;
1251	}	1251	}
1252		1252
1253	# &ftp::chmod( pathname, new mode )	1253	# &ftp'chmod( pathname, new mode )
1254	# Change the mode of a file on the remote site.	1254	# Change the mode of a file on the remote site.
1255	# return 1 for success, 0 for failure	1255	# return 1 for success, 0 for failure
1256	sub chmod	1256	sub chmod
Lines 1280-1289 Link Here
1280	return $ret;	1280	return $ret;
1281	}	1281	}
1282		1282
1283	# &ftp::rename( old name, new name )	1283	# &ftp'rename( old name, new name )
1284	# Rename a file on the remote site.	1284	# Rename a file on the remote site.
1285	# returns 1 if successful, 0 otherwise	1285	# returns 1 if successful, 0 otherwise
1286	sub ftp::rename	1286	sub ftp'rename
1287	{	1287	{
1288	local( $old_name, $new_name ) = @_;	1288	local( $old_name, $new_name ) = @_;
1289	local( $ret );	1289	local( $ret );
Lines 1331-1338 Link Here
1331	}	1331	}
1332		1332
1333		1333
1334	# &ftp::quote( site command );	1334	# &ftp'quote( site command );
1335	sub ftp::quote	1335	sub ftp'quote
1336	{	1336	{
1337	local( $cmd ) = @_;	1337	local( $cmd ) = @_;
1338	local( $ret );	1338	local( $ret );
Lines 1370-1376 Link Here
1370	}	1370	}
1371		1371
1372	#	1372	#
1373	# create the list of parameters for chat::expect	1373	# create the list of parameters for chat'expect
1374	#	1374	#
1375	# expect( time_out, {value, return value} );	1375	# expect( time_out, {value, return value} );
1376	# the last response is stored in $response	1376	# the last response is stored in $response
Lines 1433-1439 Link Here
1433	if( $ftp_show > 9 ){	1433	if( $ftp_show > 9 ){
1434	&printargs( $time_out, @expect_args );	1434	&printargs( $time_out, @expect_args );
1435	}	1435	}
1436	$ret = &chat::expect( $time_out, @expect_args );	1436	$ret = &chat'expect( $time_out, @expect_args );
1437	}	1437	}
1438		1438
1439	return $ret;	1439	return $ret;
Lines 1455-1464 Link Here
1455		1455
1456	$sockaddr = 'S n a4 x8';	1456	$sockaddr = 'S n a4 x8';
1457		1457
1458	($a,$b,$c,$d) = unpack( 'C4', $chat::thisaddr );	1458	($a,$b,$c,$d) = unpack( 'C4', $chat'thisaddr );
1459	$this = $chat::thisproc;	1459	$this = $chat'thisproc;
1460		1460
1461	if( ! socket( S, $main::pf_inet, $main::sock_stream, $main::tcp_proto ) ){	1461	if( ! socket( S, $main'pf_inet, $main'sock_stream, $main'tcp_proto ) ){
1462	warn "socket: $!";	1462	warn "socket: $!";
1463	return 0;	1463	return 0;
1464	}	1464	}
Lines 1511-1517 Link Here
1511	print $showfd "---> $sc\n";	1511	print $showfd "---> $sc\n";
1512	}	1512	}
1513		1513
1514	&chat::print( "$send_cmd\r\n" );	1514	&chat'print( "$send_cmd\r\n" );
1515	}	1515	}
1516		1516
1517	sub accept	1517	sub accept