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
 109 my %diskfiles;
 110 my $i;
 111 my $last_verbosity = 0;
 112 $|=1;
 113 if ($Opt{verbose}) {
 114     print "\n";
 115 }
 116 find({
 117       wanted => sub {
 118           my @lstat = lstat $_;
 119           return unless -l _ or -f _;
 120           $i++;
 121           if ($Opt{verbose} && time - $last_verbosity > 0.166666) {
 122               printf "\r%8d files and symlinks checked on disk ", $i;
 123               $last_verbosity = time;
 124           }
 125           $diskfiles{$File::Find::name} = $lstat[9];
 126       },
 127       no_chdir => 1,
 128      },
 129      $root
 130     );
 131 if ($Opt{verbose}) {
 132     printf "\r%8d files and symlinks checked on disk\n", $i;
 133 }
 134 $i = 0;
 135
 136 if ($Opt{verbose}) {
 137     print "\rChecking index";
 138 }
 139 my @newsargs = ();
 140 if ($Opt{verbose}) {
 141     @newsargs =
 142         (callback => sub {
 143              $i = scalar @{shift;};
 144              if (time - $last_verbosity > 0.166666) {
 145                  printf "\r%8d entries read from index ", $i;
 146                  $last_verbosity = time;
 147              }
 148          });
 149 }
 150 my $indexfiles = $recc->news(@newsargs);
 151 if ($Opt{verbose}) {
 152     printf "\r%8d entries read from index\n", scalar @$indexfiles;
 153 }
 154 my %seen;
 155 my %indexfiles = map {("$root/$_->{path}"=>$_->{epoch})} grep { !$seen{$_->{path}}++ && $_->{type} eq "new" } @$indexfiles;
 156 for my $rf (@{$recc->recentfiles}) {
 157     my $rfrfile = $rf->rfile;
 158     my @stat = stat $rfrfile or die "Could not stat '$rfrfile': $!";
 159     $indexfiles{$rfrfile} = $stat[9];
 160 }
 161 if ($Opt{verbose}) {
 162     printf "\r%8d file objects found in index\n", scalar keys %indexfiles;
 163 }
 164 my $sprintfd = length(max scalar @$indexfiles, scalar keys %diskfiles);
 165 warn sprintf(
 166              "diskfiles:        %*d\n".
 167              "indexfiles:       %*d\n",
 168              $sprintfd, scalar keys %diskfiles,
 169              $sprintfd, scalar keys %indexfiles,
 170             );
 171 my @diskmisses  = sort { $indexfiles{$b} <=> $indexfiles{$a} } grep { ! exists $diskfiles{$_}  } keys %indexfiles;
 172 my @indexmisses = sort { $diskfiles{$a}  <=> $diskfiles{$b}  } grep { ! exists $indexfiles{$_} } keys %diskfiles;
 173 warn sprintf(
 174              "missing on disk:  %*d\n".
 175              "missing in index: %*d\n",
 176              $sprintfd, scalar @diskmisses,
 177              $sprintfd, scalar @indexmisses,
 178             );
 179 $DB::single++;
 180 my $rf = $recc->principal_recentfile;
 181 my $last_aggregate_call = time;
 182 my @batch;
 183 for my $dm (@diskmisses) {
 184     if (0) {
 185     } elsif ($Opt{"dry-run"}) {
 186         if ($Opt{remoteroot}) {
 187             warn "Would fetch $dm\n";
 188         } else {
 189             warn "Would remove from indexfile $dm\n";
 190         }
 191     } elsif ($Opt{remoteroot}) {
 192         my $relative = substr $dm, 1 + length $root;
 193         $rf->get_remotefile($relative);
 194     } else {
 195         warn "Removing from indexfile: $dm\n";
 196         push @batch, {path => $dm, type => "delete"};
 197         #$rf->update($dm,"delete");
 198         #if (time > $last_aggregate_call + $rf->interval_secs) {
 199         #    warn "Aggregating\n";
 200         #    $rf->aggregate;
 201         #    $last_aggregate_call = time;
 202         #}
 203     }
 204 }
 205 for my $im (@indexmisses) {
 206     if ($Opt{"dry-run"}) {
 207         if ($Opt{remoteroot}) {
 208             warn "Would remove $im\n";
 209         } else {
 210             warn "Would add to indexfile $im\n";
 211         }
 212     } elsif ($Opt{remoteroot}) {
 213         my $ans;
 214         if ($Opt{yes}) {
 215             warn "Going to unlink '$im'\n";
 216             $ans = "y";
 217         } else {
 218             $ans = prompt "Unlink '$im'?", "y";
 219         }
 220         if ($ans =~ /^y/i) {
 221             unlink $im or die "Could not unlink '$im': $!";
 222         }
 223     } else {
 224         warn "Adding to indexfile: $im\n";
 225         my @stat = stat $im or next;
 226         push @batch, {epoch => $stat[9], path => $im, type => "new"};
 227         #$rf->update($im,"new");
 228         #if (time > $last_aggregate_call + $rf->interval_secs) {
 229         #    warn "Aggregating\n";
 230         #    $rf->aggregate;
 231         #    $last_aggregate_call = time;
 232         #}
 233     }
 234 }
 235 unless ($Opt{"dry-run"}) {
 236     if (@batch) {
 237         $rf->batch_update(\@batch);
 238     }
 239 }
 240
 241 __END__
 242
 243
 244 # Local Variables:
 245 # mode: cperl
 246 # coding: utf-8
 247 # cperl-indent-level: 4
 248 # End: