Add an utility to cancel a build

Usage:

$ cancel_build 20231231211004.pterjan.duvel.1487312
*: [cancel_build] check uploads tree
I: [cancel_build] check dir: /var/lib/schedbot/uploads/done
I: [cancel_build] check dir: /var/lib/schedbot/uploads/todo
I: [cancel_build] Failing 20231231211004.pterjan.duvel.1487312 and cleaning up done architectures
I: [cancel_build] Killing process 1146007 on rabbit2 (building for arch "i586")
I: [cancel_build] Killing process 2204767 on ecosse0 (building for arch "x86_64")
I: [cancel_build] Killing process 3092253 on ociaa1-a (building for arch "aarch64")
I: [cancel_build] Killing process 3092165 on ociaa1-b (building for arch "armv7hl")

6 files changed, 281 insertions, 138 deletions

diff --git a/NEWS b/NEWS
index 41aa2fa..e1f03a9 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,5 @@
+- cancel_build: add an utility to cancel a build in the queue
+
 0.9.0
 - iurt: Sort packages.arch.log
 - rebuild_perl_iurt: set --target to correctly build for armv7hl on aarch64
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;
diff --git a/emi b/emi
index e697e4a..1cdad5d 100755
--- a/emi
+++ b/emi
@@ -92,7 +92,7 @@ config_init(\%config_usage, $config, \%run);
 
 $run{pidfile_home} = $config->{tmp};
 $run{pidfile} = "upload";
-my $pidfile = check_pid(\%run);
+my $pidfile = check_pid(\%run, 1);
 
 my $todo = "$config->{queue}/todo";
 my $done = "$config->{queue}/done";
diff --git a/lib/Iurt/Process.pm b/lib/Iurt/Process.pm
index ea90a62..c234d0b 100644
--- a/lib/Iurt/Process.pm
+++ b/lib/Iurt/Process.pm
@@ -15,6 +15,7 @@ our @EXPORT = qw(
     check_pid
     perform_command
     sudo
+    wait_for_lock
 );
 
 my $sudo = '/usr/bin/sudo';
@@ -23,6 +24,7 @@ my $sudo = '/usr/bin/sudo';
 
 Check that there is no other program running and create a pidfile lock
 I<$run> current running options
+I<$exit> whether to exit when the lock is in use
 Return true.
 
 =cut
