bin/rrr-fsck

   1 #!/usr/bin/perl -- -*- mode: cperl -*-
   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
  80 our %Opt;
  81 GetOptions(\%Opt,
  82            @opt,
  83           ) or pod2usage(1);
  84
  85 if ($Opt{help}) {
  86     pod2usage(0);
  87 }
  88
  89 if (@ARGV == 1) {
  90 } else {
  91     pod2usage(1);
  92 }
  93
  94 my($principal) = @ARGV;
  95 my $recc = File::Rsync::Mirror::Recent->new
  96     (
  97      local => $principal,
  98      localroot => dirname $principal,
  99     );
 100 for my $passthrough (qw(remoteroot verbose)) {
 101     if (my $opt = $Opt{$passthrough}) {
 102         $recc->$passthrough($opt);
 103     }
 104 }
 105 my $root = $recc->localroot;
 106 die "Alert: Root not defined, giving up" unless defined $root;
 107
 108 my %diskfiles;
 109 find({
 110       wanted => sub {
 111           my @stat = lstat $_;
 112           return if -l _;
 113           return unless -f _;
 114           $diskfiles{$File::Find::name} = $stat[9];
 115       },
 116       no_chdir => 1,
 117      },
 118      $root
 119     );
 120
 121 my $indexfiles = $recc->news;
 122 my %seen;
 123 my %indexfiles = map {("$root/$_->{path}"=>$_->{epoch})} grep { !$seen{$_->{path}}++ && $_->{type} eq "new" } @$indexfiles;
 124 for my $rf (@{$recc->recentfiles}) {
 125     my $rfrfile = $rf->rfile;
 126     my @stat = stat $rfrfile or die "Could not stat '$rfrfile': $!";
 127     $indexfiles{$rfrfile} = $stat[9];
 128 }
 129 my $sprintfd = length(max scalar @$indexfiles, scalar keys %diskfiles);
 130 warn sprintf(
 131              "diskfiles:    %*d\n".
 132              "indexfiles:   %*d\n",
 133              $sprintfd, scalar keys %diskfiles,
 134              $sprintfd, scalar keys %indexfiles,
 135             );
 136 my @diskmisses  = sort { $indexfiles{$b} <=> $indexfiles{$a} } grep { ! exists $diskfiles{$_}  } keys %indexfiles;
 137 my @indexmisses = sort { $diskfiles{$a}  <=> $diskfiles{$b}  } grep { ! exists $indexfiles{$_} } keys %diskfiles;
 138 warn sprintf(
 139              "not on disk:  %*d\n".
 140              "not in index: %*d\n",
 141              $sprintfd, scalar @diskmisses,
 142              $sprintfd, scalar @indexmisses,
 143             );
 144 $DB::single++;
 145 for my $dm (@diskmisses) {
 146     if ($Opt{"dry-run"}) {
 147         warn "Would fetch $dm\n";
 148     } elsif ($Opt{remoteroot}) {
 149         my $relative = substr $dm, 1 + length $root;
 150         $recc->principal_recentfile->get_remotefile($relative);
 151     } else {
 152         warn "Missing on disk: $dm\n";
 153     }
 154 }
 155 for my $im (@indexmisses) {
 156     if ($Opt{"dry-run"}) {
 157         warn "Would remove $im\n";
 158     } else {
 159         my $ans;
 160         if ($Opt{yes}) {
 161             warn "Going to unlink '$im'\n";
 162             $ans = "y";
 163         } else {
 164             $ans = prompt "Unlink '$im'?", "y";
 165         }
 166         if ($ans =~ /^y/i) {
 167             unlink $im or die "Could not unlink '$im': $!";
 168         }
 169     }
 170 }
 171 __END__
 172
 173
 174 # Local Variables:
 175 # mode: cperl
 176 # coding: utf-8
 177 # cperl-indent-level: 4
 178 # End: