monitor/bot-status

#!/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>&nbsp;</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>&nbsp;</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>&nbsp;</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>&nbsp;</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);
}