mirror.pl

站点映像程序

	&msg( "\n" );
	return $exit_status;
}


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

# Connect to the site
# Return 0 on a fail,
# 1 if a connection was successfully made,
# 2 if already connected to the site
sub connect
{
	local( $attempts ) = 1; # Retry ONCE! Be friendly.
	local( $res );

	if( $connected eq $site && $curr_remote_user eq $remote_user ){
		# Already connected to this site!
		return 2;
	}

	# Clear out any session active session
	&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;
	}
	return $res;
}	

# This just prods the remote ftpd to prevent time-outs
sub prod
{
	return unless $connected;

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

# checkout and fixup any regexps.
# return 0 on an error
sub checkout_regexps
{
	local( $ret ) = 1;
	# Check out the regexps
	local( $t ) = 'x';
	foreach $r ( @regexp_values ){
		# regexps should never begin or end with a | or have
		# two in a row otherwise the pattern matches everything.
		# Use null to match everything if thats what you mean.
		$value{ $r } =~ s/\|+/|/g;
		$value{ $r } =~ s/^\|//;
		$value{ $r } =~ s/\|$//;
		local( $val ) = $value{ $r };
		next if ! $val;
		eval '$t =~ /$val/';
		if( $@ ){
			local( $err );
			chop( $err = $@ );
			&msg( "Problem with regexp $r ($err)\n" );
			$ret = 0;
		}
	}
	return $ret;
}

sub clear_local
{
	if( ! $use_files ){
		undef( %local_map );
	}
	undef( @local_sorted );
	undef( @local_time );
	undef( @local_size );
	undef( @local_type );
	undef( @local_mode );
	undef( @local_keep );
	undef( @local_totals );
	undef( @local_keep_totals );
}

sub clear_remote
{
	if( ! $use_files ){
		undef( %remote_map );
	}
	undef( @remote_sorted );
	undef( @remote_time );
	undef( @remote_size );
	undef( @remote_type );
	undef( @remote_mode );
	undef( @remote_keep );
	undef( @remote_totals );
	undef( @remote_keep_totals );
}

sub get_local_directory_details
{
	local( @dirs, $dir );
	local( $last_prodded ) = time; # when I last prodded the remote ftpd

	$next_local_mapi = $map_init;
	
	&clear_local();
	
	# Make sure the first elem is 0.
	$local_time[ 0 ] = 0;
	$local_size[ 0 ] = 0;
	$local_type[ 0 ] = 0;
	$local_mode[ 0 ] = 0;

	@get_top = ();

	&msg( "Scanning local directory $local_dir\n" ) if $debug;
	
	if( ! -d $local_dir ){
		&msg( "$local_dir no such directory - creating it\n" );
		if( $dont_do || $timestamp ){
			return 1;
		}
		if( &mkdirs( $local_dir ) ){
			&msg( $log, "Created local dir $local_dir\n" );
			$exit_xfer_status |= $exit_xfers;
		}
		else {
			&msg( $log, "FAILED to create local dir $local_dir\n" );
		}
	}
	if( !chdir( $local_dir ) ){
		&msg( "Cannot change directory to $local_dir\n" );
		return 0;
	}

	if( $local_dir =~ m,^/, ){
		$cwd = $local_dir;
	}
	else {
		&cwd();
	}

	# @dirs is the list of all directories to scan
	# As subdirs are found they are added to the end of the list
	# and as 
	@dirs = ( "." );
	# Most of these variables should be locals in blocks below but
	# that seems to tickle a perl bug and causes a lot of memory to
	# be wasted.
	local( $dir_level ) = 0;
	local( $i ) = 0;
	local( $path, $time, $size, $type, $mode, $name, $isdir, $value, $follow );
	local( $dev,$ino,$fmode,$nlink,$uid,$gid,$rdev,$ssize,
		      $atime,$mtime,$ctime,$blksize,$blocks );
	while( defined( $dir = shift( @dirs ) ) ){

		if( !opendir( DIR, $dir ) ){
			&msg( "Cannot open local directory $dir, skipping it\n" );
			next;
		}

		while( defined( $name = readdir( DIR ) ) ){
			$isdir = 0;

			# Prod the remote system from time to time
			# To prevent time outs.  Only look once every 50 files
			# to save on unnecessary systems calls.
			if( ($i % 50 == 0) && time > ($last_prodded + $prod_interval) ){
				$last_prodded = time;
				&prod();
			}
			$i ++;

			$path = "$dir/$name";
			$path =~ s,(^|/)\./,,;
			next if $name eq '.' || $name eq '..' ||
				($local_ignore && $path =~ /$local_ignore/);

			$follow = ($follow_local_symlinks ne '' && $path =~ /$follow_local_symlinks/);
			if( !$follow && -l $path ){
				$value = readlink( $path );
				( $dev,$ino,$fmode,$nlink,$uid,$gid,$rdev,$ssize,
				      $atime,$mtime,$ctime,$blksize,$blocks ) =
					lstat( _ );
				$size = $ssize;
				$time = $mtime;
				$type = "l $value";
				$mode = $fmode;
			}
			elsif( ($isdir = ($follow ? (-d $path) : (-d _))) ||
			         -f _ ){
				( $dev,$ino,$fmode,$nlink,$uid,$gid,$rdev,$ssize,
				      $atime,$mtime,$ctime,$blksize,$blocks ) =
					stat( _ );
				$size = $ssize;
				$time = $mtime;
				$mode = $fmode;
				if( $isdir ){
					push( @dirs, $path ) if $recursive;
					$type = 'd';
				}
				else {
					$type = 'f';
				}
				if( $dir_level == 0 && $update_local ){
					push( @get_top, $path );
				}
			}
			else {
				&msg( "unknown file type $path, skipping\n" );
				next;
			}
			if( $debug > 2){
				printf "local: %s %s %s %s 0%o\n",
					$path, $size, $time, $type, $mode;
			}
			if( $max_age && $time != 0 && $time < $max_age ){
				&msg( "   too old: $path\n" ) if $debug > 1;
				next;
			}

			local( $mapi ) = $next_local_mapi++;
			# push( @local_sorted, $path );
			$local_sorted[ $mapi - 1 ] = $path;
			$local_map{ $path } = $mapi;
			$local_time[ $mapi ] = $time;
			$local_size[ $mapi ] = $size;
			$local_type[ $mapi ] = $type;
			$local_mode[ $mapi ] = $mode;
			if( $type eq 'd' ){
				$local_totals[ 0 ]++;
			}
			else {
				$local_totals[ 1 ]++;
			}
		}
		closedir( DIR );
		$dir_level++;

		if( ! $recursive ){
			last;
		}
	}
	return 1;
}

# Return true if the remote directory listing was brought back safely.
sub get_remote_directory_details
{
	local( $type_changed ) = 0;
	local( $udirtmp );
	local( $storename ) = "/dev/null";

	&msg( "Scanning remote directory $remote_dir\n" ) if $debug;
	
	if( $store_remote_listing ){
		eval "\$storename = \"$store_remote_listing\"";
	}

	$next_remote_mapi = $map_init;
	&clear_remote();

	# Make sure the first elem is 0.
	$remote_time[ 0 ] = 0;
	$remote_size[ 0 ] = 0;
	$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;
		}
	}

	local( $rls );

	$use_ls = 0;

	if( $local_ls_lR_file ){
	    	local( $dirtmp ) = $local_ls_lR_file;
		&msg( " Using local file $local_ls_lR_file for remote dir listing\n" ) if $debug;
		local( $unsquish );
		if( $dirtmp =~ /\.$sys_compress_suffix$/ ){
			$unsquish = $sys_compress_prog;
		}
		elsif( $dirtmp =~ /\.($gzip_suffix|$old_gzip_suffix)$/ ){
			$unsquish = $gzip_prog;
		}
  		if( defined( $unsquish ) ){
  			local( $f );
  			$f = $dirtmp;
			$f =~ s/($shell_metachars)/\\$1/g;
			$dirtmp = "$unsquish -d < \"$f\" |";
  		}
		if( ! open( DIRTMP, $dirtmp ) ){
			&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";
		}
	}
	elsif( $ls_lR_file ){
		local( $dirtmp );
		$dirtmp = "$big_temp/.dir$$";
		if( $ls_lR_file =~ /\.($sys_compress_suffix|$gzip_suffix|$old_gzip_suffix)$/ ){
			$dirtmp .= ".$1";
		}

		&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;
		}
		local( $unsquish );
		if( $dirtmp =~ /\.$sys_compress_suffix$/ ){
			$unsquish = $sys_compress_prog;
		}
		elsif( $dirtmp =~ /\.($gzip_suffix|$old_gzip_suffix)$/ ){
			$unsquish = $gzip_prog;
		}
  		if( defined( $unsquish ) ){
  			local( $f, $uf );
			$uf = $udirtmp = $dirtmp;
			$dirtmp =~ s/($shell_metachars)/\\$1/g;
  			$f = $dirtmp;
  			$dirtmp =~ s/\.($sys_compress_suffix|$gzip_suffix|$old_gzip_suffix)$//;
  			$udirtmp =~ s/\.($sys_compress_suffix|$gzip_suffix|$ol_gzip_suffix)$//;
			if( &sys( "$unsquish -d < \"$f\" > \"$dirtmp\"" ) != 0 ){
				&msg( "Cannot uncompress directory listing\n" );
				return 0;
			}
  			unlink( $uf );
  		}
		else {
			$udirtmp = $dirtmp;
		}

		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;
		}
		else {
			$type_changed = 1;
		}
	}
	
	$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;
		}
		
		$rls = "ftp'NS";
	}
		
	$rcwd = '';
	if( $vms ){
		# Strip this off all pathnames to make them
		# 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;
	}
	if( $vms ){
		# Need to get in terms of the full pathname
		# so add it back in - see unix2vms at end of mirror
		$vms_dir = $remote_dir;
	}
	
	if( $storename ne "/dev/null" ){
		open( STORE, ">$storename" ) || die( "Cannot write to $storename\n" );
	}

	local( $parse_state ) = &parse_remote_details();

	close( STORE );

	
	if( $local_ls_lR_file ){
		close( DIRTMP );
	}
	elsif( $ls_lR_file ){
		close( DIRTMP );
		unlink( $udirtmp );
	}
	else {
		# 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
				# change back unless something is wrong
				$msg .= "aborting\n";
				&msg( $msg );
				return 0;
			}
			else {
				$msg .= "ignoring\n";
				&msg( $msg );
			}
		}
	}

	# If the other end dropped part way thru make sure the
	# higher routines know!
	return $parse_state;
}

sub parse_timeout
{
	$parse_timed_out = 1;
	die "timeout: parse_remote_details";
}

sub parse_remote_details
{
	local( $ret );
	local( $old_sig );

	$parse_timed_out = 0;
	
	if( ! $use_ls ){
		# No need to bother with the timers
		return &parse_remote_details_real();
	}
	
	# This may timeout
	$old_sig = $SIG{ 'ALRM' };
	$SIG{ 'ALRM' } = "main\'parse_timeout";
	
	$ret = eval '&parse_remote_details_real()';
	
	&alarm( 0 );

	$SIG{ 'ALRM' } = $old_sig;

	if( $@ =~ /^timeout/ ){
		&msg( "timed out parsing directory details\n" );
		return 0;
	}
	return $ret;
}


sub parse_remote_details_real
{