bin/rrr-server

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 rrr-server - watch a tree and continuously update indexfiles
   6
   7 =head1 SYNOPSIS
   8
   9   rrr-server [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<--help|h>
  20
  21 Prints a brief message and exists.
  22
  23 =item B<--verbose|v+>
  24
  25 More feedback.
  26
  27 =back
  28
  29 =head1 DESCRIPTION
  30
  31 After you have setup a tree watch it with inotify and keep it
  32 uptodate. Depends on inotify which probably only exists on linux.
  33
  34 =head1 PREREQUISITE
  35
  36 Linux::Inotify2.
  37
  38 It is not declared as prerequisites of the F:R:M:Recent package
  39 because server side handling is optional. XXX Todo: make server side
  40 handling a separate package so we can declare Inotify2 as prereq.
  41
  42 =cut
  43
  44 use strict;
  45 use warnings;
  46
  47 use File::Find qw(find);
  48 use lib "/home/k/sources/rersyncrecent/lib";
  49 use File::Rsync::Mirror::Recent;
  50 use File::Spec;
  51 use Getopt::Long;
  52 use Pod::Usage qw(pod2usage);
  53 use Time::HiRes qw(time);
  54
  55 our %Opt;
  56 GetOptions(\%Opt,
  57            @opt,
  58           ) or pod2usage(1);
  59
  60 if ($Opt{help}) {
  61     pod2usage(0);
  62 }
  63
  64 if (@ARGV != 1) {
  65     pod2usage(1);
  66 }
  67
  68 my($principal) = @ARGV;
  69 my $recc = File::Rsync::Mirror::Recent->new
  70     (local => $principal);
  71 my($rf) = $recc->principal_recentfile;
  72 my $rootdir = $rf->localroot;
  73 $rootdir =~ s|/$||;
  74 for my $req (qw(Linux::Inotify2 File::Find::Rule)) {
  75     eval qq{ require $req; 1 };
  76     if ($@) {
  77         die "Failing on 'require $req': $@"
  78     } else {
  79         $req->import;
  80     }
  81 }
  82
  83 my $inotify = new Linux::Inotify2
  84     or die "Unable to create new inotify object: $!";
  85
  86 foreach my $directory ( File::Find::Rule->new->directory->in($rootdir) ) {
  87     $inotify->watch
  88         (
  89          $directory,
  90          IN_CLOSE_WRITE()
  91          |IN_MOVED_FROM()
  92          |IN_MOVED_TO()
  93          |IN_CREATE()
  94          |IN_DELETE()
  95          |IN_DELETE_SELF()
  96          |IN_MOVE_SELF()
  97         )
  98         or die "watch creation failed";
  99 }
 100
 101 sub handle_file {
 102     my($rf,$fullname,$type,$batch) = @_;
 103     push @$batch, {path => $fullname, type => $type};
 104 }
 105
 106 sub newdir {
 107     my($inotify,$rf,$fullname,$batch) = @_;
 108     $inotify->watch
 109         (
 110          $fullname,
 111          IN_CLOSE_WRITE()
 112          |IN_MOVED_FROM()
 113          |IN_MOVED_TO()
 114          |IN_CREATE()
 115          |IN_DELETE()
 116          |IN_DELETE_SELF()
 117          |IN_MOVE_SELF()
 118         )
 119             or die "watch creation failed";
 120     # immediately inspect it, we certainly have missed the first
 121     # events in this directory
 122     opendir my $dh, $fullname or return;
 123     for my $dirent (readdir $dh) {
 124         next if $dirent eq "." || $dirent eq "..";
 125         my $abs = File::Spec->catfile($fullname,$dirent);
 126         if (-l $abs || -f _) {
 127             warn "[..:..:..] Readdir_F  $abs\n";
 128             handle_file($rf,$abs,"new",$batch);
 129         } elsif (-d $abs) {
 130             warn "[..:..:..] Readdir_D  $abs\n";
 131             newdir($inotify,$rf,$abs,$batch);
 132         }
 133     }
 134 }
 135
 136 my $requires_fsck = 1;
 137 sub handle_event {
 138     my($ev,$batch) = @_;
 139     my @stringifiedmask;
 140     for my $watch (
 141                    "IN_CREATE", "IN_CLOSE_WRITE", "IN_MOVED_TO", # new
 142                    "IN_DELETE", "IN_MOVED_FROM",            # delete
 143                    "IN_DELETE_SELF", "IN_MOVE_SELF",        # self
 144                   ) {
 145         if ($ev->$watch()){
 146             push @stringifiedmask, $watch;
 147             # new directories must be added to the watches, deleted
 148             # directories deleted; moved directories both
 149         }
 150     }
 151     # warn sprintf "rootdir[$rootdir]time[%s]ev.w.name[%s]ev.name[%s]ev.fullname[%s]mask[%s]\n", time, $ev->w->name, $ev->name, $ev->fullname, join("|",@stringifiedmask);
 152     my $ignore = 0;
 153     if ($ev->w->name eq $rootdir) {
 154         my $meta = $rf->meta_data;
 155         my $ignore_rx = qr((?x: ^ \Q$meta->{filenameroot}\E - [0-9]*[smhdWMQYZ] \Q$meta->{serializer_suffix}\E ));
 156         if ($ev->name =~ $ignore_rx) {
 157             # warn sprintf "==> Ignoring object in rootdir looking like internal file: %s", $ev->name;
 158             $ignore++;
 159         }
 160     }
 161     unless ($ignore) {
 162         my $fullname = $ev->fullname;
 163         my($reportname) = $fullname =~ m{^\Q$rootdir\E/(.*)};
 164         my $time = sprintf "%02d:%02d:%02d", (localtime)[2,1,0];
 165         if (0) {
 166         } elsif ($ev->IN_Q_OVERFLOW) {
 167             $requires_fsck = 1;
 168         } elsif ($ev->IN_DELETE || $ev->IN_MOVED_FROM) {
 169             # we don't know whether it was a directory, we simply pass
 170             # it to $rf. $rf must be robust enough to swallow bogus
 171             # deletes. Alternatively we could look into $rf whether
 172             # this object is known, couldn't we?
 173             handle_file($rf,$fullname,"delete",$batch);
 174             warn "[$time] Deleteobj  $reportname (@stringifiedmask)\n";
 175         } elsif ($ev->IN_DELETE_SELF || $ev->IN_MOVE_SELF) {
 176             $ev->w->cancel;
 177             warn "[$time] Delwatcher $reportname (@stringifiedmask)\n";
 178         } elsif ($ev->IN_ISDIR) {
 179             newdir($inotify,$rf,$fullname,$batch);
 180             warn "[$time] Newwatcher $reportname (@stringifiedmask)\n";
 181         } elsif (-l $fullname) {
 182             handle_file($rf,$fullname,"new",$batch);
 183             warn "[$time] Updatelink $reportname (@stringifiedmask)\n";
 184         } elsif (-f _) {
 185             if ($ev->IN_CLOSE_WRITE || $ev->IN_MOVED_TO) {
 186                 handle_file($rf,$fullname,"new",$batch);
 187                 warn "[$time] Updatefile $reportname (@stringifiedmask)\n";
 188             }
 189         } else {
 190             warn "[$time] Ignore     $reportname (@stringifiedmask)\n";
 191         }
 192     }
 193 }
 194
 195 my $last_aggregate_call = 0;
 196 my $have_warned_fsck = 0;
 197
 198 while () {
 199     my @events = $inotify->read;
 200     unless ( @events > 0 ) {
 201         print "Alert: inotify read error: $!";
 202         last;
 203     }
 204     my @batch;
 205     foreach my $event (@events) {
 206         handle_event($event,\@batch);
 207     }
 208     $rf->batch_update(\@batch);
 209     if (time > $last_aggregate_call + 30) {
 210         $rf->aggregate;
 211         $last_aggregate_call = time;
 212     }
 213     if ($requires_fsck) {
 214         if (time > $have_warned_fsck + 3600) {
 215             warn "REMINDER: TODO: HANDLE FSCK";
 216             $have_warned_fsck = time;
 217         }
 218     }
 219 }
 220
 221 __END__
 222
 223
 224 # Local Variables:
 225 # mode: cperl
 226 # coding: utf-8
 227 # cperl-indent-level: 4
 228 # End: