blob: 4a794f228bae2eaa3a6b5305eb02d8d771ba9016 [file] [log] [blame]
Renato Golin94cc1042016-04-26 11:02:23 +01001#!/usr/bin/env perl
2
3# This script greps the JSON files for the buildbots on
4# the LLVM official build master by name and prints an
5# HTML page with the links to the bots and the status.
6#
7# Multiple masters can be used, as well as multiple groups of bots
8# and multiple bots per group, all in a json file. See linaro.json
9# in this repository to have an idea how the config file is.
10#
11# Module JSON needs to be installed, either from cpan or packages.
12
13push @INC, `dirname $0`;
14
15use strict;
16use warnings;
17# Core modules
18use File::Temp qw/tempfile/;
19use File::Copy;
20# This is not part of core, but you really *need* it.
21use JSON;
22# This can be replaced by `wget/curl`
23use LWP;
24use LWP::UserAgent;
25# We don't have DateTime everywhere...
26my $date = `date`;
27# DEBUG
28my $DEBUG = 0;
29
30######################################################### Initialisation
31# Option checking
32my $syntax = "$0 config-file.json output-file.html\n";
33die $syntax unless (scalar @ARGV == 2);
34# Read config file
35my ($config, $error) = &read_file($ARGV[0]);
36die $error if ($error);
37($config, $error) = &decode($config);
38die $error if ($error);
39
40# Setup HTML output file
41my $output = $ARGV[1];
42my ($temp, $tempname) = tempfile();
43
44
45######################################################### Main Logic
46# Get status for all bots
47my %bot_cache;
48my $fail = 0;
49foreach my $server (@$config) {
50 next if (defined $server->{'ignore'} and $server->{'ignore'} eq "true");
51 my ($BASE_URL, $BUILDER_URL, $BUILD_URL) =
52 ($server->{'base_url'}, $server->{'builder_url'}, $server->{'build_url'});
53 &debug("Parsing server ".$server->{'name'}."...\n");
54 foreach my $builder (@{$server->{'builders'}}) {
55 &debug(" Parsing builder ".$builder->{'name'}."...\n");
56 foreach my $bot (@{$builder->{'bots'}}) {
57 &debug(" Parsing bot ".$bot->{'name'}."...\n");
58 next if defined $bot_cache{$bot->{'name'}};
59 my $status = &get_status($bot->{'name'}, $BASE_URL, $BUILDER_URL, $BUILD_URL);
60 if (!defined $bot->{'ignore'} or $bot->{'ignore'} ne "true") {
61 $fail = 1 if ($status->{'fail'});
62 } else {
63 &debug(" Ignoring...\n");
64 }
65 &debug($status->{'fail'} ? " FAIL\n" : " PASS\n");
66 $bot_cache{$bot->{'name'}} = $status;
67 }
68 }
69}
70
71# Dump all servers / bots
72foreach my $server (@$config) {
73 next if (defined $server->{'ignore'} and $server->{'ignore'} eq "true");
74 my ($BASE_URL, $BUILDER_URL, $BUILD_URL) =
75 ($server->{'base_url'}, $server->{'builder_url'}, $server->{'build_url'});
76 # Favicon
77 my $favicon = $fail ? "fail.ico" : "ok.ico";
78 print $temp "<link rel=\"shortcut icon\" href=\"$favicon\" type=\"image/x-icon\"/>\n";
79 # Header
80 print $temp "<table cellspacing=1 cellpadding=2>\n";
81 print $temp "<tr><td colspan=5>&nbsp;</td><tr>\n";
82 print $temp "<tr><th colspan=5>$server->{'name'} @ $date</td><tr>\n";
83 ## Main loop
84 foreach my $builder (@{$server->{'builders'}}) {
85 print $temp "<tr><td colspan=5>&nbsp;</td><tr>\n";
86 print $temp "<tr><th colspan=5>$builder->{'name'}</td><tr>\n";
87 print $temp "<tr><th>Buildbot</th><th>Status</th><th>Comments</th>".
88 "<th>Build #</th><th>Commits</th></tr>\n";
89 foreach my $bot (@{$builder->{'bots'}}) {
90 print $temp "<tr>\n";
91 my $status = $bot_cache{$bot->{'name'}};
92 my $url = "$BASE_URL/$BUILDER_URL/$bot->{'name'}";
93 print $temp " <td><a href='$url'>$bot->{'name'}</a></td>\n";
94 if ($status->{'fail'}) {
95 print $temp " <td><font color='red'>FAIL</font></td>\n".
96 " <td>$status->{'fail'}</td>\n";
97 } else {
98 print $temp " <td><font color='green'>PASS</font></td>\n".
99 " <td>&nbsp;</td>\n";
100 }
Renato Golin2f8ac152016-09-14 17:59:08 +0100101 if (defined $status->{'build'}) {
102 my $build_url = $url."/builds/".$status->{'build'};
103 print $temp " <td><a href='$build_url'>$status->{'build'}</a></td>\n";
Renato Golin94cc1042016-04-26 11:02:23 +0100104 } else {
Renato Golin2f8ac152016-09-14 17:59:08 +0100105 print $temp " <td>&nbsp;</td>\n";
106 }
107 if (defined $status->{'from'} and
108 defined $status->{'to'}) {
109 print $temp " <td>$status->{'from'}-$status->{'to'}</td>\n";
110 } else {
111 print $temp " <td>&nbsp;</td>\n";
Renato Golin94cc1042016-04-26 11:02:23 +0100112 }
113 print $temp "</tr>\n";
114 }
115 }
116 # Footer
117 print $temp "</table>\n";
118}
119close $temp;
120
121# Move temp to main (atomic change)
122move($tempname, $output);
123exit;
124
125######################################################### Subs
126
127# GET STATUS: get the status of an individual bot
128# (botname, base url, builder url, build url) -> (status)
129sub get_status() {
130 my ($bot, $BASE_URL, $BUILDER_URL, $BUILD_URL) = @_;
131 my ($err, $contents, $json);
132 my %status;
133
134 # Get buildbot main JSON
135 ($contents, $err) = wget("$BASE_URL/json/$BUILDER_URL/$bot");
136 $status{'fail'} = $err;
137 return \%status if $err;
138 ($json, $err) = decode($contents);
139 $status{'fail'} = $err;
140 return \%status if $err;
141
142 # Find recent builds
143 my $cached_builds = scalar @{$json->{'cachedBuilds'}};
144 my $running_builds = scalar @{$json->{'currentBuilds'}};
145 my $last_build = $json->{'cachedBuilds'}[$cached_builds - $running_builds - 1];
146 return \%status if (not defined $last_build);
147
148 # Get most recent build
149 ($contents, $err) = wget("$BASE_URL/json/$BUILDER_URL/$bot/$BUILD_URL/$last_build");
150 $status{'fail'} = $err;
151 return \%status if $err;
152 ($json, $err) = decode($contents);
153 $status{'fail'} = $err;
154 return \%status if $err;
155
156 # Build number
157 $status{'build'} = $json->{'number'};
158
159 # Status of the last build
160 # "text" : [ "build", "successful" ],
161 # "text" : [ "failed", "svn-llvm" ],
162 my $failed = 0;
163 foreach (@{$json->{'text'}}) {
164 $status{'fail'} .= $_." " if ($failed);
165 $failed = 1 if (/failed|exception/);
166 }
167 $status{'fail'} =~ s/ $//;
168
169 # Commit range
170 # [
171 # 'revision',
172 # '238202',
173 # 'Build'
174 # ],
175 my $max = 0;
176 foreach (@{$json->{'properties'}}) {
177 if ($_->[0] eq 'revision') {
178 $max = $_->[1];
179 last;
180 }
181 }
182 # Min is in the changes' section
183 my $min = $max;
184 foreach (@{$json->{'sourceStamp'}->{'changes'}}) {
185 my $commit = $_->{'revision'};
186 $min = $commit if ($commit < $min);
187 }
188 $status{'from'} = $min;
189 $status{'to'} = $max;
190
191 return \%status;
192}
193
194# WGET: uses LWP to get an URL, returns contents (or error).
195# (url) -> (contents, error)
196sub wget() {
197 my ($url) = @_;
198 my ($contents, $error) = ("", "");
199
200 my $ua = LWP::UserAgent->new;
201 $ua->agent("LLVM BotMonitor/0.1");
202 my $req = HTTP::Request->new(GET => $url);
203 my $res = $ua->request($req);
204
205 if ($res->is_success) {
206 $contents = $res->content;
207 } else {
208 $error = $res->status_line;
209 }
210 return ($contents, $error);
211}
212
213# READ FILE: Reads a local file, returns contents
214# (filename) -> (contents)
215sub read_file() {
216 my ($file) = @_;
217 my ($contents, $error) = ("", "");
218 if (open FH, $file) {
219 while (<FH>) { $contents .= $_; }
220 close FH;
221 } else {
222 $error = "Can't open config file $file: $!";
223 }
224 return ($contents, $error);
225}
226
227# DECODE: Reads contents, returns JSON output (or error)
228# (contents) -> (JSON, error)
229sub decode() {
230 my ($contents) = @_;
231 my ($json, $error) = ("", "");
232 eval { $json = decode_json($contents); };
233 if ($@) {
234 if ($DEBUG) {
235 $error = $@;
236 } else {
237 $error = "JSON error";
238 }
239 }
240 return ($json, $error);
241}
242
243# DEBUG: Prints debug messages if debug enabled
244# (msg) -> ()
245sub debug () {
246 my ($msg) = @_;
247 print STDERR $msg if ($DEBUG);
248}