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 use Time::HiRes qw(sleep);
  67
  68 my @opt = $optpod =~ /B<--(\S+)>/g;
  69 our %Opt;
  70 GetOptions
  71     (
  72      \%Opt,
  73      @opt,
  74     ) or pod2usage(1);
  75
  76 pod2usage(0) if $Opt{help};
  77
  78 use FindBin;
  79 # use lib ("$FindBin::RealBin");
  80
  81 sub counting_inotify_backed_sleep ($$) {
  82     my($sleep,$inotify) = @_;
  83     my $eta = time+$sleep;
  84     local($|)=1;
  85     my $ts = POSIX::strftime "%FT%T", localtime;
  86     while () {
  87         my $left = $eta - time;
  88         last if $left < 0;
  89         my @events = $inotify->read;
  90         for my $ev (@events) {
  91             my $name = $ev->name;
  92             if ($name =~ /\.rpt/){
  93                 # printf "!!! inotify event: %s\n", File::Basename::basename($name);
  94                 print "!";
  95                 return;
  96             }
  97         }
  98         printf "\r%s sleeping %d: %d    ", $ts, $sleep, $left;
  99         sleep 1;
 100     }
 101     print "\n";
 102 }
 103
 104 my $ctr_dir = "/home/sand/var/ctr";
 105 my $sync_dir = "$ctr_dir/sync";
 106 my $inotify;
 107 if ($inotify = new Linux::Inotify2) {
 108     $inotify->blocking(0);
 109     $inotify->watch
 110         (
 111          $ctr_dir,
 112          IN_CLOSE_WRITE()
 113         );
 114 } else {
 115     warn "Unable to create new inotify object: $!";
 116 }
 117 $| = 1;
 118 while () {
 119     my $t = time;
 120     my $ttgo = $t+300;
 121     {
 122         my $dh;
 123         # 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.
 124         until (opendir $dh, $ctr_dir) {
 125             warn "Could not opendir '$ctr_dir': $!; Retrying in 117 seconds\n";
 126             sleep 117;
 127         }
 128         my $found_ctr = 0;
 129         for my $dirent (readdir $dh) {
 130             next unless $dirent =~ /\.rpt$/;
 131             my $abs = "$ctr_dir/$dirent";
 132             if ($dirent =~ /^unknown/) {
 133                 local $^T = time;
 134                 if ( -M $abs > 7 ) {
 135                     unlink $abs or die "Could not unlink '$abs': $!";
 136                 }
 137                 next;
 138             }
 139             next unless -s $abs;
 140         WF_PROBABLY_CLOSED: while () {
 141                 # wait until this file is older than 2 seconds
 142                 local $^T = time;
 143                 if (-M $abs > 3/86400) {
 144                     last WF_PROBABLY_CLOSED;
 145                 } else {
 146                     sleep 1;
 147                 }
 148             }
 149             my $abs_to = "$sync_dir/$dirent";
 150             rename $abs, $abs_to or die "Couldn't mv '$abs' '$abs_to': $!";
 151             $found_ctr = 1;
 152             print "+";
 153         }
 154         my $found_sync = 0;
 155         unless ($found_ctr) {
 156             opendir my $dh, $sync_dir or die "Could not opendir '$sync_dir': $!";
 157             for my $dirent (readdir $dh) {
 158                 next unless $dirent =~ /\.rpt$/;
 159                 my $abs = "$sync_dir/$dirent";
 160                 next unless -s $abs;
 161                 $found_sync = 1;
 162                 last;
 163             }
 164         }
 165         if ($found_ctr || $found_sync) {
 166             print "\n";
 167             my @opt="$FindBin::RealBin/send_tr_reports.pl";
 168             if (my $tu = $Opt{'transport-uri'}) {
 169                 push @opt, "--transport-uri=$tu";
 170             }
 171             unless (0 == system $^X, @opt) {
 172                 my $sleep = 0.16;
 173                 warn sprintf "ALERT: Running '%s %s' failed at %s UTC; sleeping $sleep", $^X, join(" ",@opt), scalar gmtime;
 174                 $ttgo = time; # when we have a failing submission, we must come back here to work quickier
 175                 sleep $sleep;
 176             }
 177             sleep 1;
 178         }
 179     }
 180     {
 181         my $donedir = "$ctr_dir/done";
 182         opendir my $dh, $donedir or die "Could not opendir $donedir\: $!";
 183         for my $dirent (readdir $dh) {
 184             my $abs = "$donedir/$dirent";
 185             next if -d $abs;
 186             my($todir) = $dirent =~ /(?:pass|fail|unknown|na)\.(.+?)-(?:v?\d)/;
 187             die "no todir determined on dirent[$dirent]" unless $todir;
 188             my $first_letter = substr($todir,0,1);
 189             my $todir_abs = "$donedir/archive/$first_letter/$todir";
 190             -d $todir_abs or mkpath $todir_abs or die "could not mkdir $todir_abs\: $!";
 191             rename $abs, "$todir_abs/$dirent" or die "Could not rename $abs to $todir_abs\: $!";
 192         }
 193     }
 194     my $sleep = $ttgo - time;
 195     if ($sleep >= 1 && $inotify) {
 196         counting_inotify_backed_sleep($sleep, $inotify);
 197     }
 198 }