bin/rrr-fsck

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 rrr-fsck -
   6
   7 =head1 SYNOPSIS
   8
   9   rrr-fsck [options] principalfile
  10
  11 =head1 OPTIONS
  12
  13 =over 8
  14
  15 =cut
  16
  17 my @opt = <<'=back' =~ /B<--(\S+)>/g;
  18
  19 =item B<--dry-run|n>
  20
  21 Does nothing, only prints what it would do.
  22
  23 =item B<--help|h>
  24
  25 Prints a brief message and exists.
  26
  27 =item B<--remoteroot=s>
  28
  29 If provided fsck will try to mirror missing files from this location.
  30 For remote locations requiring authentication you may need to set the
  31 environment variables USER and RSYNC_PASSWORD as well.
  32
  33 =item B<--verbose|v+>
  34
  35 More feedback.
  36
  37 =item B<--yes|y>
  38
  39 Consider all answers to asked questions to be I<yes>.
  40
  41 =back
  42
  43 =head1 DESCRIPTION
  44
  45 Compares disk contents with index contents and gathers files missing
  46 on local disk and files missing in local index.
  47
  48 If remoteroot is given missing files are fetched from remote.
  49
  50 Files on the local disk that have no counterpart in the index are
  51 considered obsolete and the user is asked for each file if the file
  52 should be deleted. And if the user confirms it will be deleted.
  53
  54 =head1 BUGS
  55
  56 There is a race condition when the tree or the index is manipulated
  57 while we are running. This implies that the result is only then 100%
  58 correct when disk and index are not changed while we are running.
  59
  60 There should be an option to declare the files on disk authoritative
  61 so that they are added to the index.
  62
  63 =cut
  64
  65
  66 use strict;
  67 use warnings;
  68
  69 use lib "/home/k/sources/rersyncrecent/lib";
  70
  71 use File::Basename qw(dirname);
  72 use File::Find qw(find);
  73 use ExtUtils::MakeMaker qw(prompt);
  74 use File::Rsync::Mirror::Recent;
  75 use File::Spec;
  76 use Getopt::Long;
  77 use List::Util qw(max);
  78 use Pod::Usage qw(pod2usage);
  79 use Time::HiRes qw(time sleep);
  80
  81 our %Opt;
  82 GetOptions(\%Opt,
  83            @opt,
  84           ) or pod2usage(1);
  85
  86 if ($Opt{help}) {
  87     pod2usage(0);
  88 }
  89
  90 if (@ARGV == 1) {
  91 } else {
  92     pod2usage(1);
  93 }
  94
  95 my($principal) = @ARGV;
  96 my $recc = File::Rsync::Mirror::Recent->new
  97     (
  98      local => $principal,
  99      localroot => dirname $principal,
 100     );
 101 for my $passthrough (qw(remoteroot verbose)) {
 102     if (my $opt = $Opt{$passthrough}) {
 103         $recc->$passthrough($opt);
 104     }
 105 }
 106 my $root = $recc->localroot;
 107 die "Alert: Root not defined, giving up" unless defined $root;
 108 my $prf = $recc->principal_recentfile;
 109 my $filenameroot = $prf->filenameroot;
 110 my $serializer_suffix = $prf->serializer_suffix;
 111 my $ignore_rx = qr((?x:
 112  ^ \Q$filenameroot\E (?:  - [0-9]*[smhdWMQYZ] \Q$serializer_suffix\E (?: \.lock (?: /.* )? )?  | \.recent ) \z
 113 ));
 114
 115 my %diskfiles;
 116 my $i;
 117 my $last_verbosity = 0;
 118 $|=1;
 119 if ($Opt{verbose}) {
 120     print "\n";
 121 }
 122 find({
 123       wanted => sub {
 124           my @lstat = lstat $_;
 125           return unless -l _ or -f _;
 126           my($reportname) = $File::Find::name =~ m{^\Q$root\E/*(.*)};
 127           return if $reportname =~ $ignore_rx;
 128           $i++;
 129           if ($Opt{verbose} && time - $last_verbosity > 0.166666) {
 130               printf "\r%8d files and symlinks checked on disk ", $i;
 131               $last_verbosity = time;
 132           }
 133           $diskfiles{$File::Find::name} = $lstat[9];
 134       },
 135       no_chdir => 1,
 136      },
 137      $root
 138     );
 139 if ($Opt{verbose}) {
 140     printf "\r%8d files and symlinks checked on disk\n", $i;
 141 }
 142 $i = 0;
 143
 144 if ($Opt{verbose}) {
 145     print "\rChecking index";
 146 }
 147 my @newsargs = ();
 148 if ($Opt{verbose}) {
 149     @newsargs =
 150         (callback => sub {
 151              $i = scalar @{shift;};
 152              if (time - $last_verbosity > 0.166666) {
 153                  printf "\r%8d entries read from index ", $i;
 154                  $last_verbosity = time;
 155              }
 156          });
 157 }
 158 my $indexfiles = $recc->news(@newsargs);
 159 if ($Opt{verbose}) {
 160     printf "\r%8d entries read from index\n", scalar @$indexfiles;
 161 }
 162 my %seen;
 163 my %indexfiles = map {
 164     ("$root/$_->{path}"=>$_->{epoch})
 165 } grep {
 166     defined $_->{path} &&
 167         !$seen{$_->{path}}++
 168             && $_->{type} eq "new"
 169 } @$indexfiles;
 170
 171 my @missing_rfrfiles;
 172 for my $rf (@{$recc->recentfiles}) {
 173     my $rfrfile = $rf->rfile;
 174     unless (-e $rfrfile) {
 175         push @missing_rfrfiles, $rfrfile;
 176     }
 177 }
 178 if (@missing_rfrfiles) {
 179     warn "Warning: missing index files @missing_rfrfiles\n";
 180 }
 181 if ($Opt{verbose}) {
 182     printf "\r%8d file objects found in index\n", scalar keys %indexfiles;
 183 }
 184 my $sprintfd = length(max scalar @$indexfiles, scalar keys %diskfiles);
 185 warn sprintf(
 186              "diskfiles:        %*d\n".
 187              "indexfiles:       %*d\n",
 188              $sprintfd, scalar keys %diskfiles,
 189              $sprintfd, scalar keys %indexfiles,
 190             );
 191 my @diskmisses  = sort { $indexfiles{$b} <=> $indexfiles{$a} } grep { ! exists $diskfiles{$_}  } keys %indexfiles;
 192 my @indexmisses = sort { $diskfiles{$a}  <=> $diskfiles{$b}  } grep { ! exists $indexfiles{$_} } keys %diskfiles;
 193 warn sprintf(
 194              "missing on disk:  %*d\n".
 195              "missing in index: %*d\n",
 196              $sprintfd, scalar @diskmisses,
 197              $sprintfd, scalar @indexmisses,
 198             );
 199 $DB::single++;
 200 my $rf = $recc->principal_recentfile;
 201 my $last_aggregate_call = time;
 202 my @batch;
 203 for my $dm (@diskmisses) {
 204     if (0) {
 205     } elsif ($Opt{"dry-run"}) {
 206         if ($Opt{remoteroot}) {
 207             warn "Would fetch $dm\n";
 208         } else {
 209             warn "Would remove from indexfile $dm\n";
 210         }
 211     } elsif ($Opt{remoteroot}) {
 212         my $relative = substr $dm, 1 + length $root;
 213         $rf->get_remotefile($relative);
 214     } else {
 215         warn "Removing from indexfile: $dm\n";
 216         push @batch, {path => $dm, type => "delete"};
 217     }
 218 }
 219 for my $im (@indexmisses) {
 220     if ($Opt{"dry-run"}) {
 221         if ($Opt{remoteroot}) {
 222             warn "Would remove $im\n";
 223         } else {
 224             warn "Would add to indexfile $im\n";
 225         }
 226     } elsif ($Opt{remoteroot}) {
 227         my $ans;
 228         if ($Opt{yes}) {
 229             warn "Going to unlink '$im'\n";
 230             $ans = "y";
 231         } else {
 232             $ans = prompt "Unlink '$im'?", "y";
 233         }
 234         if ($ans =~ /^y/i) {
 235             unlink $im or die "Could not unlink '$im': $!";
 236         }
 237     } else {
 238         warn "Adding to indexfile: $im\n";
 239         my @stat = lstat $im or next;
 240         push @batch, {epoch => $stat[9], path => $im, type => "new"};
 241     }
 242 }
 243 unless ($Opt{"dry-run"}) {
 244     if (@batch) {
 245         $rf->batch_update(\@batch);
 246     }
 247 }
 248
 249 __END__
 250
 251
 252 # Local Variables:
 253 # mode: cperl
 254 # coding: utf-8
 255 # cperl-indent-level: 4
 256 # End: