Start splitting ulri

2 files changed, 207 insertions, 198 deletions

diff --git a/lib/Iurt/Ulri.pm b/lib/Iurt/Ulri.pm
new file mode 100755
index 0000000..4140678
--- /dev/null
+++ b/lib/Iurt/Ulri.pm
@@ -0,0 +1,185 @@
+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::Util qw(plog ssh_setup ssh sput);
+use strict;
+
+our @EXPORT = qw(
+    build_package
+    warn_about_failure
+);
+
+sub build_package {
+    my ($config, $pkg_tree, $media, $prefix, $host, $arch, $bot) = @_;
+
+    plog('INFO', "building on $host/$arch ($bot)");
+
+    my $path = $pkg_tree->{$prefix}{media}{$media}{path};
+    my $todo_dir = "$config->{queue}/todo/$path";
+    my $target = $pkg_tree->{$prefix}{target};
+    my $srpms = $pkg_tree->{$prefix}{srpms};
+    my $user = get_author_email($pkg_tree->{$prefix}{user}) || $config->{packager};
+    $user =~ s/([<>])/\\$1/g;
+
+    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/";
+    my $status_file = "$prefix_dir/log/status.log";
+
+    # Copy packages to build node
+    #
+    # create also the log dir for botcmd.log
+    if (ssh($remote, "mkdir -p $prefix_dir/log")) {
+	exclude_machine($config, $host);
+	next;
+    }
+    my $pkgs;
+    my $ok = 1;
+    foreach my $srpm (@$srpms) {
+	plog('NOTIFY', "Send to $host/$arch: $srpm");
+	$ok &&= !sput($remote, "$todo_dir/${prefix}_$srpm",
+		      "$prefix_dir/$srpm");
+	$pkgs .= " $prefix_dir/$srpm";
+    }
+    if (!$ok) {
+	exclude_machine($config, $host);
+	return;
+    }
+
+    # spawn remote build bot and save output on local file
+    # (remove status.log before building, otherwise we can have
+    # a install_deps_failure and reschedule even if the package
+    # is currently building)
+    #
+    plog('DEBUG', "remove status file");
+    ssh($remote, "rm $status_file 2>/dev/null");
+
+    plog('INFO', "Execute build command on $host/$arch");
+
+    my $temp = mktemp("$config->{tmp}/ulri.tmp.$prefix.XXXXX");
+    my $cmd = $bot_conf->{command};
+    $cmd =~ s!__ARCH__!$arch!g;
+    $cmd =~ s!__DIR__!$path/$prefix-$arch!g;
+    $cmd =~ s!__TARGET__!$target!g;
+    $cmd =~ s!__PACKAGER__!$user!g;
+    my $section = $media;
+    $section =~ s!/.*$!!;
+    $cmd =~ s!__SECTION__!$section!g;
+
+    my $media_to_add;
+    my $medium = ref $config->{media}{$target}{$media} ? $target : 'default';
+    $media_to_add = join ' ', @{$config->{media}{$medium}{$media}};
+    plog('DEBUG', "Will compile only with media $media_to_add");
+    $cmd =~ s!__MEDIA__!$media_to_add!g;
+
+    #- allow x86_64 hosts to build i586 packages
+    if ($arch eq 'i586') {
+	$cmd = "setarch i586 $cmd";
+    }
+
+    plog('DEBUG', "Build $pkgs");
+    ssh($remote, "'echo PID=\$\$; exec $cmd $pkgs &>$prefix_dir/log/botcmd.\$(date +%s).\$(hostname -s).log' > $temp &");
+
+    # wait 10 seconds or until we have the log file
+    # plus 20 seconds if it timeouts.
+    #
+    if (check_file_timeout($temp, 10)) {
+	plog('WARN', "Timeout waiting for building start. Waiting more 20s.");
+	if (check_file_timeout($temp, 20)) {
+	    plog('WARN', "Timeout! Abandoning the build.");
+	    return;
+	}
+    }
+
+    # get remote PID from log file
+    #
+    my $pid = get_pid_from_file($temp);
+    unlink $temp;
+    plog('DEBUG', "remote pid $pid");
+    if (!$pid) {
+	plog('WARN', "pid is unknown, abandoning the build.");
+	return;
+    }
+
+    # Fork to wait for the build to finish
+    if (fork() == 0) {
+	local $SIG{ALRM} = sub {
+	    # Run ourselves to kill the build
+	    exec "ulri";
+        };
+	alarm $config->{faildelay};
+	# SSH to $host and wait up for $pid to exit
+	ssh($remote, "'while /bin/true; do ps $pid >/dev/null 2>&1 || exit; sleep 1; done'");
+	alarm 0;
+	# Fetch build results
+	exec "ulri";
+    }
+    return $pid;
+}
+
+sub check_file_timeout {
+    my ($file, $time) = @_;
+
+    my $i = 0;
+    while ($i < $time && (!-f $file || -z $file)) { sleep 1; $i++ }
+
+    $i == $time;
+}
+
+sub exclude_machine {
+    my ($config, $host) = @_;
+    plog('INFO', "Excluding build host $host");
+    foreach my $arch (keys %{$config->{bot}}) {
+	delete $config->{bot}{$arch}{$host};
+    }
+}
+
+sub get_pid_from_file {
+    my ($file) = @_;
+
+    my $pid;
+    open my $FILE, $file || die "FATAL: can't open $file";
+    local $_;
+    while (<$FILE>) { last if ($pid) = /^PID=(\d+)/ }
+
+    $pid;
+}
+
+sub warn_about_failure {
+    my ($config, $user, $ent, $arch, $fail_dir, $path, $prefix) = @_;
+    my $text = join("\n", "Build of the following packages failed:\n", map { "- $_" } @{$ent->{srpms}}) . "\n";
+    my $srpms = join(' ', @{$ent->{srpms}}, undef);
+
+    my $to = get_author_email($user) || "Unknown <$config->{admin}>";
+    my $cc;
+    my $fpath = "$config->{http_queue}/failure/$path/$prefix";
+    $fpath =~ tr!/!!s;             # Squash double slashes ...
+    $fpath =~ s!/!//!;           # ... except for http://
+
+    $text .= "\nFailure details available in $fpath/log\n";
+    $text .= "Reason:\n";
+    $text .= read_file("$fail_dir/$prefix/log/status.log");
+    $text .= "\nLog files generated:\n";
+
+    opendir my $DP1, "$fail_dir/$prefix/log/";
+    foreach my $f1 (sort(readdir($DP1))) {
+        next if ! -d "$fail_dir/$prefix/log/$f1" || $f1 =~ m/^\./;
+
+        opendir my $DP2, "$fail_dir/$prefix/log/$f1";
+        foreach my $f2 (readdir $DP2) {
+            next if $f2 =~ m/^\./;
+            $text .= "$fpath/log/$f1/$f2\n";
+        }
+        closedir $DP2;
+    }
+    closedir $DP1;
+
+    sendmail($to, $cc,
+             "Rebuild failed on $arch for $srpms", $text,
+             "Ulri the scheduler bot <$config->{admin}>", 0, $config);
+}
diff --git a/ulri b/ulri
index 0c74450..e373419 100755
--- a/ulri
+++ b/ulri
@@ -38,6 +38,7 @@ use Iurt::Process qw(check_pid);
 use Iurt::File qw(cleanup_failed_build get_upload_tree_state);
 use Iurt::Mail qw(sendmail);
 use Iurt::Util qw(plog_init plog ssh_setup ssh sout sget sput);
