mirror.pl

站点映像程序

		# Found a package so process all packages from now on
		$skip_till = $limit_packages = 0;
	}
	
	local( $exit_status ) = $exit_fail_noconnect;  # Presume the worse.
	$timeouts = 0;

	# set things from the command line arguments
	&command_line_override();

	if( ! &checkout_regexps() ){
		&msg( "skipping package\n\n" );
		return $exit_status;
	}

	# set each variable $key = $value{ $key }
	&set_variables();

	# don't trash locally glossed over things with stuff from the remote
	if( $local_ignore ){
		if( $exclude_patt ){
			$exclude_patt .= '|' . $local_ignore;
		}
		else {
			$exclude_patt = $local_ignore;
		}
	}

	if( $debug > 3 ){
		&pr_variables( "\n" );
	}
	elsif( $package && ! $pretty_print ){
		if( $get_patt ){
			&msg( "package=$package $site:$remote_dir -> $local_dir\n");
		}
		else {
			&msg( "package=$package $local_dir -> $site:$remote_dir\n" );
		}
		&msg( "algorithm=$algorithm\n") if $algorithm != 0;
	}
	
	# Don't bother if trying to mirror here!
	if( !$interactive && !$force && ((gethostbyname( $site ))[0] eq $hostname) ){
		&msg( "Skipping $site as it is this local site!\n\n" );
		return $exit_ok;
	}

	chdir $home;

	$max_age = 0;
	if( $value{ 'max_days' } ne '0' ){
		$max_age = time - ($value{ 'max_days' } * 24 * 60 * 60);
		&msg( "max_age = $max_age\n" ) if $debug > 1;
	}

	# pull in external code, if required
	if( $external_mapping ){
		&msg( "Loading external mapping from $external_mapping.\n" ) if $debug > 0 ;
		do $external_mapping || die "Cannot load from $external_mapping";
	}

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

	if( $recurse_hard ){
		$recursive = 1;
	}
	if( $algorithm == 1 ){
		$recursive = 0;
		$make_bad_symlinks = 1;
		$rem_start_len = length( $remote_dir );
	}

	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
	$XFER = $get_file ? "get" : "put";

	# create the list of items to copy
	@transfer_list = ();
	if( $interactive ){
		if( $algorithm == 1 ){
			warn "Cannot use algorithm 1 with interactive, using 0\n";
			$algorithm = 0;
		}
		# copy the remainder of items from argv to the transfer list
		while( @ARGV ){
			# copy the local directory
			if( @ARGV ){
				push( @transfer_list, shift( @ARGV ) );
			} 
	
			# copy the remote directory
			if( @ARGV ){
				push( @transfer_list, shift( @ARGV ) );
			}
			else {
				die "remote directory must be specified\n";
			}
	
			# copy the pattern, if available
			if( @ARGV ){
				push( @transfer_list, shift( @ARGV ) );
			} else {
				push( @transfer_list, $default{ 'get_patt' } );
			}
		}
	
		if( $debug > 1 ){
			local( @t );
			@t  = @transfer_list;
	
			while( @t ){
				printf( "local_dir=%s remote_dir=%s patt=%s\n",
					shift( @t ), shift( @t ), shift( @t ) );
			}
		}
	}
	else {
		push( @transfer_list, $local_dir );
		push( @transfer_list, $remote_dir );
		push( @transfer_list, $get_patt );
		if( $algorithm != 1 ){
			$get_one_package = 1;
		}
        }
		

	if( $update_local && $get_patt ){
		if( $get_patt ne $default{ 'get_patt' } ){
			&msg( "Cannot mix get_patt and update_local.  get_patt ignored\n" );
		}
		$get_patt = '';
	}

	
	if( !$site || (!$interactive && (!$local_dir || !$remote_dir)) ){
		&msg( "Insufficient details for package to be fetched\n" );
		&msg( "Must give at least: site, remote_user, remote_dir and local_dir\n\n" );
		return $exit_status;
	}

        if( $pretty_print ){
                # Don't actually mirror just print a pretty list
                # of what would be mirrored.  This is for mailing to
                # people
		if( $skip ){
			return $exit_ok;
		}
                &msg( "$package  \"$comment\"\n" );
                &msg( "  $site:$remote_dir  -->  $local_dir\n\n" );
                return $exit_ok;
        }

	if( $skip ){
		&msg( "Skipping $site:$package because $skip\n\n" );
		return $exit_ok;
	}

	$split_max = &to_bytes( $split_max );
	$split_chunk = &to_bytes( $split_chunk );

	if( $split_max && $split_max <= $split_chunk ){
		&msg( "split_max <= split_chunk - skipping package\n" );
		&msg( " $split_max <= $split_chunk\n\n" );
		return $exit_status;
	}

	if( $split_chunk && ($split_chunk & 511) ){
		&msg( "split_chunk bad size - skipping package\n" );
		&msg( " $split_chunk should be a multiple of 512 bytes\n\n" );
		return $exit_status;
	}

	if( $local_dir_check && ! -d $local_dir ){
		&msg( "local_dir $local_dir does not exist - skipping package\n" );
		return $exit_status;
	}

	if( $get_one_package && $algorithm != 1 ){
    		# If only getting one package may as well parse the
		# local directory listings before connecting to the
		# remote site.  (With the status_file stuff this info
		# can then be reused if something goes wrong.)
		if( $use_files ){
			&create_assocs();
		}

		if( !&get_local_directory_details() ){
			&msg( "Cannot get local directory details ($local_dir)\n" );
			&disconnect();
			&msg( "\n" );
			return $exit_status;
		}
	}

	local( $con ) = &connect();
	if( $con <= 0 ){
		&msg( "Cannot connect, skipping package\n" );
		&disconnect();
		&msg( "\n" );
		return $exit_status;
	}

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

		}
	}
	else {
		# Already connected to this site - so no need to login again
		&msg( "Already connected to site $site\n" ) if $debug;
	}

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

	$exit_status = $exit_fail; # ok this is now the worse case

	# Mirror thinks in terms of Unix pathnames.
	# Ask ftp.pl to map any remote name it is about to use by
	# 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( $debug > 2 ){
			&msg( "remote site " . ($remote_has_chmod ? "has" : "hasn't") . " got chmod\n" );
			&msg( "remote site " . ($remote_has_idle ? "has" : "hasn't") . " got idle\n" );
		}
	}
	
	if( $remote_has_idle && $remote_idle ){
		if( ! &ftp'quote( "site idle $remote_idle" ) ){
			&msg( "Cannot set remote idle\n" );
		}
		elsif( $debug > 2 ){
		 	&msg( "remote idle has been set to $remote_idle\n" );
		}
	}

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

	@log = ();
	$cannot = 0;

	local( @sub_dirs );
	while( @transfer_list ){
		# get files
		$local_dir = shift( @transfer_list );
		$remote_dir = shift( @transfer_list );
		$get_patt = shift( @transfer_list );

		# Clear all details
		undef( @xfer_dest );
		undef( @xfer_src );
		undef( @xfer_attribs );
		undef( @things_to_make );
		undef( @sub_dirs );

		if( ! $get_one_package ){
			if( $use_files ){
				&create_assocs();
			}

			if( !&get_local_directory_details() ){
				&msg( "Cannot get local directory details ($local_dir)\n" );
				&disconnect();
				&msg( "\n" );
				return $exit_status;
			}
		}

		# Create a get_patt from the contents of the local directory
		if( $update_local && $#get_top >= 0 ){
			$get_patt = '^' . join( '|^', @get_top );
			$get_patt =~ s/$squished//g;
			&msg( "get_patt = $get_patt\n" ) if $debug;
		}
	
		if( !&get_remote_directory_details() ){
			&msg( "Cannot get remote directory details ($remote_dir)\n" );
			if( $algorithm == 1 ){
				# Skip this directory.
				$cannot++;
				if( $cannot < $max_failed_dirs ){
					next;
				}
				# Too many failed directories.  Fall thru'
				# into disconnect.
			}
			&disconnect();
			&msg( "\n" );
			return $exit_status;
		}
	
		if( $get_file ){
			&compare_dirs(
				*remote_sorted,
				 *remote_map, *remote_time,
				  *remote_size, *remote_type,
				*local_sorted,
				 *local_map, *local_time,
				  *local_size, *local_type,
				   *local_keep, *local_keep_totals );
		} else {
			&compare_dirs(
				*local_sorted,
				 *local_map, *local_time,
				  *local_size, *local_type,
				*remote_sorted,
				 *remote_map, *remote_time,
				  *remote_size, *remote_type,
				   *remote_keep, *remote_keep_totals );
		}

		if( $timestamp ){
			&set_timestamps();
			if( $algorithm == 1 ){
				foreach $sd ( @sub_dirs ){
					push( @transfer_list, "$local_dir/$sd" );
					push( @transfer_list, "$remote_dir/$sd" );
					push( @transfer_list, $get_patt );
				}
			}

			next;
		}

		&make_dirs();
		&do_all_transfers();

		$exit_status = $exit_ok;	# Everything went ok.

		if( $get_file ){
			# I must have finished with the remote information
			# so clear it out.
			&clear_remote();
		}
		else {
			# clear out local info.
			&clear_local();
		}
		
		if( $save_deletes ){
			# If $save_dir is null, make $save_dir to be
			# subdirectory 'Old' under 
			# current path
			if( ( ! defined( $save_dir ) ) || ( $save_dir eq '' ) ){
				$save_dir = "$cwd/Old";
			}

			# If $save_dir is not absolute, take it as
			# subdirectory of current path
			if( $save_dir !~ m,^/, ){
               			$save_dir = "$cwd/$save_dir";
       			}
		}

		if( $do_deletes || $save_deletes ){
			if( $get_file ){
				&do_deletes(
					*local_sorted,
					 *local_map,
					  *local_type, *local_keep,
					   *local_totals, *local_keep_totals );
			}
			else {
				&do_deletes(
					*remote_sorted,
					 *remote_map,
					  *remote_type, *remote_keep,
					   *remote_totals, *remote_keep_totals );
			}
		}

		&make_symlinks();
		undef( @things_to_make );

		if( $algorithm == 1 ){
			foreach $sd ( @sub_dirs ){
				push( @transfer_list, "$local_dir/$sd" );
				push( @transfer_list, "$remote_dir/$sd" );
				push( @transfer_list, $get_patt );
			}
		}

		# No more transfers if the connection has died.
		last if ! $connected;
	}

	&clear_local();
	&clear_remote();
	
	if( $use_files ){
		# Close and zap.
		&delete_assocs();
	}

	# Should I force a disconnect now?
	if( $connected && $disconnect ){
		&disconnect();
	}

	if( $dont_do || $timestamp ){
		# Don't generate logs/email
		&msg( "\n" );
		return $exit_status;
	}

	local( $now ) = &time_to_standard( time );
	if( $update_log ){
		if( ! open( LOGG, ">>$update_log" ) ){
			&msg( "Cannot append to $update_log because: $!\n\n" );
			# Serious but this shouldn't stop mirroring.
			# return $exit_fail;
		}
		print LOGG "mirroring $package ($site:$remote_dir) completed successfully \@ $now\n";
		print LOGG @log;
		close( LOGG );
	}

	if( $#log >= 0 && $mail_prog ne '' && $mail_to =~ /./ ){
		local( $arg );
		eval "\$arg = \"$mail_subject\"";
		if( ! open( MAIL, "|$mail_prog $arg $mail_to" ) ){
			&msg( "Cannot run: $com\n\n" );
			return $exit_fail;
		}
		if( $get_patt ){
			print MAIL "Mirrored $package ($site:$remote_dir -> $local_dir) $comment \@ $now\n";
		}
		else {
			print MAIL "Mirrored $package ($local_dir -> $site:$remote_dir) $comment \@ $now\n";
		}
		print MAIL @log;
		close( MAIL );
	}
	undef( @log );