mirror.pl

站点映像程序

	local( $path, $size, $time, $type, $mode, $rdir, $rcwd );
	local( @dir_list );
	local( $i ) = 0;
	local( $old_path );
	
	if( $use_ls ){
		&alarm( $parse_time );
	}
	
	# Need to loop in case $recurse_hard
	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;
				$_ = $path;
				eval $ls_fix_mappings;
				if( $_ ne $old_path ){
					$path = $_;
				}
			}
			next if $name eq '.' || $name eq '..';
			if( $debug > 2 ){
				printf "remote: %s %s %s %s 0%o\n",
 					$path, $size, $time, $type, $mode;
			}
			if( $use_ls ){
				# I just got something so shouldn't timeout
				&alarm( $parse_time );
			}
			else {
				# 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 ++;
			}
			
			if( $algorithm == 1 ){
				$path0 = substr( $remote_dir, $rem_start_len );
				if( $path0 ne '' ){
					$path0 .= "/";
				}
				$path0 .= $path;
				$path0 =~ s,^/,,;
				# &msg( "debug: $path0, $remote_dir, $rem_start_len\n" );
			}
			else {
			    	$path0 = $path;
			}

			if( $exclude_patt && $path0 =~ /$exclude_patt/ ){
				&msg( "   exclude: $path0\n" ) if $debug > 1;
				next;
			}

			if( $type eq 'd' ){
				push( @dir_list, $path0 );
			}
			
			if( $max_age && $time != 0 && $time < $max_age ){
				&msg( "   too old: $path0\n" ) if $debug > 1;
				next;
			}
			
			# If vms and only keeping the latest version
			if( $vms && !$vms_keep_versions ){
				# If we already have a file, pick the newer
				# TODO: pick the greatest version number
				local( $ri ) = $remote_map{ $path };
				if( $ri &&
				    $time > $remote_time[ $ri ] ){
					$remote_time[ $ri ] = $time;
					$remote_size[ $ri ] = $size;
					$remote_type[ $ri ] = $type;
					$remote_mode[ $ri ] = $mode;
					next;
				}
			}
			
			local( $mapi ) = $next_remote_mapi++;
			# push( @remote_sorted, $path );
			$remote_sorted[ $mapi - 1 ] = $path;
			$remote_map{ $path } = $mapi;
			$remote_time[ $mapi ] = $time;
			$remote_size[ $mapi ] = $size;
			$remote_type[ $mapi ] = $type;
			$remote_mode[ $mapi ] = $mode;
			if( $type eq 'd' ){
				$remote_totals[ 0 ]++;
			}
			else {
				$remote_totals[ 1 ]++;
			}
		}

		if( $use_ls ){
			if( ! &ftp'dir_close() ){
				&msg( "Failure at end of remote directory" .
				 " ($rdir) because: $ftp'response\n" );
				return 0;
			}
		}
		
		if( $recurse_hard ){
			local( $done ) = 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;
					last;
				}
				$rcwd = shift( @dir_list );
				$rdir = "$remote_dir/$rcwd";
				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;
		}
		
		# All done - snap the loop
		last;
	}
	return 1;
}

