Adding upstream version 0.85.6.upstream/0.85.6

Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>

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);
+}