tools/debianqueued-0.9/dqueued-watcher

   1 #!/usr/bin/perl -w
   2 #
   3 # dqueued-watcher -- for regularily watching the queue daemon
   4 #
   5 # This script is intended to check periodically (e.g. started by cron) that
   6 # everything is ok with debianqueued. If the daemon isn't running, it notifies
   7 # the maintainer. It also checks if a new Debian keyring is available (in a
   8 # Debian mirror aera, f.i.) and then updates the keyring used by debianqueued.
   9 #
  10 # Copyright (C) 1997 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
  11 #
  12 # This program is free software.  You can redistribute it and/or
  13 # modify it under the terms of the GNU General Public License as
  14 # published by the Free Software Foundation: either version 2 or
  15 # (at your option) any later version.
  16 # This program comes with ABSOLUTELY NO WARRANTY!
  17 #
  18 # $Id: dqueued-watcher,v 1.28 1999/07/08 09:43:22 ftplinux Exp $
  19 #
  20 # $Log: dqueued-watcher,v $
  21 # Revision 1.28  1999/07/08 09:43:22  ftplinux
  22 # Bumped release number to 0.9
  23 #
  24 # Revision 1.27  1999/07/07 11:58:22  ftplinux
  25 # Also update gpg keyring if $conf::gpg_keyring is set.
  26 #
  27 # Revision 1.26  1998/07/06 14:24:36  ftplinux
  28 # Some changes to handle debian-keyring.tar.gz files which expand to a
  29 # directory including a date.
  30 #
  31 # Revision 1.25  1998/05/14 14:21:45  ftplinux
  32 # Bumped release number to 0.8
  33 #
  34 # Revision 1.24  1998/03/30 12:31:05  ftplinux
  35 # Don't count "already reported" or "ignored for now" errors as .changes errors.
  36 # Also list files for several error types.
  37 # Also print out names of processed jobs.
  38 #
  39 # Revision 1.23  1998/03/30 11:27:37  ftplinux
  40 # If called with args, make summaries for the log files given.
  41 # make_summary: New arg $to_stdout, for printing report directly.
  42 #
  43 # Revision 1.22  1998/03/23 14:05:15  ftplinux
  44 # Bumped release number to 0.7
  45 #
  46 # Revision 1.21  1997/12/16 13:19:29  ftplinux
  47 # Bumped release number to 0.6
  48 #
  49 # Revision 1.20  1997/11/20 15:18:48  ftplinux
  50 # Bumped release number to 0.5
  51 #
  52 # Revision 1.19  1997/10/31 12:26:31  ftplinux
  53 # Again added new counters in make_summary: suspicious_files,
  54 # transient_changes_errs.
  55 # Extended tests for bad_changes.
  56 # Quotes in pattern seem not to work, replaced by '.'.
  57 #
  58 # Revision 1.18  1997/10/30 14:17:32  ftplinux
  59 # In make_summary, implemented some new counters for command files.
  60 #
  61 # Revision 1.17  1997/10/17 09:39:09  ftplinux
  62 # Fixed wrong args to plural_s
  63 #
  64 # Revision 1.16  1997/09/25 11:20:42  ftplinux
  65 # Bumped release number to 0.4
  66 #
  67 # Revision 1.15  1997/09/17 12:16:33  ftplinux
  68 # Added writing summaries to a file
  69 #
  70 # Revision 1.14  1997/09/16 11:39:29  ftplinux
  71 # In make_summary, initialize all counters to avoid warnings about uninited
  72 # values.
  73 #
  74 # Revision 1.13  1997/09/16 10:53:36  ftplinux
  75 # Made logging more verbose in queued and dqueued-watcher
  76 #
  77 # Revision 1.12  1997/08/18 13:07:15  ftplinux
  78 # Implemented summary mails
  79 #
  80 # Revision 1.11  1997/08/18 12:11:44  ftplinux
  81 # Replaced timegm by timelocal in parse_date; times in log file are
  82 # local times...
  83 #
  84 # Revision 1.10  1997/08/18 11:27:20  ftplinux
  85 # Revised age calculation of log file for rotating
  86 #
  87 # Revision 1.9  1997/08/12 09:54:40  ftplinux
  88 # Bumped release number
  89 #
  90 # Revision 1.8  1997/08/11 12:49:10  ftplinux
  91 # Implemented logfile rotating
  92 #
  93 # Revision 1.7  1997/07/28 13:20:38  ftplinux
  94 # Added release numner to startup message
  95 #
  96 # Revision 1.6  1997/07/25 10:23:04  ftplinux
  97 # Made SIGCHLD handling more portable between perl versions
  98 #
  99 # Revision 1.5  1997/07/09 10:13:55  ftplinux
 100 # Alternative implementation of status file as plain file (not FIFO), because
 101 # standard wu-ftpd doesn't allow retrieval of non-regular files. New config
 102 # option $statusdelay for this.
 103 #
 104 # Revision 1.4  1997/07/08 08:39:56  ftplinux
 105 # Need to remove -z from tar options if --use-compress-program
 106 #
 107 # Revision 1.3  1997/07/08 08:34:15  ftplinux
 108 # If dqueued-watcher runs as cron job, $PATH might not contain gzip. Use extra
 109 # --use-compress-program option to tar, and new config var $gzip.
 110 #
 111 # Revision 1.2  1997/07/03 13:05:57  ftplinux
 112 # Added some verbosity if stdin is a terminal
 113 #
 114 # Revision 1.1.1.1  1997/07/03 12:54:59  ftplinux
 115 # Import initial sources
 116 #
 117 #
 118
 119 require 5.002;
 120 use strict;
 121 use POSIX;
 122 require "timelocal.pl";
 123
 124 sub LINEWIDTH { 79 }
 125 my $batchmode = !(-t STDIN);
 126 $main::curr_year = (localtime)[5];
 127
 128 do {
 129         my $version;
 130         ($version = 'Release: 0.9 $Revision: 1.28 $ $Date: 1999/07/08 09:43:22 $ $Author: ftplinux $') =~ s/\$ ?//g;
 131         print "dqueued-watcher $version\n" if !$batchmode;
 132 };
 133
 134 package conf;
 135 ($conf::queued_dir = (($0 !~ m,^/,) ? POSIX::getcwd()."/" : "") . $0)
 136         =~ s,/[^/]+$,,;
 137 require "$conf::queued_dir/config";
 138 my # avoid spurious warnings about unused vars
 139 $junk = $conf::gzip;
 140 $junk = $conf::maintainer_mail;
 141 $junk = $conf::log_age;
 142 package main;
 143
 144 # prototypes
 145 sub check_daemon();
 146 sub daemon_running();
 147 sub rotate_log();
 148 sub logf($);
 149 sub parse_date($);
 150 sub make_summary($$$);
 151 sub stimes($);
 152 sub plural_s($);
 153 sub format_list($@);
 154 sub mail($@);
 155 sub logger(@);
 156 sub format_time();
 157
 158 # the main program:
 159 if (@ARGV) {
 160         # with arguments, make summaries (to stdout) for the logfiles given
 161         foreach (@ARGV) {
 162                 make_summary( 1, undef, $_ );
 163         }
 164 }
 165 else {
 166         # without args, just do normal maintainance actions
 167         check_daemon();
 168         rotate_log();
 169 }
 170 exit 0;
 171
 172
 173 #
 174 # check if the daemon is running, notify maintainer if not
 175 #
 176 sub check_daemon() {
 177         my $daemon_down_text = "Daemon is not running\n";
 178         my( $line, $reported );
 179
 180         if (daemon_running()) {
 181                 print "Daemon is running\n" if !$batchmode;
 182                 return;
 183         }
 184         print "Daemon is NOT running!\n" if !$batchmode;
 185
 186         $reported = 0;
 187         if ($conf::statusfile && -f $conf::statusfile && ! -p _ &&
 188                 open( STATUSFILE, "<$conf::statusfile" )) {
 189                 $line = <STATUSFILE>;
 190                 close( STATUSFILE );
 191                 $reported = $line eq $daemon_down_text;
 192         }
 193         if (!$reported) {
 194                 mail( "debianqueued down",
 195                           "The Debian queue daemon isn't running!\n",
 196                           "Please start it up again.\n" );
 197                 logger( "Found that daemon is not running\n" );
 198         }
 199
 200         # remove unnecessary pid file
 201         # also remove status FIFO, so opening it for reading won't block
 202         # forever
 203         unlink( $conf::pidfile, $conf::statusfile );
 204
 205         # replace status FIFO by a file that tells the user the daemon is down
 206         if ($conf::statusfile) {
 207                 open( STATUSFILE, ">$conf::statusfile" )
 208                         or die "Can't open $conf::statusfile: $!\n";
 209                 print STATUSFILE $daemon_down_text;
 210                 close( STATUSFILE );
 211         }
 212 }
 213
 214 #
 215 # check if daemon is running
 216 #
 217 sub daemon_running() {
 218         my $pid;
 219         local( *PIDFILE );
 220
 221         if (open( PIDFILE, "<$conf::pidfile" )) {
 222                 chomp( $pid = <PIDFILE> );
 223                 close( PIDFILE );
 224                 $main::daemon_pid = $pid, return 1 if $pid && kill( 0, $pid );
 225         }
 226         return 0;
 227 }
 228
 229 #
 230 # check if new keyring is available, if yes extract it
 231 #
 232
 233 sub rotate_log() {
 234         my( $first_date, $f1, $f2, $i );
 235         local( *F );
 236
 237         return if !defined $main::daemon_pid || !-f $conf::logfile;
 238
 239         open( F, "<$conf::logfile" ) or die "Can't open $conf::logfile: $!\n";
 240         while( <F> ) {
 241                 last if $first_date = parse_date( $_ );
 242         }
 243         close( F );
 244         # Simply don't rotate if nothing couldn't be parsed as date -- probably
 245         # the file is empty.
 246         return if !$first_date;
 247         # assume year-wrap if $first_date is in the future
 248         $first_date -= 365*24*60*60 if $first_date > time;
 249         # don't rotate if first date too young
 250         return if time - $first_date < $conf::log_age*24*60*60;
 251         logger( "Logfile older than $conf::log_age days, rotating\n" );
 252
 253         # remove oldest log
 254         $f1 = logf($conf::log_keep-1);
 255         if (-f $f1) {
 256                 unlink( $f1 ) or warn "Can't remove $f1: $!\n";
 257         }
 258
 259         # rename other logs
 260         for( $i = $conf::log_keep-2; $i > 0; --$i ) {
 261                 $f1 = logf($i);
 262                 $f2 = logf($i+1);
 263                 if ($i == 0) {
 264                 }
 265                 if (-f $f1) {
 266                         rename( $f1, $f2 ) or warn "Can't rename $f1 to $f2: $!\n";
 267                 }
 268         }
 269
 270         # compress newest log
 271         $f1 = "$conf::logfile.0";
 272         $f2 = "$conf::logfile.1.gz";
 273         if (-f $f1) {
 274                 system $conf::gzip, "-9f", $f1
 275                         and die "gzip failed on $f1 (status $?)\n";
 276                 rename( "$f1.gz", $f2 ) or warn "Can't rename $f1.gz to $f2: $!\n";
 277         }
 278
 279         # rename current log and signal the daemon to open a new logfile
 280         rename( $conf::logfile, $f1 );
 281         kill( 1, $main::daemon_pid );
 282
 283         print "Rotated log files\n" if !$batchmode;
 284         make_summary( 0, $first_date, $f1 )
 285                 if $conf::mail_summary || $conf::summary_file;
 286 }
 287
 288 sub logf($) {
 289         my $num = shift;
 290         return sprintf( "$conf::logfile.%d.gz", $num );
 291 }
 292
 293 sub parse_date($) {
 294         my $date = shift;
 295         my( $mon, $day, $hours, $mins, $month, $year, $secs );
 296         my %month_num = ( "jan", 0, "feb", 1, "mar", 2, "apr", 3, "may", 4,
 297                                           "jun", 5, "jul", 6, "aug", 7, "sep", 8, "oct", 9,
 298                                           "nov", 10, "dec", 11 );
 299
 300         warn "Invalid date: $date\n", return 0
 301                 unless $date =~ /^(\w\w\w)\s+(\d+)\s+(\d+):(\d+):(\d+)\s/;
 302         ($mon, $day, $hours, $mins, $secs) = ($1, $2, $3, $4, $5);
 303
 304         $mon =~ tr/A-Z/a-z/;
 305         return 0 if !exists $month_num{$mon};
 306         $month = $month_num{$mon};
 307         return timelocal( $secs, $mins, $hours, $day, $month, $main::curr_year );
 308 }
 309
 310 sub make_summary($$$) {
 311         my $to_stdout = shift;
 312         my $startdate = shift;
 313         my $file = shift;
 314         my( $starts, $statusd_starts, $suspicious_files, $transient_errs,
 315             $upl_failed, $success, $commands, $rm_cmds, $mv_cmds, $msg,
 316             $uploader );
 317         my( @pgp_fail, %transient_errs, @changes_errs, @removed_changes,
 318             @already_present, @del_stray, %uploaders, %cmd_uploaders );
 319         local( *F );
 320
 321         if (!open( F, "<$file" )) {
 322                 mail( "debianqueued summary failed",
 323                           "Couldn't open $file to make summary of events." );
 324                 return;
 325         }
 326
 327         $starts = $statusd_starts = $suspicious_files = $transient_errs =
 328                 $upl_failed = $success = $commands = $rm_cmds = $mv_cmds = 0;
 329         while( <F> ) {
 330                 $startdate = parse_date( $_ ) if !$startdate;
 331                 ++$starts if /daemon \(pid \d+\) started$/;
 332                 ++$statusd_starts if /forked status daemon/;
 333                 push( @pgp_fail, $1 )
 334                         if /PGP signature check failed on (\S+)/;
 335                 ++$suspicious_files if /found suspicious filename/;
 336                 ++$transient_errs, ++$transient_errs{$1}
 337                         if /(\S+) (doesn.t exist|is too small) \(ignored for now\)/;
 338                 push( @changes_errs, $1 )
 339                         if (!/\((already reported|ignored for now)\)/ &&
 340                                 (/(\S+) doesn.t exist/ || /(\S+) has incorrect (size|md5)/)) ||
 341                            /(\S+) doesn.t contain a Maintainer: field/ ||
 342                            /(\S+) isn.t signed with PGP/ ||
 343                            /(\S+) doesn.t mention any files/;
 344                 push( @removed_changes, $1 )
 345                         if /(\S+) couldn.t be processed for \d+ hours and is now del/ ||
 346                            /(\S+) couldn.t be uploaded for \d+ times/;
 347                 push( @already_present, $1 )
 348                         if /(\S+) is already present on master/;
 349                 ++$upl_failed if /Upload to \S+ failed/;
 350                 ++$success, push( @{$uploaders{$2}}, $1 )
 351                         if /(\S+) processed successfully \(uploader (\S*)\)$/;
 352                 push( @del_stray, $1 ) if /Deleted stray file (\S+)/;
 353                 ++$commands if /processing .*\.commands$/;
 354                 ++$rm_cmds if / > rm /;
 355                 ++$mv_cmds if / > mv /;
 356                 ++$cmd_uploaders{$1}
 357                         if /\(command uploader (\S*)\)$/;
 358         }
 359         close( F );
 360
 361         $msg .= "Queue Daemon Summary from " . localtime($startdate) . " to " .
 362                     localtime(time) . ":\n\n";
 363
 364         $msg .= "Daemon started ".stimes($starts)."\n"
 365                 if $starts;
 366         $msg .= "Status daemon restarted ".stimes($statusd_starts-$starts)."\n"
 367                 if $statusd_starts > $starts;
 368         $msg .= @pgp_fail." job".plural_s(@pgp_fail)." failed PGP check:\n" .
 369                     format_list(2,@pgp_fail)
 370                 if @pgp_fail;
 371         $msg .= "$suspicious_files file".plural_s($suspicious_files)." with ".
 372                         "suspicious names found\n"
 373                 if $suspicious_files;
 374         $msg .= "Detected ".$transient_errs." transient error".
 375                         plural_s($transient_errs)." in .changes files:\n".
 376                         format_list(2,keys %transient_errs)
 377                 if $transient_errs;
 378         $msg .= "Detected ".@changes_errs." error".plural_s(@changes_errs).
 379                     " in .changes files:\n".format_list(2,@changes_errs)
 380                 if @changes_errs;
 381         $msg .= @removed_changes." job".plural_s(@removed_changes).
 382                     " removed due to persistent errors:\n".
 383                         format_list(2,@removed_changes)
 384                 if @removed_changes;
 385         $msg .= @already_present." job".plural_s(@already_present).
 386                         " were already present on master:\n".format_list(2,@already_present)
 387                 if @already_present;
 388         $msg .= @del_stray." stray file".plural_s(@del_stray)." deleted:\n".
 389                         format_list(2,@del_stray)
 390                 if @del_stray;
 391         $msg .= "$commands command file".plural_s($commands)." processed\n"
 392                 if $commands;
 393         $msg .= "  ($rm_cmds rm, $mv_cmds mv commands)\n"
 394                 if $rm_cmds || $mv_cmds;
 395         $msg .= "$success job".plural_s($success)." processed successfully\n";
 396
 397         if ($success) {
 398                 $msg .= "\nPeople who used the queue:\n";
 399                 foreach $uploader ( keys %uploaders ) {
 400                         $msg .= "  $uploader (".@{$uploaders{$uploader}}."):\n".
 401                                         format_list(4,@{$uploaders{$uploader}});
 402                 }
 403         }
 404
 405         if (%cmd_uploaders) {
 406                 $msg .= "\nPeople who used command files:\n";
 407                 foreach $uploader ( keys %cmd_uploaders ) {
 408                         $msg .= "  $uploader ($cmd_uploaders{$uploader})\n";
 409                 }
 410         }
 411
 412         if ($to_stdout) {
 413                 print $msg;
 414         }
 415         else {
 416                 if ($conf::mail_summary) {
 417                         mail( "debianqueued summary", $msg );
 418                 }
 419
 420                 if ($conf::summary_file) {
 421                         local( *F );
 422                         open( F, ">>$conf::summary_file" ) or
 423                                 die "Cannot open $conf::summary_file for appending: $!\n";
 424                         print F "\n", "-"x78, "\n", $msg;
 425                         close( F );
 426                 }
 427         }
 428 }
 429
 430 sub stimes($) {
 431         my $num = shift;
 432         return $num == 1 ? "once" : "$num times";
 433 }
 434
 435 sub plural_s($) {
 436         my $num = shift;
 437         return $num == 1 ? "" : "s";
 438 }
 439
 440 sub format_list($@) {
 441         my $indent = shift;
 442         my( $i, $pos, $ret, $item, $len );
 443
 444         $ret = " " x $indent; $pos += $indent;
 445         while( $item = shift ) {
 446                 $len = length($item);
 447                 $item .= ", ", $len += 2 if @_;
 448                 if ($pos+$len > LINEWIDTH) {
 449                         $ret .= "\n" . " "x$indent;
 450                         $pos = $indent;
 451                 }
 452                 $ret .= $item;
 453                 $pos += $len;
 454         }
 455         $ret .= "\n";
 456         return $ret;
 457 }
 458
 459 #
 460 # send mail to maintainer
 461 #
 462 sub mail($@) {
 463         my $subject = shift;
 464         local( *MAIL );
 465
 466         open( MAIL, "|$conf::mail -s '$subject' '$conf::maintainer_mail'" )
 467                 or (warn( "Could not open pipe to $conf::mail: $!\n" ), return);
 468         print MAIL @_;
 469         print MAIL "\nGreetings,\n\n\tYour Debian queue daemon watcher\n";
 470         close( MAIL )
 471                 or warn( "$conf::mail failed (exit status $?)\n" );
 472 }
 473
 474 #
 475 # log something to logfile
 476 #
 477 sub logger(@) {
 478         my $now = format_time();
 479         local( *LOG );
 480
 481         if (!open( LOG, ">>$conf::logfile" )) {
 482                 warn( "Can't open $conf::logfile\n" );
 483                 return;
 484         }
 485         print LOG "$now dqueued-watcher: ", @_;
 486         close( LOG );
 487 }
 488
 489 #
 490 # return current time as string
 491 #
 492 sub format_time() {
 493         my $t;
 494
 495         # omit weekday and year for brevity
 496         ($t = localtime) =~ /^\w+\s(.*)\s\d+$/;
 497         return $1;
 498 }
 499
 500
 501 # Local Variables:
 502 #  tab-width: 4
 503 #  fill-column: 78
 504 # End: