1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
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::File qw(check_file_timeout);
use Iurt::Util qw(plog ssh_setup ssh sput);
use File::Slurp qw(read_file);
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 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);
}
|
