Renato Golin | 94cc104 | 2016-04-26 11:02:23 +0100 | [diff] [blame] | 1 | #!/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 | |
| 13 | push @INC, `dirname $0`; |
| 14 | |
| 15 | use strict; |
| 16 | use warnings; |
| 17 | # Core modules |
| 18 | use File::Temp qw/tempfile/; |
| 19 | use File::Copy; |
| 20 | # This is not part of core, but you really *need* it. |
| 21 | use JSON; |
| 22 | # This can be replaced by `wget/curl` |
| 23 | use LWP; |
| 24 | use LWP::UserAgent; |
| 25 | # We don't have DateTime everywhere... |
| 26 | my $date = `date`; |
| 27 | # DEBUG |
| 28 | my $DEBUG = 0; |
| 29 | |
| 30 | ######################################################### Initialisation |
| 31 | # Option checking |
| 32 | my $syntax = "$0 config-file.json output-file.html\n"; |
| 33 | die $syntax unless (scalar @ARGV == 2); |
| 34 | # Read config file |
| 35 | my ($config, $error) = &read_file($ARGV[0]); |
| 36 | die $error if ($error); |
| 37 | ($config, $error) = &decode($config); |
| 38 | die $error if ($error); |
| 39 | |
| 40 | # Setup HTML output file |
| 41 | my $output = $ARGV[1]; |
| 42 | my ($temp, $tempname) = tempfile(); |
| 43 | |
| 44 | |
| 45 | ######################################################### Main Logic |
| 46 | # Get status for all bots |
| 47 | my %bot_cache; |
| 48 | my $fail = 0; |
| 49 | foreach 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 |
| 72 | foreach 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> </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> </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> </td>\n"; |
| 100 | } |
Renato Golin | 2f8ac15 | 2016-09-14 17:59:08 +0100 | [diff] [blame] | 101 | 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 Golin | 94cc104 | 2016-04-26 11:02:23 +0100 | [diff] [blame] | 104 | } else { |
Renato Golin | 2f8ac15 | 2016-09-14 17:59:08 +0100 | [diff] [blame] | 105 | print $temp " <td> </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> </td>\n"; |
Renato Golin | 94cc104 | 2016-04-26 11:02:23 +0100 | [diff] [blame] | 112 | } |
| 113 | print $temp "</tr>\n"; |
| 114 | } |
| 115 | } |
| 116 | # Footer |
| 117 | print $temp "</table>\n"; |
| 118 | } |
| 119 | close $temp; |
| 120 | |
| 121 | # Move temp to main (atomic change) |
| 122 | move($tempname, $output); |
| 123 | exit; |
| 124 | |
| 125 | ######################################################### Subs |
| 126 | |
| 127 | # GET STATUS: get the status of an individual bot |
| 128 | # (botname, base url, builder url, build url) -> (status) |
| 129 | sub 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) |
| 196 | sub 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) |
| 215 | sub 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) |
| 229 | sub 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) -> () |
| 245 | sub debug () { |
| 246 | my ($msg) = @_; |
| 247 | print STDERR $msg if ($DEBUG); |
| 248 | } |