diff options
Diffstat (limited to 'lib/Iurt/Ulri.pm')
| -rwxr-xr-x | lib/Iurt/Ulri.pm | 185 |
1 files changed, 185 insertions, 0 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); +} |