@@ -31,7 +33,7 @@ Return true.
 #     should be designed
 
 sub check_pid {
-    my ($run) = @_;
+    my ($run, $exit) = @_;
 
     my $pidfile = "$run->{pidfile_home}/$run->{pidfile}";
 
@@ -66,9 +68,10 @@ sub check_pid {
 		    sleep 1;
 		}
 	    } else  {
-		plog('WARN', "another instance [$pid] is already running for ",
-				time()-$time, " seconds");
-		exit();
+		plog('WARN', "another instance [$pid] is already running for",
+				time()-$time, "seconds");
+		exit() if $exit;
+		return;
 	    }
 	} else {
 	    plog('WARN', "cleaning stale lockfile");
@@ -81,6 +84,20 @@ sub check_pid {
     $pidfile;
 }
 
+sub wait_for_lock {
+    my ($run) = @_;
+
+    plog('INFO', 'Waiting for ulri lock to be available');
+    my $delay = 10;
+    my $pidfile = check_pid($run, 0);
+    while (!defined($pidfile)) {
+	plog('WARN', "waiting $delay seconds before retrying");
+	sleep $delay;
+	$pidfile = check_pid($run, 0);
+    }
+
+    $pidfile;
+}
 
 sub fork_to_monitor {
     my ($run, $config, $logfile, %opt) = @_;
diff --git a/lib/Iurt/Ulri.pm b/lib/Iurt/Ulri.pm
index e9f8e44..09be6b0 100755
--- a/lib/Iurt/Ulri.pm
+++ b/lib/Iurt/Ulri.pm
@@ -3,19 +3,155 @@ package Iurt::Ulri;
 use base qw(Exporter);
 use File::Path qw(make_path);
 use File::Temp qw(mktemp);
-use Iurt::Config qw(get_author_email);
+use Iurt::Config qw(config_init config_usage get_author_email);
 use Iurt::File qw(check_file_timeout);
 use Iurt::Mail qw(sendmail);
 use Iurt::Util qw(plog ssh_setup sget ssh sput);
 use File::Slurp qw(read_file);
+use MDK::Common qw(cat_);
 use strict;
 
 our @EXPORT = qw(
     build_package
     fetch_logs_and_cleanup
+    load_config
     warn_about_failure
 );
 
+sub load_config {
+    my ($run) = @_;
+    my $HOME = $ENV{HOME};
+    my $configfile = "$HOME/.upload.conf";
+    my $sysconfigfile = "/etc/iurt/upload.conf";
+
+    my $config = {};
+    foreach my $f ($configfile, $sysconfigfile) {
+	plog('DEBUG', "load config: $f");
+	if (-f $f) {
+            $config = eval(cat_($f))
+              or die "FATAL $run->{program_name}: syntax error in $f";
+            last;
+	}
+    }
+
+    my %config_usage = (
+	admin => {
+	    desc => 'mail address of the bot administrator',
+	    default => 'distrib-admin@mandrivalinux.org'
+	},
+	'arch_translation' => {
+	    desc => "Renaming of arch",
+	    default => { 'sparc64' => 'sparcv9' }
+	},
+	bot => {
+	    desc => "List of bot able to compile the packages",
+	    default => {
+		i586 => {
+	            localhost => {
+			iurt => {
+			    user => 'builder',
+			    command => qq(iurt --copy_srpm --group --config local_spool /home/builder/iurt/__DIR__ --no_rsync --chrooted-urpmi -m __MEDIA__ -- http://localhost/distrib/ -p "__PACKAGER__" -r __TARGET__ __ARCH__),
+			    packages => '/home/builder/iurt/',
+			},
+		    },
+		},
+	    },
+	},
+	media => {
+	    desc => 'Corresponding media to add given the current media',
+	    default => {
+		default => {
+		    "core/backports" => [ "core/backports", "core/release", "core/updates" ],
+		    "core/backports_testing" => [
+			"core/backports", "core/backports_testing",
+			"core/release", "core/updates"
+		    ],
+		    "core/release" => [ "core/release" ],
+		    "core/updates" => [ "core/release", "core/updates" ],
+		    "core/updates_testing" => [
+			"core/release", "core/updates", "core/updates_testing"
+		    ],
+		    "nonfree/backports" => [
+			"core/backports", "core/release", "core/updates",
+			"nonfree/backports", "nonfree/release", "nonfree/updates"
+		    ],
+		    "nonfree/backports_testing" => [
+			"core/backports", "core/backports_testing",
+			"core/release", "core/updates",
+			"nonfree/backports", "nonfree/backports_testing",
+			"nonfree/release", "nonfree/updates"
+		    ],
+		    "nonfree/release" => [ "core/release", "nonfree/release" ],
+		    "nonfree/updates" => [
+			"core/release", "core/updates",
+			"nonfree/release", "nonfree/updates"
+		    ],
+		    "nonfree/updates_testing" => [
+			"core/release", "core/updates", "core/updates_testing",
+			"nonfree/release", "nonfree/updates", "nonfree/updates_testing"
+		    ],
+		    "tainted/backports" => [
+			"core/backports", "core/release", "core/updates",
+			"tainted/backports", "tainted/release", "tainted/updates"
+		    ],
+		    "tainted/backports_testing" => [
+			"core/backports", "core/backports_testing",
+			"core/release", "core/updates",
+			"tainted/backports", "tainted/backports_testing",
+			"tainted/release", "tainted/updates"
+		    ],
+		    "tainted/release" => [ "core/release", "tainted/release" ],
+		    "tainted/updates" => [
+			"core/release", "core/updates",
+			"tainted/release", "tainted/updates"
+		    ],
+		    "tainted/updates_testing" => [
+			"core/release", "core/updates", "core/updates_testing",
+			"tainted/release", "tainted/updates", "tainted/updates_testing"
+		    ],
+		},
+	    },
+	},
+	faildelay => {
+	    desc => "Time after which the rebuild is considered as a failure",
+	    default => 36000
+	},
+	http_queue => {
+	    desc => 'Address where log can be consulted',
+	    default => 'http://pkgsubmit.mageia.org/uploads/'
+	},
+	queue => {
+	    desc => "Root of the tree where the packages to compile are located",
+	    default => "$HOME/uploads"
+	},
+	tmp => {
+	    desc => "Temporary directory",
+	    default => "$HOME/tmp"
+	},
+	ssh_options => {
+	    desc => "SSH options",
+	    default => "-o ConnectTimeout=5 -o BatchMode=yes -o ServerAliveInterval=5"
+	},
+	packager => {
+            desc => 'Default packager tag user by bot',
+	    default => 'Mageia Team <http://www.mageia.org>'
+	},
+	'arch' => {
+	    desc => 'Architectures list for each target',
+	    default => {
+		default => [ 'i586', 'x86_64' ],
+	    },
+	},
+	'backoff_delays' => {
+	    desc => 'List of delays in seconds before retrying retriable errors. Error becomes permanent after reaching the end of the list.',
+	    default => [5*60, 30*60, 60*60, 120*60]
+	},
+    );
+    config_usage(\%config_usage, $config) if $run->{config_usage};
+    config_init(\%config_usage, $config, $run);
+    return $config;
+}
+
 sub build_package {
     my ($config, $pkg_tree, $media, $prefix, $host, $arch, $bot) = @_;
 
diff --git a/ulri b/ulri
index 553fbd9..fe5ad84 100755
--- a/ulri
+++ b/ulri
@@ -21,14 +21,14 @@
 
 use strict;
 use MDK::Common qw(any cat_ if_ find);
-use Iurt::Config qw(config_usage get_date config_init get_author_email get_target_arch get_mandatory_arch);
+use Iurt::Config qw(get_date get_author_email get_target_arch get_mandatory_arch);
 use Iurt::File qw(create_file);
 use Iurt::Mail qw(sendmail);
 use Iurt::Process qw(check_pid);
 use Iurt::Queue qw(check_if_mandatory_arch_failed cleanup_failed_build get_upload_tree_state load_lock_file_data record_bot_complete schedule_next_retry);
 use Iurt::RPM qw(check_arch check_noarch);
 use Iurt::Util qw(plog_init plog ssh_setup ssh sout sget sput);
-use Iurt::Ulri qw(build_package fetch_logs_and_cleanup warn_about_failure);
+use Iurt::Ulri qw(build_package fetch_logs_and_cleanup load_config warn_about_failure);
 use File::Copy 'move';
 use File::Path 'make_path';
 use File::Temp 'mktemp';
@@ -47,135 +47,7 @@ if (!$ENV{ULRI_LOG_FILE} || !open($LOG, '>>', $ENV{ULRI_LOG_FILE})) {
 
 plog_init($program_name, $LOG, 7, 1);
 
-my $HOME = $ENV{HOME};
-my $configfile = "$HOME/.upload.conf";
-my $sysconfigfile = "/etc/iurt/upload.conf";
-
-my $config = {};
-foreach my $f ($configfile, $sysconfigfile) {
-    plog('DEBUG', "load config: $f");
-    if (-f $f) {
-        $config = eval(cat_($f))
-          or die "FATAL $program_name: syntax error in $f";
-        last;
-    }
-}
-
-my %config_usage = ( 
-    admin => {
-	desc => 'mail address of the bot administrator',
-	default => 'distrib-admin@mandrivalinux.org'
-    },
-    'arch_translation' => {  
-	desc => "Renaming of arch",
-	default => { 'sparc64' => 'sparcv9' }
-    },
-     bot => {  
-	desc => "List of bot able to compile the packages",
-	default => {
-	    i586 => {
-	        localhost => {
-		    iurt => {
-			user => 'builder',
-			command => qq(iurt --copy_srpm --group --config local_spool /home/builder/iurt/__DIR__ --no_rsync --chrooted-urpmi -m __MEDIA__ -- http://localhost/distrib/ -p "__PACKAGER__" -r __TARGET__ __ARCH__),
-			packages => '/home/builder/iurt/',
-		    } ,
-		},
-	    },
-	},
-    },
-    media => { 
-	desc => 'Corresponding media to add given the current media',
-	default => {
-	    default => {
-		"core/backports" => [ "core/backports", "core/release", "core/updates" ],
-		"core/backports_testing" => [
-		    "core/backports", "core/backports_testing",
-		    "core/release", "core/updates"
-		],
-		"core/release" => [ "core/release" ],
-		"core/updates" => [ "core/release", "core/updates" ],
-		"core/updates_testing" => [
-		    "core/release", "core/updates", "core/updates_testing"
-		],
-		"nonfree/backports" => [
-		    "core/backports", "core/release", "core/updates",
-		    "nonfree/backports", "nonfree/release", "nonfree/updates"
-		],
-		"nonfree/backports_testing" => [
-		    "core/backports", "core/backports_testing",
-		    "core/release", "core/updates",
-		    "nonfree/backports", "nonfree/backports_testing",
-		    "nonfree/release", "nonfree/updates"
-		],
-		"nonfree/release" => [ "core/release", "nonfree/release" ],
-		"nonfree/updates" => [
-		    "core/release", "core/updates",
-		    "nonfree/release", "nonfree/updates"
-		],
-		"nonfree/updates_testing" => [
-		    "core/release", "core/updates", "core/updates_testing",
-		    "nonfree/release", "nonfree/updates", "nonfree/updates_testing"
-		],
-		"tainted/backports" => [
-		    "core/backports", "core/release", "core/updates",
-		    "tainted/backports", "tainted/release", "tainted/updates"
-		],
-		"tainted/backports_testing" => [
-		    "core/backports", "core/backports_testing",
-		    "core/release", "core/updates",
-		    "tainted/backports", "tainted/backports_testing",
-		    "tainted/release", "tainted/updates"
-		],
-		"tainted/release" => [ "core/release", "tainted/release" ],
-		"tainted/updates" => [
-		    "core/release", "core/updates",
-		    "tainted/release", "tainted/updates"
-		],
-		"tainted/updates_testing" => [
-		    "core/release", "core/updates", "core/updates_testing",
-		    "tainted/release", "tainted/updates", "tainted/updates_testing"
-		],
-	    },
-	},
-    },
-    faildelay => {
-	desc => "Time after which the rebuild is considered as a failure",
-	default => 36000
-    },
-    http_queue => {
-	desc => 'Address where log can be consulted',
-	default => 'http://kenobi.mandriva.com/queue '
-    },
-    queue => {
-	desc => "Root of the tree where the packages to compile are located",
-	default => "$HOME/uploads"
-    },
-    tmp => {
-       desc => "Temporary directory",
-       default => "$HOME/tmp"
-    },
-    ssh_options => {
-	desc => "SSH options",
-	default => "-o ConnectTimeout=5 -o BatchMode=yes -o ServerAliveInterval=5"
-    },
-    packager => {
-        desc => 'Default packager tag user by bot',
-	default => 'Mageia Team <http://www.mageia.org>'
-    },
-    'arch' => {
-	desc => 'Architectures list for each target',
-	default => {
-	    default => [ 'i586', 'x86_64' ],
-	},
-    },
-    'backoff_delays' => {
-	desc => 'List of delays in seconds before retrying retriable errors. Error becomes permanent after reaching the end of the list.',
-	default => [5*60, 30*60, 60*60, 120*60]
-    },
-);
-config_usage(\%config_usage, $config) if $run{config_usage};
-config_init(\%config_usage, $config, \%run);
+my $config = load_config(\%run);
 
 my %untranslated_arch;
 foreach my $k (keys %{$config->{arch_translation}}) {
@@ -185,7 +57,7 @@ foreach my $k (keys %{$config->{arch_translation}}) {
 
 $run{pidfile_home} = $config->{tmp};
 $run{pidfile} = $program_name;
-my $pidfile = check_pid(\%run);
+my $pidfile = check_pid(\%run, 1);
 
 
 my ($fulldate, $daydate) = get_date();