+use Iurt::Ulri qw(build_package warn_about_failure);
 use File::Copy 'move';
 use File::Path 'make_path';
 use File::Temp 'mktemp';
@@ -413,7 +414,7 @@ foreach my $prefix (keys %pkg_tree) {
 	    # Notify user if build failed
 	    #
 	    if ($user) {
-		warn_about_failure($user, $ent, $arch, $fail_dir, $path, $prefix);
+		warn_about_failure($config, $user, $ent, $arch, $fail_dir, $path, $prefix);
 	    }
 
 	    # clean the log on the compilation machine
@@ -473,20 +474,10 @@ foreach my $prefix (sort keys %pkg_tree) {
 
     foreach my $media (keys %{$ent->{media}}) {
 	my $path = $ent->{media}{$media}{path};
+	my $todo_dir = "$config->{queue}/todo/$path";
 	my $target = $ent->{target};
 	my $srpms = $ent->{srpms} or next;
 
-	my $user = get_author_email($ent->{user}) || $config->{packager};
-	$user =~ s/([<>])/\\$1/g;
-
-	# Local pathnames
-	my $done_dir = "$done/$path";
-	my $todo_dir = "$todo/$path";
-
-	# Make sure these exist
-	make_path($done_dir);
-	make_path($todo_dir);
-
 	#plog('DEBUG', "searching a bot to compile @$srpms");
 
 	# count noarch todos only once even if searching multiple bots
@@ -496,7 +487,6 @@ foreach my $prefix (sort keys %pkg_tree) {
 	my @arch_list = $arch_list ? @$arch_list : keys %{$config->{bot}};
 	# need to find a bot for each arch
 	foreach my $arch (@arch_list) {
-
 	    # Skip this arch if package is already building as noarch or for this arch
 	    #  or if it should not be built on this arch
 	    next if $pkg_tree{$prefix}{media}{$media}{arch}{noarch};
@@ -514,138 +504,40 @@ foreach my $prefix (sort keys %pkg_tree) {
 	    my $excluded = any { !check_arch("$todo_dir/${prefix}_$_", $arch) } @$srpms;
 	    if ($excluded) {
 		plog('WARN', "excluding from $arch: $excluded");
+		my $done_dir = "$done/$path";
+		make_path($done_dir);
 		create_file("$done_dir/${prefix}_$arch.excluded",
 			    "ulri $arch excluded");
 		$pkg_tree{$prefix}{media}{$media}{excluded_arch}{$arch} = 1;
 		next;
 	    }
-	    
+
 	    if ($noarch) {
 		plog('DEBUG', "search any bot for @$srpms") unless $noarch_countflag;
 	    } else {
 		plog('DEBUG', "search $arch bot for @$srpms");
 	    }
-	    
-	    foreach my $host (keys %{$config->{bot}{$arch}}) {
+
+	    hosts: foreach my $host (keys %{$config->{bot}{$arch}}) {
 		foreach my $bot (keys %{$config->{bot}{$arch}{$host}}) {
 		    next if $run{bot}{$host}{$bot};
-		    
-		    plog('INFO', "building on $host/$arch ($bot)");
-		    
-		    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/";
-		    my $status_file = "$prefix_dir/log/status.log";
-		    
-		    # Copy packages to build node
-		    #
-		    # create also the log dir for botcmd.log
-		    if (ssh($remote, "mkdir -p $prefix_dir/log")) {
-			exclude_machine($config, $host);
-			next;
-		    }
-		    my $pkgs;
-		    my $ok = 1;
-		    foreach my $srpm (@$srpms) {
-			plog('NOTIFY', "Send to $host/$arch: $srpm");
-			$ok &&= !sput($remote, "$todo_dir/${prefix}_$srpm",
-				      "$prefix_dir/$srpm");
-			$pkgs .= " $prefix_dir/$srpm";
-		    }
-		    if (!$ok) {
-			exclude_machine($config, $host);
-			next;
-		    }
-		    
-		    # Register that the package is building
-		    $run{bot}{$host}{$bot} = $prefix;
-		    $pkg_tree{$prefix}{media}{$media}{arch}{$noarch ? 'noarch' : $arch} = 1;
-
-		    # spawn remote build bot and save output on local file
-		    # (remove status.log before building, otherwise we can have
-		    # a install_deps_failure and reschedule even if the package
-		    # is currently building)
-		    #
-		    plog('DEBUG', "remove status file");
-		    ssh($remote, "rm $status_file 2>/dev/null");
-		    
-		    plog('INFO', "Execute build command on $host/$arch");
-		    
-		    my $temp = mktemp("$config->{tmp}/ulri.tmp.$prefix.XXXXX");
-		    my $cmd = $bot_conf->{command};
-		    $cmd =~ s!__ARCH__!$arch!g;
-		    $cmd =~ s!__DIR__!$path/$prefix-$arch!g;
-		    $cmd =~ s!__TARGET__!$target!g;
-		    $cmd =~ s!__PACKAGER__!$user!g;
-		    my $section = $media;
-		    $section =~ s!/.*$!!;
-		    $cmd =~ s!__SECTION__!$section!g;
-		    
-		    my $media_to_add;
-		    my $medium = ref $config->{media}{$target}{$media} ? $target : 'default';
-		    $media_to_add = join ' ', @{$config->{media}{$medium}{$media}};
-		    plog('DEBUG', "Will compile only with media $media_to_add");
-		    $cmd =~ s!__MEDIA__!$media_to_add!g;
-		    
-		    #- allow x86_64 hosts to build i586 packages
-		    if ($arch eq 'i586') {
-			$cmd = "setarch i586 $cmd";
+		    my $pid = build_package($config, \%pkg_tree, $path, $prefix, $host, $arch, $bot);
+		    if ($pid) {
+			# Register that the package is building
+			$run{bot}{$host}{$bot} = $prefix;
+			$pkg_tree{$prefix}{media}{$media}{arch}{$noarch ? 'noarch' : $arch} = 1;
+
+			my $lock_arch = $noarch ? "$arch-noarch" : $arch;
+			my $lock_file = "$todo_dir/${prefix}_" .
+			    "$lock_arch.$bot.$host.$fulldate.$pid.lock";
+			plog('DEBUG', "create lock $lock_file");
+			create_file($lock_file, "$program_name $$", time());
+
+			last hosts;
 		    }
-		    
-		    plog('DEBUG', "Build $pkgs");
-		    ssh($remote, "'echo PID=\$\$; exec $cmd $pkgs &>$prefix_dir/log/botcmd.\$(date +%s).\$(hostname -s).log' > $temp &");
-		    
-		    # wait 10 seconds or until we have the log file
-		    # plus 20 seconds if it timeouts.
-		    #
-		    if (check_file_timeout($temp, 10)) {
-			plog('WARN', "Timeout waiting for building start. Waiting more 20s.");
-			if (check_file_timeout($temp, 20)) {
-			    plog('WARN', "Timeout! Abandoning the build.");
-			    last;
-			}
-		    }
-		    
-		    # get remote PID from log file
-		    #
-		    my $pid = get_pid_from_file($temp);
-		    unlink $temp;
-		    plog('DEBUG', "remote pid $pid");
-		    if (!$pid) {
-			plog('WARN', "pid is unknown, abandoning the build.");
-			last;
-		    }
-		    
-		    # create lock file
-		    #
-		    my $lock_arch = $noarch ? "$arch-noarch" : $arch;
-		    my $lock_file = "$todo_dir/${prefix}_" .
-			"$lock_arch.$bot.$host.$fulldate.$pid.lock";
-		    plog('DEBUG', "create lock $lock_file");
-		    create_file($lock_file, "$program_name $$", time());
-
-                    # Fork to wait for the build to finish
-                    if (fork() == 0) {
-                        local $SIG{ALRM} = sub {
-                            # Run ourselves to kill the build
-                            exec "ulri";
-                        };
-                        alarm $config->{faildelay};
-                        # SSH to $host and wait up for $pid to exit
-                        ssh($remote, "'while /bin/true; do ps $pid >/dev/null 2>&1 || exit; sleep 1; done'");
-                        alarm 0;
-                        # Fetch build results
-                        exec "ulri";
-                    }
-
-		    last;
 		}
-		last if $pkg_tree{$prefix}{media}{$media}{arch}{$arch};
-		last if $pkg_tree{$prefix}{media}{$media}{arch}{noarch};
 	    }
-	    
+
 	    # Count packages to compile for each architecture. Count noarch
 	    # package only once.
 	    #
@@ -684,57 +576,6 @@ plog('INFO', "jobs in queue:", %to_compile ?
 
 unlink $pidfile;
 exec "emi" if $something_finished;
-exit();
-
-
-#
-# Subroutines
-#
-
-sub warn_about_failure {
-    my ($user, $ent, $arch, $fail_dir, $path, $prefix) = @_;
-    my $text = join("\n", "Build of the following packages failed:\n", map { "- $_" } @{$ent->{srpms}}) . "\n";
-    my $srpms = join(' ', @{$ent->{srpms}}, undef);
-
-    my $to = get_author_email($user) || "Unknown <$config->{admin}>";
-    my $cc;
-    my $fpath = "$config->{http_queue}/failure/$path/$prefix";
-    $fpath =~ tr!/!!s;             # Squash double slashes ... 
-      $fpath =~ s!/!//!;           # ... except for http://
-
-    $text .= "\nFailure details available in $fpath/log\n";
-    $text .= "Reason:\n";
-    $text .= read_file("$fail_dir/$prefix/log/status.log");
-    $text .= "\nLog files generated:\n";
-
-    opendir my $DP1, "$fail_dir/$prefix/log/";
-    foreach my $f1 (sort(readdir($DP1))) {
-        next if ! -d "$fail_dir/$prefix/log/$f1" || $f1 =~ m/^\./;
-
-        opendir my $DP2, "$fail_dir/$prefix/log/$f1";
-        foreach my $f2 (readdir $DP2) {
-            next if $f2 =~ m/^\./;
-            $text .= "$fpath/log/$f1/$f2\n";
-        }
-        closedir $DP2;
-    }
-    closedir $DP1;
-
-    sendmail($to, $cc,
-             "Rebuild failed on $arch for $srpms", $text,
-             "Ulri the scheduler bot <$config->{admin}>", 0, $config);
-}
-
-sub get_pid_from_file {
-    my ($file) = @_;
-
-    my $pid;
-    open my $FILE, $file || die "FATAL: can't open $file";
-    local $_;
-    while (<$FILE>) { last if ($pid) = /^PID=(\d+)/ }
-
-    $pid;
-}
 
 sub create_file {
     my $file = shift;
@@ -744,23 +585,6 @@ sub create_file {
     print $FILE "@contents";
 }
 
-sub check_file_timeout {
-    my ($file, $time) = @_;
-
-    my $i = 0;
-    while ($i < $time && (!-f $file || -z $file)) { sleep 1; $i++ }
-
-    $i == $time;
-}
-
-sub exclude_machine {
-    my ($config, $host) = @_;
-    plog('INFO', "Excluding build host $host");
-    foreach my $arch (keys %{$config->{bot}}) {
-	delete $config->{bot}{$arch}{$host};
-    }
-}
-
 __END__
 
 # ulri ends here