aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Iurt/Ulri.pm
blob: e9f8e4410d679a98da0c4f1472adbcd1fe906c8a (plain)
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
179
180
181
182
183
184
185
186
187
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::Mail qw(sendmail);
use Iurt::Util qw(plog ssh_setup sget ssh sput);
use File::Slurp qw(read_file);
use strict;

our @EXPORT = qw(
    build_package
    fetch_logs_and_cleanup
    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;

    #- force 32bit if needed, this allows to build 32 bits package on 64 bit hosts
    if ($arch =~ /^(i.86|armv5tl|armv7hl)/) {
	$cmd = "setarch linux32 $cmd";
    }

    plog('DEBUG', "Build $pkgs");
    ssh($remote, "'echo PID=\$\$; exec $cmd $pkgs &>$prefix_dir/log/botcmd.\$(date +%s).$arch.\$(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 fetch_logs_and_cleanup {
    my ($remote, $remote_dir, $target_dir) = @_;
    make_path($target_dir);
    sget($remote, "$remote_dir/log/*", $target_dir);
    ssh($remote, "rm -rf $remote_dir");
}

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 (readdir($DP1)) {
        next if ! -d "$fail_dir/$prefix/log/$f1" || $f1 =~ m/^\./;

        opendir my $DP2, "$fail_dir/$prefix/log/$f1";
        foreach my $f2 (sort(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);
}