1 files changed, 116 insertions, 0 deletions
diff --git a/cancel_build b/cancel_build
new file mode 100755
index 0000000..817dfb2
--- /dev/null
+++ b/cancel_build
@@ -0,0 +1,116 @@
+#!/usr/bin/perl
+#
+# 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, 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, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+#
+
+use strict;
+use MDK::Common qw(cat_);
+use Iurt::Config qw(config_usage get_date config_init);
+use Iurt::File qw(create_file);
+use Iurt::Process qw(wait_for_lock);
+use Iurt::Queue qw(cleanup_failed_build get_upload_tree_state load_lock_file_data);
+use Iurt::Util qw(plog_init plog ssh_setup ssh);
+use Iurt::Ulri qw(load_config);
+
+my %run;
+my $program_name = 'cancel_build';
+$run{program_name} = $program_name;
+
+my $LOG;
+if (!$ENV{ULRI_LOG_FILE} || !open($LOG, '>>', $ENV{ULRI_LOG_FILE})) {
+    open($LOG, ">&STDERR");
+}
+
+plog_init($program_name, $LOG, 7, 1);
+my $prefix = shift or die "Usage: $0 <prefix>\n";
+
+my $HOME = $ENV{HOME};
+my $configfile = "$HOME/.upload.conf";
+my $sysconfigfile = "/etc/iurt/upload.conf";
+
+my $config = load_config(\%run);
+
+$run{pidfile_home} = $config->{tmp};
+# Use ulri lock as we don't want to run concurrently with it
+$run{pidfile} = 'ulri';
+my $pidfile = wait_for_lock(\%run);
+
+my ($fulldate, $daydate) = get_date();
+$run{daydate} = $daydate;
+
+($fulldate, $daydate) = get_date();
+
+my $todo = "$config->{queue}/todo";
+my $failure = "$config->{queue}/failure";
+my $done = "$config->{queue}/done";
+my $reject = "$config->{queue}/reject";
+
+my %pkg_tree = get_upload_tree_state($config);
+
+if (!defined($pkg_tree{$prefix})) {
+    plog('ERROR', "Unknown prefix $prefix");
+    unlink $pidfile;
+    exit 1;
+}
+
+my $ent = $pkg_tree{$prefix};
+foreach my $media (keys %{$ent->{media}}) {
+    foreach my $bot (@{$ent->{media}{$media}{bot}}) {
+	$run{bot}{$bot->{host}}{$bot->{bot}} = $prefix;
+    }
+}
+
+foreach my $media (keys %{$ent->{media}}) {
+    my $path = $ent->{media}{$media}{path};
+    my $user = $ent->{user};
+
+    # Local pathnames
+    my $done_dir = "$done/$path";
+    my $todo_dir = "$todo/$path";
+    my $fail_dir = "$failure/$path";
+
+    # Calling with "noarch" to make it always a fatal failure
+    plog('INFO', "Failing $prefix and cleaning up done architectures");
+    cleanup_failed_build($todo_dir, $done_dir, $fail_dir, $prefix, $ent, $media, "noarch", $config);
+    foreach my $bot_list (@{$ent->{media}{$media}{bot}}) {
+	my ($bot, $host, $date, $pid, $arch, $time) =
+		    @$bot_list{qw(bot host date pid arch time)};
+
+	my $bot_conf = $config->{bot}{$arch}{$host}{$bot};
+        my $remote = ssh_setup($config->{ssh_options},
+			   $bot_conf->{user}, $host);
+
+	my $prefix_dir = "$bot_conf->{packages}/$path/$prefix-$arch/";
+
+	# If our build is noarch, set arch appropriately.
+	#
+	my $lock_file =
+	    "$todo_dir/${prefix}_$arch-noarch.$bot.$host.$date.$pid.lock";
+
+	if (-f $lock_file) {
+	    plog('DEBUG', "$prefix is noarch");
+	    $arch = "noarch";
+	} else {
+	    $lock_file =~ s/-noarch//;
+	}
+
+	plog('INFO', "Killing process $pid on $host (building for arch \"$arch\")");
+	ssh($remote, "kill -TERM $pid");
+	$pkg_tree{$prefix}{media}{$media}{cancelled_arch}{$arch} = 1;
+	create_file("$done_dir/${prefix}_$arch.cancelled", "$bot $host");
+    }
+}
+
+unlink $pidfile;