--- mirror.pl Sat May 30 05:01:42 1998 +++ - Tue Jan 29 18:06:25 2002 @@ -17,6 +17,12 @@ # This software is provided "as is" without express or implied warranty. # # +# The Debian system patched this file after installation to add: +# ls-lR file patching 2001/09/29 +# Copyright (C) 1999-2001 Ian Maclaine-cross +# and other changes. +# Debian patches are copyright by their authors and you may use them only +# under the conditions of the General Public License in file GPL. # # $Id: mirror.pl,v 2.9 1998/05/29 19:01:07 lmjm Exp lmjm $ # $Log: mirror.pl,v $ @@ -84,6 +90,8 @@ # # +$#ARGV >= 0 or die("Try `man mirror` for help.\n"); + # Make sure we don't go recursive processing signals $sigs = 0; $max_sigs = 10; @@ -142,6 +150,18 @@ $old_gzip_suffix = 'z'; } +# For remote systems with gzipped patches to their ls-lR.gz file. The +# gzipped patch file is a unified diff between old and new ls-lR. The +# times file has modification times in decimal epoch seconds of the +# old and new ls-lR file on its first and second lines respectively. +if( $patch_prog = &find_prog( 'patch' ) ){ + $patch_local = '-usNT'; + $patch_UTC = '-usNZ'; +} +$patch_suffix = '.pth'; # These suffices distinct +$patch_gzip_suffix = '.patch.gz'; # if truncated locally. +$times_suffix = '.times'; + # A mail program that can be called as: "$mail_prog person_list' # Can be overridden with the mail_prog keyword. # If you use $mail_subject to pass extra arguments then remember that @@ -280,6 +300,7 @@ $default{ 'get_size_change' } = 1; # get the file if size if different than local $default{ 'make_bad_symlinks' } = 0; # prevent symlinks to non-existant files $default{ 'follow_local_symlinks' } = ''; # Follow symlinks to pathnames matching this regexp. +$default{ 'get_symlink_files' } = 0; # If true gets file and makes symlink otherwise bad. $default{ 'get_missing' } = 1; # Set get_missing to 0 to just delete files not on remote system $default{ 'get_file' } = 1; # perform get, not put by default $default{ 'text_mode' } = 0; # transfer in binary mode by default @@ -335,9 +356,11 @@ $default{ 'remote_fs' } = 'unix'; # Remote filestore # Other posibilies dls, netware and vms -$default{ 'ls_lR_file' } = ''; # remote file containing ls-lR - else use remote ls +$default{ 'ls_lR_file' } = ''; # remote file containing ls-lR, patch or + # times - else use remote ls $default{ 'local_ls_lR_file' } = ''; # local file containing ls-lR - # useful when first copying a large remote package + # used when first copying a large remote package + # or ls_lR_file is a remote ls-lR patch or times $default{ 'recursive' } = 1; # true indicates to do recursive processing $default{ 'recurse_hard' } = 0; # true indicates have to cwd+ls for each remote # subdirectory - AVOID wherever possible. @@ -369,8 +392,9 @@ 'mode_copy', 'disconnect', 'interactive', 'text_mode', 'force', 'get_file', 'verbose', 'proxy', 'delete_get_patt', 'delete_source', 'save_deletes', 'use_files', 'use_timelocal', - 'make_bad_symlinks', 'recurse_hard', 'get_missing', 'strip_cr', - 'passive_ftp', 'using_socks', 'local_dir_check' ); + 'make_bad_symlinks', 'get_symlink_files', 'recurse_hard', + 'get_missing', 'strip_cr', 'passive_ftp', 'using_socks', + 'local_dir_check' ); %boolean_values = (); &set_assoc_from_array( *boolean_values ); @@ -435,6 +459,8 @@ sub msg_version { &msg( '$Id: mirror.pl,v 2.9 1998/05/29 19:01:07 lmjm Exp lmjm $' . "\n" ); + &msg( 'Debian patch version: mirror (2.9-38) Tue Jan 29 07:06:25 2002 UTC.' . "\n" ); + &msg( 'Copyright conditions are in file /usr/share/doc/mirror/copyright.' . "\n" ); } parse_args: @@ -547,13 +573,20 @@ $command_line{ 'recursive' } = 0; next; } - - if( $arg =~ /^-k(.*)=(.*)/ ){ - # set the keyword = value - if( !defined( $default{ "$1" } ) ){ - warn "Invalid keyword $1\n"; - } else { - $command_line{ "$1" } = $2; +# Debian bug #93853, -k keyword=value did not work, jkn@softavenue.fi + if( $arg =~ /^-k(.*)/ ){ + local( $key_val ) = $1; + if( ! $key_val ){ + # Must be -k space key=val + $key_val = shift; + } + if( $key_val =~ /(.*)=(.*)/ ){ + # set the keyword = value + if( !defined( $default{ "$1" } ) ){ + warn "Invalid keyword $1\n"; + } else { + $command_line{ "$1" } = $2; + } } next; } @@ -1809,6 +1842,9 @@ $f =~ s/($shell_metachars)/\\$1/g; $dirtmp = "$unsquish -d < \"$f\" |"; } + elsif( $ls_lR_file =~ /($times_suffix|$patch_gzip_suffix)$/ ){ + return 0 if &patch_ls_lR_file()==0; + } if( ! open( DIRTMP, $dirtmp ) ){ &msg( "Cannot open $dirtmp\n" ); return 0; @@ -1944,6 +1980,112 @@ return $parse_state; } +# Get remote ls-lR times or mirror gzipped patch files. +sub patch_ls_lR_file +{ + if( ! $patch_prog ){ + &msg( "No patch program on PATH\n" ); + return 0; + } + local( $f, $fr, $flb, $flt, $flp, $flz, $frb, $frt ); + local( $to , $tn ); + $frb = $frt = $ls_lR_file; + $flb = $dirtmp; + &msg( "Patching $flb using $frb\n" ) if $debug; + local( $tlb ) = -f $flb?(stat($flb))[9]:0; + $dateconv'use_timelocal = $use_timelocal; + $flp = "$flb$patch_suffix"; + $flz = "$flb$patch_gzip_suffix"; + # Get times and patch. + if( $frt =~ /$times_suffix$/ ){ + # Use remote times file. + $frb =~ s/$times_suffix$//; + $flt = "$flb$times_suffix"; + &ftp'get( $frt, $flt, 0 ) ? + &msg( "Got $frt\n" ): + return 0; + open( FT, $flt ); + for( $to, $tn ){ + $f = gmtime( ); + $_ = &lstime_to_time( $f ); + } + close( FT ); + $f = "$frb$patch_gzip_suffix"; + if( $tlb == $to && &ftp'get( $f, $flz, 0 ) && + ! &sys("$gzip_prog -df <$flz >$flp") ){ + &msg( $log, "Got $f\n" ); + unlink $flz if ! $debug; + } + } + else { + # Get time of remote patch file. + $lsparse'fstype = $remote_fs; + $lsparse'name = "$site:$package"; + &lsparse'reset( $remote_dir ); + if( ! &ftp'dir_open( "$flags_nonrecursive $frb" ) ){ + &msg( "List remote ls-lR patch: $ftp'response\n" ); + &ftp'dir_close(); + return 0; + } + local( $p, $s, $trz, $t, $m ) = &lsparse'line( ftp'NS ); + &msg( "Remote ls-lR patch:\n$p $s $trz $t $m\n" ) if $debug; + if( ! &ftp'dir_close() ){ + &msg( "List remote ls-lR patch: $ftp'response\n" ); + return 0; + } + # If remote time does not match local get remote patch file. + local( $tlz ) = -f $flz?(stat($flz))[9]:0; + if( $trz == $tlz ){ + &msg( "No new $frb\n" ); + &msg( "age $trz same as $flz\n" ) if $debug; + } + else { + &ftp'get( $frb, $flz, 0 )? + &msg( $log, "Got $frb $s\n" ): + return 0; + &utime( $trz, $trz, $flz ); + } + # unzip patch and read times. + $frb =~ s/$patch_gzip_suffix$//; + &sys( "$gzip_prog -df <$flz >$flp" ) ? + return 0: + open( FT, $flp ); + for( $to, $tn ){ + ( $fr, $f ) = split( /\t/, ); + $_ = &lstime_to_time( $f ); + } + close( FT ); + } + # Patch or leave or get new local ls-lR file? + $f = "$patch_prog "; + $f .= $use_timelocal?$patch_local:$patch_UTC; + if( $tlb == $to && ! &sys( "$f $flb $flp" ) ){ + &msg( "$flb patched\n" ); + } + elsif( $tlb == $tn ){ + &msg( "$flb up to date\n" ); + } + else { + $fr = "$frb.$gzip_suffix"; + $f = "$flb.$gzip_suffix"; + if( &ftp'get( $fr, $f, 0 ) && + ! &sys( "$gzip_prog -df $f" ) ){ + &utime( $tn, $tn, $flb ); + &msg( $log, "Got $fr for $flb\n" ); + } + else { + &msg( "Did not get $fr\nand $ftp'response\n" ); + return 0; + } + } + unlink $flp, $flt if ! $debug; + if( ! $do_deletes && $exclude_patt =~ /^\.($|\|)/ ){ + &msg( "$flb check complete\n" ); + next; + } + return 1; +} + sub parse_timeout { $parse_timed_out = 1; @@ -2487,11 +2629,15 @@ #warn "get_file = $get_file, can_restart = $can_restart, dest_size = $dest_size[ $tmpi ], dest_time = $dest_time[ $tmpi ], src_time = $src_time[ $srci ]\n"; if( $get_file && $can_restart && - $dest_size[ $tmpi ] != 0 && - ($dest_time[ $tmpi ] eq $src_time[ $srci ]) ){ +# Debian bug #24243, mirror-2.9 does not restart, adam@usa.net + $dest_size[ $tmpi ] != 0 ){ + if ($dest_time[ $tmpi ] eq $src_time[ $srci ]) { # Then this is an xfer of the same file # so just restart where I left off $restart = 'r'; + } elsif ( $debug > 1 ){ + &msg ( "Timestamp useless on $tmp\n" ); + } } # x for xfer, c for compress, s for split push( @xfer_attribs, @@ -2598,19 +2744,15 @@ } local( $dest, $existing ) = ($1, $2); local( $dirpart ) = &dirpart( $dest ); - if( -e "$dirpart/$existing" ){ + local( $ft ) = &expand_symlink( $dest, $existing ); + if( -e $ft ){ + &mkdirs( $dirpart ) if ! -d $dirpart; # symlink to existing file. - if( $dont_do ){ - &msg( "Should symlink $dest to $existing\n" ); - } - else { - &mksymlink( $dest, $existing ); - } +# Debian bug #85353 "bad symlink stops listing with -n" + &mksymlink( $dest, $existing ); next; } - return if $dont_do; - # The existing file doesn't actually exist! # Has it been compressed, gzipped, split? or worse # compressed/gzipped AND split. (OK so it could @@ -2636,8 +2778,27 @@ &msg( "symlink to non-existant file: $dest -> $existing\n" ); &mksymlink( $dest, $existing ); } + elsif ( $get_symlink_files ){ +# Get file within $local_dir tree and make symlink, iml@debian.org, 2001/09/22. + if( $ft =~ m|\.\./| ){ + &msg( "Not getting path $ft\nas not in remote_dir $remote_dir\n" ); + &msg( "and not symlinking $dest -> $existing\n" ); + next thing; + } + local( $dl ) = &dirpart( $ft ); + &mkdirs( $dl ) if ! -d $dl; + if( &ftp'get( $ft, $ft, 0 ) ){ + &msg( $log, "Got $ft\n" ); + &mksymlink( $dest, $existing ); + } + else { + &msg( "Did not get $ft\nbecause $ftp'response\n" ); + &msg( "so not symlinking $dest -> $existing\n" ); + } + } else { &msg( "Not symlinking $dest -> $existing\n" ); + &msg( "as no path $ft\n" ); } } } @@ -3175,7 +3336,7 @@ } else { &msg( $log, "delete DIR $del\n" ); - &ftp'delete( "$del" ) || + &ftp'deldir( "$del" ) || &msg( $log, "ftp delete DIR $del failed\n" ); } } @@ -3243,6 +3404,12 @@ return; } +# Debian bug #85353 "bad symlink stops listing with -n" + if( $dont_do ){ + &msg( "Should symlink $dest_path to $existing_path\n" ); + return; + } + # make the symlink locally # Zap any exiting file/symlink of that name @@ -3845,12 +4012,8 @@ } local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @t; - if( $year < 70 ){ - $year += 2000; - } - else { - $year += 1900; - } +# Debian bug #48611, 1969 appeared as 2069, dsb@smart.net. + $year += 1900; return sprintf( "%04d/%02d/%02d-%02d:%02d:%02d", $year, $mon + 1, $mday, $hour, $min, $sec );