sub compare_dirs
{
	# This declaration must be "local()" because it modifies global data.
	local( *src_paths,
		*src_map, *src_time,
		 *src_size, *src_type, 
	       *dest_paths,
		*dest_map, *dest_time,
		 *dest_size, *dest_type,
		  *dest_keep, *dest_keep_totals ) = @_;
	local( $src_path, $dest_path, $i );
	local( $last_prodded ) = time; # when I last prodded the remote ftpd

	# 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( $desti, $srci, $compress, $srciZ, $srcigz, $split, $dest_path_real );
	local( $old_dest_path, $existing_path, $tmp, $restart );
	local( $sp, $dp ) = ($#src_paths + 1, $#dest_paths + 1);
	
	&msg( "compare directories (src $sp, dest $dp)\n" ) if $debug;
	$total_src_size = 0;

	for( $i = 0; $i <= $#src_paths; $i++ ){
		$dest_path = $src_path = $src_paths[ $i ];
		
		$desti = $dest_map{ $dest_path };
		$srci = $i + 1;

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

		if( $debug > 2 ){
			&msg( "Compare src $src_path ($srci): " .
				&t2str( $src_time[ $srci ] ) );
			&msg( " $src_size[ $srci ] $src_type[ $srci ]\n" );
		}

		# I'm about to do a lot of matching on this
		study( $src_path );

		# Should I compress this file?
		#  Don't compress this file if trying to do a compress->gzip
		# conversion.
		$compress = 0;
		if( &will_compress( $src_path, $srci ) ){
			if( $dest_path !~ /$squished/o ){
				$srciZ = $src_map{ "$src_path.$sys_compress_suffix" };
				$srcigz = $src_map{ "$src_path.$gzip_suffix" };
				if( $srciZ || $srcigz ){
					# There is a compressed version
					# too!  Skip the uncompressed one
					&msg( "   do not xfer, compressed version exists: $src_path\n" ) if $debug > 1;
					next;
				}

				$compress = 1;
				$dest_path .= '.' . $compress_suffix;
				$desti = $dest_map{ $dest_path };
			}
		}
		# need to adjust the symlink pointer?
		elsif( $src_type[ $srci ] =~ /^l (.*)/ ){
		   # Am I going to squish the file this points to?
		   local( $real, $reali, $reali1 );
		   local( $count ) = 0;
		   while( $count++ <= 10 ){
			$real = &expand_symlink( $src_path, $1 );
			$reali = $src_map{ $real };
			# Look out for when the symlink loops on itself
			if( defined( $reali1 ) && $reali == $reali1 ){
				last;
			}
			$reali1 = $reali;
			last if $src_type[ $reali ] !~ /^l (.*)$/;
		   }
		   if( &will_compress( $real, $reali ) ){
			# real is going to be (at least) squished so
			# suffix the dest
			$dest_path .= '.' . $compress_suffix;
			$desti = $dest_map{ $dest_path };
			$src_type[ $srci ] .= '.' . $compress_suffix;
			&msg( "  symlink pointer is now $dest_path\n" ) if $debug > 1;
			if( $src_map{ $dest_path } ){
				&msg( "do not xfer, $dest_path exists\n" ) if $debug > 1;
				next;
			}
		   }
		   if( &will_split( $real, $reali ) ){
			$src_type[ $srci ] .= '-split/README';
			&msg( "  symlink pointer now to $real-split/README'\n" ) if $debug > 1;
		   }
		}
		
		# If this is a file that I decided not to compress but the
		# remote file is compressed and I want a gziped local version
		# then force compression.
		# This ignores any compress_excl flags.
		if( ! $compress &&
		    $compress_suffix eq $gzip_suffix &&
		    $compress_conv_patt && $src_path =~ /$compress_conv_patt/ ){
			$_ = $dest_path;
			eval $compress_conv_expr;
			$dest_path = $_;
			# check if dest_path exists in the sources.  If it
			# does, ignore this file.  This is to avoid the
			# double mirroring problem if you are using gzip and
			# the source site has both foo.Z and foo.gz.
			if( $src_map{ $dest_path } ){
				&msg( "Skipping $src_path because remote site also has $dest_path\n" ) if $debug > 2;
				next;
			}
			&msg( "   $src_path -> $dest_path\n" ) if $debug > 2;
			$desti = $dest_map{ $dest_path };
			$compress = 1;
		}

		# Am I converting the compression on the file this points to?
		if( $src_type[ $srci ] =~ /^l (.*)/ &&
		      $compress_suffix eq $gzip_suffix ){
		        local( $value ) = $1;
			local( $real ) = &expand_symlink( $src_path, $value );
		        local( $reali ) = $src_map{ $real };
		        if( $src_type[ $reali ] ne 'd' &&
			    $src_type[ $reali ] ne /^l .*/ &&
			    $compress_conv_patt && $real =~ /$compress_conv_patt/ ){
			    $dest_path =~ s/$sys_compress_suffix$/$gzip_suffix/;
			    $desti = $dest_map{ $dest_path };
			    $value =~ s/$sys_compress_suffix$/$gzip_suffix/;
			    &msg( "  symlink pointer is now $dest_path (conv)\n")
				 if $debug > 1;
			}
			if( $name_mappings || $external_mapping ){
			        local( $old ) = $value;
				$value = &map_name( $value );
				if( $value ne $old ){
				    &msg( "   Mapped symlink value is $value\n" ) if $debug > 2;
				}
				    
			}
			$src_type[ $srci ] = "l ".$value;
		}

		if( $name_mappings || $external_mapping ){
			local( $old_dest_path ) = $dest_path;
			$dest_path = &map_name( $dest_path );
			if( $dest_path ne $old_dest_path ){
				$desti = $dest_map{ $dest_path };
				&msg( "   Mapped name is $dest_path\n" ) if $debug > 2;
			}
		}
		
		# Should this file be split?
		$split = 0;
		$dest_path_real = undef;
		if( &will_split( $src_path, $srci ) ){
			$split = 1;
			$dest_path_real = $dest_path;
			$dest_path .= "-split/part01";
			$desti = $dest_map{ $dest_path };
		}

		if( $debug > 2 ){
			&msg( "       dest $dest_path ($desti): " .
				&t2str( $dest_time[ $desti ] ) );
			&msg( " $dest_size[ $desti ] $dest_type[ $desti ]" );
			&msg( " (->$compress_suffix)" ) if $compress;
			&msg( " (split)" ) if $split;
			&msg( "\n" );
		}
		
		if( $algorithm == 1 ){
			$src_path0 = substr( $remote_dir, $rem_start_len );
			if( $src_path0 ne '' ){
				$src_path0 .= "/";
			}
		 	$src_path0 .= $src_path;
			$src_path0 =~ s,^/,,;
			#&msg( "debug: $src_path0, $remote_dir, $rem_start_len\n" );
		}
		else {
			$src_path0 = $src_path;
		}
			
		if( $get_patt && $src_path0 !~ /$get_patt/ ){
			&msg( "   do not xfer: $src_path0\n" ) if $debug > 1;
			next;
		}

		# Just create any needed directories (the timestamps
		# should be ignored)
		if( $src_type[ $srci ] eq 'd' ){
			if( $algorithm == 1 ){
				if( $exclude_patt && $src_path0 =~ /$exclude_patt/ ){
					&msg( "   exclude: $src_path0\n" ) if $debug > 1;
				}
				else {
					$rel_src_path = $src_path;
					$rel_src_path =~ s,.*/,,;
					push( @sub_dirs, $rel_src_path );
					&msg( "   adding $rel_src_path\n" ) if $debug;
				}
			}
			if( $dest_type[ $desti ] ne 'd' ){
				push( @things_to_make, "d $dest_path" );
				&msg( "   need to mkdir $dest_path\n" ) if $debug > 1;
			}
			# keep the directory once made
			# (Also if local is really a symlink elsewhere
			#  it will be kept.)
			&keep( $desti, $dest_path, *dest_keep, *dest_keep_totals, *dest_map, 0 );
			next;
		}

		# Well that just leaves files and symlinks.
		# Do various checks on them.

		if( $desti && ! $dest_keep[ $desti ] ){
			&keep( $desti, $dest_path, *dest_keep, *dest_keep_totals, *dest_map, 1 );
			if( $split ){
				# Mark all the split parts as kept
				local( $dpp, $dps );
				($dpp, $dps) = ($dest_path =~ m,^(.*/)(part[0-9]+)$,);
				while( 1 ){
					$dps++;
					if( !($di = $dest_map{ $dpp . $dps }) ){
						last;
					}
					&keep( $di, $dpp . $dps, *dest_keep, *dest_keep_totals, *dest_map, 1 );
				}
				# And the README
				$dps = 'README';
				$di = $dest_map{ $dpp . $dps };
				if( $di ){
					&keep( $di, $dpp . $dps, *dest_keep, *dest_keep_totals, *dest_map, 1 );
				}
				# And the directory
				chop( $dpp );
				$dps = '';
				$di = $dest_map{ $dpp . $dps };
				if( $di ){
					&keep( $di, $dpp . $dps, *dest_keep, *dest_keep_totals, *dest_map, 0 );
				}
			}
		}
		
		local( $update ) = 0;

		if( ! $get_missing ){
			next;
		}

		if( ($max_size > 0) && ($src_size[ $srci ] > $max_size) ){
			&msg( "   src is too big, no need to xfer it\n" ) if $debug > 2;
			next;
		}

		if( $force || ! $dest_type[ $desti ] || $timestamp ){
			# Either I'm forcing xfers or the file doesn't exist
			# either way I should update
			$update = 1;
		}
		else {
			# Maybe the src is newer?
			if( $get_newer &&
			   &compare_times( $src_time[ $srci ], $dest_time[ $desti ] ) ){
				&msg( "   src is newer, xfer it\n" ) if $debug > 2;
				$update = 1;
			}
			# or maybe its size has changed?
			# don't bother if file was compressed or split as the
			# size will have changed anyway
			if( !$update &&
			   !$compress && !$split &&
			   $get_size_change &&
			   ($src_type[ $srci ] eq 'f') &&
			   ($src_size[ $srci ] != $dest_size[ $desti ]) ){
				$update = 1;
				if( $debug > 2 ){
				    &msg( "   src is different size, xfer it\n" );
				}
			}
			# Maybe it has changed type!
			if( !$update &&
			   $src_type[ $srci ] ne $dest_type[ $desti ] ){
				$update = 1;
				if( $debug > 2 ){
				    &msg( "   src has different type, xfer it\n" );
				}
			}
		}

		if( ! $update ){
			next;
		}

		if( $src_type[ $srci ] =~ /^l (.*)/ ){
			# If the symlink hasn't changed then may as well 
			# leave it alone
			if( $src_type[ $srci ] eq $dest_type[ $desti ] ){
				next;
			}
			# DONT FORGET TO NAME MAP!!!!
			$existing_path = $1;

			if( $compress_suffix eq $gzip_suffix &&
			    $compress_conv_patt && $existing_path =~ /$compress_conv_patt/ ){
				$_ = $existing_path;
				eval $compress_conv_expr;
				$existing_path = $_;
			}

			push( @things_to_make, "l $dest_path -> $existing_path" );
			&msg( "   need to symlink $dest_path -> $existing_path\n" ) if $debug > 2;
			next;
		}

		# Now that the tests are complete use the real dest.
		if( defined( $dest_path_real ) ){
			$dest_path = $dest_path_real;
			$desti = $dest_map{ $dest_path };
		}

		$total_src_size += $src_size[ $srci ];
		if( $dont_do ){
			&msg("Should ");
		}
		&msg( "$XFER file $src_path as $dest_path ($src_size[ $srci ])".
			($compress ? " (->$compress_suffix)" : "") .
			($split ? " (split)" : "") . "\n" ) if $debug > 1;
		pu