diff options
Diffstat (limited to 'bin/check-old-builds')
| -rwxr-xr-x | bin/check-old-builds | 153 |
1 files changed, 153 insertions, 0 deletions
diff --git a/bin/check-old-builds b/bin/check-old-builds new file mode 100755 index 0000000..12306f7 --- /dev/null +++ b/bin/check-old-builds @@ -0,0 +1,153 @@ +#!/usr/bin/perl +# +# check-old-build: check for packages which are in Building for extended time +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +use strict; +use warnings; +use Time::Local; + +my $HOME = $ENV{'HOME'} +or die "HOME not defined in environment!\n"; + +sub check (@); +sub notify_mail (@); +sub parse_date ($); + +my $reported_file = "$HOME/lib/reported-old-builds"; +my $list_cmd = "wanna-build --list=building -v"; +my $report_days = 10; +my $mailprog = "/usr/sbin/sendmail"; +chomp( my $mailname = `cat /etc/mailname` || `hostname` ); +my $sender = $ENV{'LOGNAME'} || (getpwuid($<))[0]; + +my ($pkg, $builder, $date); +my %reported; +my %seen; +my $now = time; +my $report_time = $report_days * 24*60*60; + +my %monname = ('jan', 0, + 'feb', 1, + 'mar', 2, + 'apr', 3, + 'may', 4, + 'jun', 5, + 'jul', 6, + 'aug', 7, + 'sep', 8, + 'oct', 9, + 'nov', 10, + 'dec', 11 ); + +if (open( F, "<$reported_file" )) { + while( <F> ) { + next if !/^(\S+)\s+(\S+)\s+(\d+)$/; + $reported{$2}->{$1} = $3; + } + close( F ); +} + +my $dist; +foreach $dist (qw(stable frozen unstable)) { + open( PIPE, "$list_cmd --dist=$dist 2>&1 |" ) + or die "Cannot spawn $list_cmd: $!\n"; + while( <PIPE> ) { + next if /^wanna-build Revision/ || /^Total \d+ package/; + if (/^Database for \S+ doesn't exist/i) { + last; + } + elsif (m,^\S*/(\S+) by (\S+) \[.*\]$,) { + ($pkg, $builder) = ($1, $2); + $seen{$dist}->{$pkg} = 1; + } + elsif (/^\s+Previous state was \S+ until (.*)$/) { + $date = parse_date($1); + check( $dist, $pkg, $builder, $date ); + } + elsif (/^Database locked by \S+ -- please wait/ || /^\s/) { + # ignore + } + else { + warn "Unexpected output from $list_cmd line $.:\n$_"; + } + } + close( PIPE ); +} + +open( F, ">$reported_file" ) + or die "Cannot open $reported_file for writing: $!\n"; +foreach $dist (qw(stable frozen unstable)) { + foreach (keys %{$reported{$dist}}) { + print F "$_ $dist $reported{$dist}->{$_}\n" + if $seen{$dist}->{$_}; + } +} +close( F ); + +exit 0; + +sub check (@) { + my ($dist, $pkg, $builder, $bdate) = @_; + my $date = (exists $reported{$dist}->{$pkg}) ? + $reported{$dist}->{$pkg} : $bdate; + + if ($now - $date > $report_time) { + notify_mail( $dist, $pkg, $builder, $bdate ); + $reported{$dist}->{$pkg} = $now; + } +} + +sub notify_mail (@) { + my ($dist, $pkg, $to, $_date) = @_; + my $date = localtime($date); + local( *MAIL ); + + local $SIG{'PIPE'} = 'IGNORE'; + open( MAIL, "| $mailprog -oem $to\@$mailname" ) + or die "Can't open pipe to $mailprog: $!\n"; + print MAIL <<"EOF"; +From: $sender\@$mailname +To: $to\@$mailname +Subject: Old build of $pkg (dist=$dist) + +The package $pkg has been taken by you for +building in distribution $dist at $date. +This is some time ago now, so it could be you have forgotten the build. +Can you please check this and --if this is the case-- give back the package +or finish it? +If you did not call wanna-build --uploaded, it might also be the case +that the package is not yet installed in the archive. + +(This is an automated message.) +EOF + close( MAIL ); +} + +sub parse_date ($) { + my $text = shift; + + die "Cannot parse date: $text\n" + if $text !~ /^(\d{4}) (\w{3}) (\d+) (\d{2}):(\d{2}):(\d{2})$/; + my ($year, $mon, $day, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6); + $mon =~ y/A-Z/a-z/; + die "Invalid month name $mon" if !exists $monname{$mon}; + $mon = $monname{$mon}; + return timelocal($sec, $min, $hour, $day, $mon, $year); +} |