bin/cleanout-ctr-loop.pl

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 ....pl -
   6
   7 =head1 SYNOPSIS
   8
   9
  10
  11 =head1 OPTIONS
  12
  13 =over 8
  14
  15 =cut
  16
  17
  18 my $optpod = <<'=back';
  19
  20 =item B<--help|h!>
  21
  22 This help
  23
  24 =item B<--transport-uri=s>
  25
  26 URI of the Metabase API, passed through to send_tr_reports.pl.
  27
  28 =back
  29
  30 =head1 DESCRIPTION
  31
  32 ~/var/ctr/ contains the three subdirs C<./process/> and C<./sync/> and
  33 C<./done/>.
  34
  35 The move from the sync/ directory via the process/ directory to the
  36 done/ directory is done by the send_tr_reports.pl script which we call
  37 in the middle of our loop. If a file is later found in the process
  38 directory, then we probably want to move it back to the ctr/ and watch
  39 what happens.
  40
  41 Before that, this script here moves the candidates to be sent from the
  42 ctr directory into the sync directory.
  43
  44 We use both sleep and inotify. From time to time we read the directory
  45 anyway, but when inotify gets a CLOSE_WRITE event, then we do it
  46 immediately. So if only one computer writes to the directory, we
  47 rarely find two rpt files at once, most of the time only one and we
  48 send it off as soon as it is 3 seconds old. If another computer writes
  49 to the directory, inotify won't notice, and then we come at the usual
  50 interval.
  51
  52 =head1 TODO
  53
  54
  55 =head1 AUTHOR
  56
  57 =cut
  58
  59 use strict;
  60 use Getopt::Long;
  61 use File::Basename ();
  62 use File::Path qw(mkpath);
  63 use Pod::Usage qw(pod2usage);
  64 use POSIX ();
  65 use Linux::Inotify2;
  66
  67 my @opt = $optpod =~ /B<--(\S+)>/g;
  68 our %Opt;
  69 GetOptions
  70     (
  71      \%Opt,
  72      @opt,
  73     ) or pod2usage(1);
  74
  75 pod2usage(0) if $Opt{help};
  76
  77 use FindBin;
  78 # use lib ("$FindBin::RealBin");
  79
  80 sub counting_inotify_backed_sleep ($$) {
  81     my($sleep,$inotify) = @_;
  82     my $eta = time+$sleep;
  83     local($|)=1;
  84     my $ts = POSIX::strftime "%FT%T", localtime;
  85     while () {
  86         my $left = $eta - time;
  87         last if $left < 0;
  88         my @events = $inotify->read;
  89         for my $ev (@events) {
  90             my $name = $ev->name;
  91             if ($name =~ /\.rpt/){
  92                 # printf "!!! inotify event: %s\n", File::Basename::basename($name);
  93                 print "!";
  94                 return;
  95             }
  96         }
  97         printf "\r%s sleeping %d: %d    ", $ts, $sleep, $left;
  98         sleep 1;
  99     }
 100     print "\n";
 101 }
 102
 103 my $ctr_dir = "/home/sand/var/ctr";
 104 my $sync_dir = "$ctr_dir/sync";
 105 my $inotify;
 106 if ($inotify = new Linux::Inotify2) {
 107     $inotify->blocking(0);
 108     $inotify->watch
 109         (
 110          $ctr_dir,
 111          IN_CLOSE_WRITE()
 112         );
 113 } else {
 114     warn "Unable to create new inotify object: $!";
 115 }
 116 $| = 1;
 117 while () {
 118     my $t = time;
 119     my $ttgo = $t+300;
 120     {
 121         my $dh;
 122         # Could not opendir '/home/sand/var/ctr': Stale file handle at /home/sand/src/andk/andk-cpan-tools/bin/cleanout-ctr-loop.pl line 114.
 123         until (opendir $dh, $ctr_dir) {
 124             warn "Could not opendir '$ctr_dir': $!; Retrying in 117 seconds\n";
 125             sleep 117;
 126         }
 127         my $found_ctr = 0;
 128         for my $dirent (readdir $dh) {
 129             next unless $dirent =~ /\.rpt$/;
 130             my $abs = "$ctr_dir/$dirent";
 131             if ($dirent =~ /^unknown/) {
 132                 local $^T = time;
 133                 if ( -M $abs > 7 ) {
 134                     unlink $abs or die "Could not unlink '$abs': $!";
 135                 }
 136                 next;
 137             }
 138             next unless -s $abs;
 139         WF_PROBABLY_CLOSED: while () {
 140                 # wait until this file is older than 2 seconds
 141                 local $^T = time;
 142                 if (-M $abs > 3/86400) {
 143                     last WF_PROBABLY_CLOSED;
 144                 } else {
 145                     sleep 1;
 146                 }
 147             }
 148             my $abs_to = "$sync_dir/$dirent";
 149             rename $abs, $abs_to or die "Couldn't mv '$abs' '$abs_to': $!";
 150             $found_ctr = 1;
 151             print "+";
 152         }
 153         my $found_sync = 0;
 154         unless ($found_ctr) {
 155             opendir my $dh, $sync_dir or die "Could not opendir '$sync_dir': $!";
 156             for my $dirent (readdir $dh) {
 157                 next unless $dirent =~ /\.rpt$/;
 158                 my $abs = "$sync_dir/$dirent";
 159                 next unless -s $abs;
 160                 $found_sync = 1;
 161                 last;
 162             }
 163         }
 164         if ($found_ctr || $found_sync) {
 165             print "\n";
 166             my @opt="$FindBin::RealBin/send_tr_reports.pl";
 167             if (my $tu = $Opt{'transport-uri'}) {
 168                 push @opt, "--transport-uri=$tu";
 169             }
 170             unless (0 == system $^X, @opt) {
 171                 warn sprintf "ALERT: Running '%s %s' failed at %s UTC; sleeping 30", $^X, join(" ",@opt), scalar gmtime;
 172                 sleep 30;
 173             }
 174             sleep 1;
 175         }
 176     }
 177     {
 178         my $donedir = "$ctr_dir/done";
 179         opendir my $dh, $donedir or die "Could not opendir $donedir\: $!";
 180         for my $dirent (readdir $dh) {
 181             my $abs = "$donedir/$dirent";
 182             next if -d $abs;
 183             my($todir) = $dirent =~ /(?:pass|fail|unknown|na)\.(.+?)-(?:v?\d)/;
 184             die "no todir determined on dirent[$dirent]" unless $todir;
 185             my $first_letter = substr($todir,0,1);
 186             my $todir_abs = "$donedir/archive/$first_letter/$todir";
 187             -d $todir_abs or mkpath $todir_abs or die "could not mkdir $todir_abs\: $!";
 188             rename $abs, "$todir_abs/$dirent" or die "Could not rename $abs to $todir_abs\: $!";
 189         }
 190     }
 191     my $sleep = $ttgo - time;
 192     if ($sleep >= 1 && $inotify) {
 193         counting_inotify_backed_sleep($sleep, $inotify);
 194     }
 195 }