Initial Commit, moving from dev-private and removing private stuff
diff --git a/monitor/bot-status b/monitor/bot-status
new file mode 100755
index 0000000..f2de0ea
--- /dev/null
+++ b/monitor/bot-status
@@ -0,0 +1,244 @@
+#!/usr/bin/env perl
+
+# This script greps the JSON files for the buildbots on
+# the LLVM official build master by name and prints an
+# HTML page with the links to the bots and the status.
+#
+# Multiple masters can be used, as well as multiple groups of bots
+# and multiple bots per group, all in a json file. See linaro.json
+# in this repository to have an idea how the config file is.
+#
+# Module JSON needs to be installed, either from cpan or packages.
+
+push @INC, `dirname $0`;
+
+use strict;
+use warnings;
+# Core modules
+use File::Temp qw/tempfile/;
+use File::Copy;
+# This is not part of core, but you really *need* it.
+use JSON;
+# This can be replaced by `wget/curl`
+use LWP;
+use LWP::UserAgent;
+# We don't have DateTime everywhere...
+my $date = `date`;
+# DEBUG
+my $DEBUG = 0;
+
+######################################################### Initialisation
+# Option checking
+my $syntax = "$0 config-file.json output-file.html\n";
+die $syntax unless (scalar @ARGV == 2);
+# Read config file
+my ($config, $error) = &read_file($ARGV[0]);
+die $error if ($error);
+($config, $error) = &decode($config);
+die $error if ($error);
+
+# Setup HTML output file
+my $output = $ARGV[1];
+my ($temp, $tempname) = tempfile();
+
+
+######################################################### Main Logic
+# Get status for all bots
+my %bot_cache;
+my $fail = 0;
+foreach my $server (@$config) {
+ next if (defined $server->{'ignore'} and $server->{'ignore'} eq "true");
+ my ($BASE_URL, $BUILDER_URL, $BUILD_URL) =
+ ($server->{'base_url'}, $server->{'builder_url'}, $server->{'build_url'});
+ &debug("Parsing server ".$server->{'name'}."...\n");
+ foreach my $builder (@{$server->{'builders'}}) {
+ &debug(" Parsing builder ".$builder->{'name'}."...\n");
+ foreach my $bot (@{$builder->{'bots'}}) {
+ &debug(" Parsing bot ".$bot->{'name'}."...\n");
+ next if defined $bot_cache{$bot->{'name'}};
+ my $status = &get_status($bot->{'name'}, $BASE_URL, $BUILDER_URL, $BUILD_URL);
+ if (!defined $bot->{'ignore'} or $bot->{'ignore'} ne "true") {
+ $fail = 1 if ($status->{'fail'});
+ } else {
+ &debug(" Ignoring...\n");
+ }
+ &debug($status->{'fail'} ? " FAIL\n" : " PASS\n");
+ $bot_cache{$bot->{'name'}} = $status;
+ }
+ }
+}
+
+# Dump all servers / bots
+foreach my $server (@$config) {
+ next if (defined $server->{'ignore'} and $server->{'ignore'} eq "true");
+ my ($BASE_URL, $BUILDER_URL, $BUILD_URL) =
+ ($server->{'base_url'}, $server->{'builder_url'}, $server->{'build_url'});
+ # Favicon
+ my $favicon = $fail ? "fail.ico" : "ok.ico";
+ print $temp "<link rel=\"shortcut icon\" href=\"$favicon\" type=\"image/x-icon\"/>\n";
+ # Header
+ print $temp "<table cellspacing=1 cellpadding=2>\n";
+ print $temp "<tr><td colspan=5> </td><tr>\n";
+ print $temp "<tr><th colspan=5>$server->{'name'} @ $date</td><tr>\n";
+ ## Main loop
+ foreach my $builder (@{$server->{'builders'}}) {
+ print $temp "<tr><td colspan=5> </td><tr>\n";
+ print $temp "<tr><th colspan=5>$builder->{'name'}</td><tr>\n";
+ print $temp "<tr><th>Buildbot</th><th>Status</th><th>Comments</th>".
+ "<th>Build #</th><th>Commits</th></tr>\n";
+ foreach my $bot (@{$builder->{'bots'}}) {
+ print $temp "<tr>\n";
+ my $status = $bot_cache{$bot->{'name'}};
+ my $url = "$BASE_URL/$BUILDER_URL/$bot->{'name'}";
+ print $temp " <td><a href='$url'>$bot->{'name'}</a></td>\n";
+ if ($status->{'fail'}) {
+ print $temp " <td><font color='red'>FAIL</font></td>\n".
+ " <td>$status->{'fail'}</td>\n";
+ } else {
+ print $temp " <td><font color='green'>PASS</font></td>\n".
+ " <td> </td>\n";
+ }
+ if (defined $status->{'build'} and
+ defined $status->{'from'} and
+ defined $status->{'to'}) {
+ print $temp " <td>$status->{'build'}</td>\n".
+ " <td>$status->{'from'}-$status->{'to'}</td>\n";
+ } else {
+ print $temp " <td colspan=2> </td>\n";
+ }
+ print $temp "</tr>\n";
+ }
+ }
+ # Footer
+ print $temp "</table>\n";
+}
+close $temp;
+
+# Move temp to main (atomic change)
+move($tempname, $output);
+exit;
+
+######################################################### Subs
+
+# GET STATUS: get the status of an individual bot
+# (botname, base url, builder url, build url) -> (status)
+sub get_status() {
+ my ($bot, $BASE_URL, $BUILDER_URL, $BUILD_URL) = @_;
+ my ($err, $contents, $json);
+ my %status;
+
+ # Get buildbot main JSON
+ ($contents, $err) = wget("$BASE_URL/json/$BUILDER_URL/$bot");
+ $status{'fail'} = $err;
+ return \%status if $err;
+ ($json, $err) = decode($contents);
+ $status{'fail'} = $err;
+ return \%status if $err;
+
+ # Find recent builds
+ my $cached_builds = scalar @{$json->{'cachedBuilds'}};
+ my $running_builds = scalar @{$json->{'currentBuilds'}};
+ my $last_build = $json->{'cachedBuilds'}[$cached_builds - $running_builds - 1];
+ return \%status if (not defined $last_build);
+
+ # Get most recent build
+ ($contents, $err) = wget("$BASE_URL/json/$BUILDER_URL/$bot/$BUILD_URL/$last_build");
+ $status{'fail'} = $err;
+ return \%status if $err;
+ ($json, $err) = decode($contents);
+ $status{'fail'} = $err;
+ return \%status if $err;
+
+ # Build number
+ $status{'build'} = $json->{'number'};
+
+ # Status of the last build
+ # "text" : [ "build", "successful" ],
+ # "text" : [ "failed", "svn-llvm" ],
+ my $failed = 0;
+ foreach (@{$json->{'text'}}) {
+ $status{'fail'} .= $_." " if ($failed);
+ $failed = 1 if (/failed|exception/);
+ }
+ $status{'fail'} =~ s/ $//;
+
+ # Commit range
+ # [
+ # 'revision',
+ # '238202',
+ # 'Build'
+ # ],
+ my $max = 0;
+ foreach (@{$json->{'properties'}}) {
+ if ($_->[0] eq 'revision') {
+ $max = $_->[1];
+ last;
+ }
+ }
+ # Min is in the changes' section
+ my $min = $max;
+ foreach (@{$json->{'sourceStamp'}->{'changes'}}) {
+ my $commit = $_->{'revision'};
+ $min = $commit if ($commit < $min);
+ }
+ $status{'from'} = $min;
+ $status{'to'} = $max;
+
+ return \%status;
+}
+
+# WGET: uses LWP to get an URL, returns contents (or error).
+# (url) -> (contents, error)
+sub wget() {
+ my ($url) = @_;
+ my ($contents, $error) = ("", "");
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("LLVM BotMonitor/0.1");
+ my $req = HTTP::Request->new(GET => $url);
+ my $res = $ua->request($req);
+
+ if ($res->is_success) {
+ $contents = $res->content;
+ } else {
+ $error = $res->status_line;
+ }
+ return ($contents, $error);
+}
+
+# READ FILE: Reads a local file, returns contents
+# (filename) -> (contents)
+sub read_file() {
+ my ($file) = @_;
+ my ($contents, $error) = ("", "");
+ if (open FH, $file) {
+ while (<FH>) { $contents .= $_; }
+ close FH;
+ } else {
+ $error = "Can't open config file $file: $!";
+ }
+ return ($contents, $error);
+}
+
+# DECODE: Reads contents, returns JSON output (or error)
+# (contents) -> (JSON, error)
+sub decode() {
+ my ($contents) = @_;
+ my ($json, $error) = ("", "");
+ eval { $json = decode_json($contents); };
+ if ($@) {
+ if ($DEBUG) {
+ $error = $@;
+ } else {
+ $error = "JSON error";
+ }
+ }
+ return ($json, $error);
+}
+
+# DEBUG: Prints debug messages if debug enabled
+# (msg) -> ()
+sub debug () {
+ my ($msg) = @_;
+ print STDERR $msg if ($DEBUG);
+}