scripts/processall

   1 #!/usr/bin/perl
   2 # processall dispatches incomming messages to process or service
   3 # and is released under the terms of the GNU GPL version 3, or any
   4 # later version, at your option. See the file README and COPYING for
   5 # more information.
   6 # Copyright 2018 by Don Armstrong <don@donarmstrong.com>.
   7
   8
   9 use warnings;
  10 use strict;
  11
  12 use Getopt::Long;
  13 use Pod::Usage;
  14 use Debbugs::Config qw(:config);
  15 use Debbugs::Common qw(:lock);
  16 use Filesys::Notify::Simple;
  17 use File::Path;
  18
  19 =head1 NAME
  20
  21 processall - dispatches incomming messages to process or service
  22
  23 =head1 SYNOPSIS
  24
  25 processall [options]
  26
  27 Options:
  28 --debug, -d debugging level (Default 0)
  29 --help, -h display this help
  30 --man, -m display manual
  31
  32 =head1 OPTIONS
  33
  34 =over
  35
  36 =item B<--debug, -d>
  37
  38 Debug verbosity. (Default 0)
  39
  40 =item B<--help, -h>
  41
  42 Display brief usage information.
  43
  44 =item B<--man, -m>
  45
  46 Display this manual.
  47
  48 =back
  49
  50 =head1 EXAMPLES
  51
  52 C<processall>
  53
  54 =cut
  55
  56 # Uses up: incoming/I<code><bugnum>.nn
  57 # Temps:   incoming/[GP].nn
  58 # Creates: incoming/E.nn
  59 # Stop:    stop
  60
  61
  62 use vars qw($DEBUG);
  63
  64 my %options = (debug           => 0,
  65                help            => 0,
  66                man             => 0,
  67               );
  68
  69 GetOptions(\%options,
  70            'debug|d+','help|h|?','man|m');
  71
  72 pod2usage() if $options{help};
  73 pod2usage({verbose=>2}) if $options{man};
  74
  75 $DEBUG = $options{debug};
  76
  77 my @USAGE_ERRORS;
  78 if (@ARGV) {
  79     push @USAGE_ERRORS,"This script takes no arguments";
  80 }
  81
  82 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
  83
  84 my $lib_path = $config{lib_path};
  85
  86 chdir( $config{spool_dir} ) or
  87     die "Unable to chdir to spool ($config{spool_dir}): $!\n";
  88
  89 if (not lockpid('processall.pid')) {
  90     print STDERR "Another processall is running";
  91     exit 1;
  92 }
  93
  94 umask(002);
  95
  96 process_new_incoming();
  97 # my $watcher = Filesys::Notify::Simple->new(['incomming']) or
  98 #     die "Unable to create new filesystem watcher";
  99 #
 100 # $watcher->
 101 #     wait(\&process_new_incoming);
 102
 103 my %fudged;
 104
 105 my $nf = 0;
 106 my $ndone = 0;
 107
 108 sub process_new_incoming {
 109     if (-f 'stop') {
 110         print(STDERR "stop file created\n") || die $!;
 111         return;
 112     }
 113     my $dir;
 114     opendir($dir,"incoming") or die $!;
 115     my @ids =
 116         map {s/^I//?$_:() } readdir($dir);
 117     closedir($dir) or
 118         die $!;
 119     stat($config{maintainer_file}) or
 120         die "Unable to stat Maintainer File '$config{maintainer_file}': $!";
 121     foreach my $id (@ids) {
 122         eval {
 123             handle_incoming_message($id) and
 124                 $ndone++;
 125         };
 126         if ($@) {
 127             die "$@";
 128         }
 129     }
 130 }
 131
 132 sub handle_incoming_message {
 133     my $id = (@_);
 134     unless (rename("incoming/I$id","incoming/G$id")) {
 135         if ($fudged{$id}) {
 136             die "$id already fudged once! $!\n";
 137         }
 138         $fudged{$id}= 1;
 139         return 0;
 140     }
 141     my $c;
 142     my $handler;
 143     if ($id =~ m/^[RC]/) {
 144         $handler = "service";
 145     } elsif ($id =~ m/^[BMQFDUL]/) {
 146         $handler = "process"
 147     } else {
 148        die "Invalid incomming ID type $id";
 149    }
 150     $nf++;
 151     print(STDOUT "[$nf] $id $handler ...") or
 152         die $!;
 153     my $exit = system("$lib_path/$handler",$id);
 154     if ($? == -1) {
 155         print STDOUT "failed to execute $lib_path/$handler: $!\n";
 156     }
 157     elsif ($? & 127) {
 158         printf STDOUT "child died with signal %d, %s coredump\n",
 159             ($? & 127), ($? & 128) ? 'with' : 'without';
 160     } else {
 161         printf STDOUT "$id: process failed (%d)\n", $? >> 8;
 162     }
 163     print(STDOUT " done\n") or die $!;
 164     rmtree("$config{spool_dir}/mime.tmp",0,1);
 165     return 1;
 166 }
 167
 168
 169 system("$lib_path/gen-indices",'--quick') == 0 or print STDERR "gen-indices failed\n";
 170
 171 if (@{$config{post_processall}//[]}) {
 172     system @{$config{post_processall}} == 0 or
 173         print STDERR "\@gPostProcessall failed: ".join(' ',@{$config{post_processall}})."\n";
 174 }
 175
 176
 177
 178 exit(0);
 179
 180
 181
 182 __END__
 183 # Local Variables:
 184 # indent-tabs-mode: nil
 185 # cperl-indent-level: 4
 186 # End: