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 {("$root/$_->{path}"=>$_->{epoch})} grep { !$seen{$_->{path}}++ && $_->{type} eq "new" } @$indexfiles;
 164 for my $rf (@{$recc->recentfiles}) {
 165     my $rfrfile = $rf->rfile;
 166     my @stat = stat $rfrfile or die "Could not stat '$rfrfile': $!";
 167     $indexfiles{$rfrfile} = $stat[9];
 168 }
 169 if ($Opt{verbose}) {
 170     printf "\r%8d file objects found in index\n", scalar keys %indexfiles;
 171 }
 172 my $sprintfd = length(max scalar @$indexfiles, scalar keys %diskfiles);
 173 warn sprintf(
 174              "diskfiles:        %*d\n".
 175              "indexfiles:       %*d\n",
 176              $sprintfd, scalar keys %diskfiles,
 177              $sprintfd, scalar keys %indexfiles,
 178             );
 179 my @diskmisses  = sort { $indexfiles{$b} <=> $indexfiles{$a} } grep { ! exists $diskfiles{$_}  } keys %indexfiles;
 180 my @indexmisses = sort { $diskfiles{$a}  <=> $diskfiles{$b}  } grep { ! exists $indexfiles{$_} } keys %diskfiles;
 181 warn sprintf(
 182              "missing on disk:  %*d\n".
 183              "missing in index: %*d\n",
 184              $sprintfd, scalar @diskmisses,
 185              $sprintfd, scalar @indexmisses,
 186             );
 187 $DB::single++;
 188 my $rf = $recc->principal_recentfile;
 189 my $last_aggregate_call = time;
 190 my @batch;
 191 for my $dm (@diskmisses) {
 192     if (0) {
 193     } elsif ($Opt{"dry-run"}) {
 194         if ($Opt{remoteroot}) {
 195             warn "Would fetch $dm\n";
 196         } else {
 197             warn "Would remove from indexfile $dm\n";
 198         }
 199     } elsif ($Opt{remoteroot}) {
 200         my $relative = substr $dm, 1 + length $root;
 201         $rf->get_remotefile($relative);
 202     } else {
 203         warn "Removing from indexfile: $dm\n";
 204         push @batch, {path => $dm, type => "delete"};
 205         #$rf->update($dm,"delete");
 206         #if (time > $last_aggregate_call + $rf->interval_secs) {
 207         #    warn "Aggregating\n";
 208         #    $rf->aggregate;
 209         #    $last_aggregate_call = time;
 210         #}
 211     }
 212 }
 213 for my $im (@indexmisses) {
 214     if ($Opt{"dry-run"}) {
 215         if ($Opt{remoteroot}) {
 216             warn "Would remove $im\n";
 217         } else {
 218             warn "Would add to indexfile $im\n";
 219         }
 220     } elsif ($Opt{remoteroot}) {
 221         my $ans;
 222         if ($Opt{yes}) {
 223             warn "Going to unlink '$im'\n";
 224             $ans = "y";
 225         } else {
 226             $ans = prompt "Unlink '$im'?", "y";
 227         }
 228         if ($ans =~ /^y/i) {
 229             unlink $im or die "Could not unlink '$im': $!";
 230         }
 231     } else {
 232         warn "Adding to indexfile: $im\n";
 233         my @stat = stat $im or next;
 234         push @batch, {epoch => $stat[9], path => $im, type => "new"};
 235         #$rf->update($im,"new");
 236         #if (time > $last_aggregate_call + $rf->interval_secs) {
 237         #    warn "Aggregating\n";
 238         #    $rf->aggregate;
 239         #    $last_aggregate_call = time;
 240         #}
 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: