Initial checkin
authorMans Rullgard <mans@mansr.com>
Sun, 25 Jul 2010 16:16:31 +0000 (17:16 +0100)
committerMans Rullgard <mans@mansr.com>
Sun, 25 Jul 2010 16:16:31 +0000 (17:16 +0100)
FATE.pm [new file with mode: 0644]
fate-recv.sh [new file with mode: 0755]
fate.css [new file with mode: 0644]
history.cgi [new file with mode: 0755]
index.cgi [new file with mode: 0755]
report.cgi [new file with mode: 0755]

diff --git a/FATE.pm b/FATE.pm
new file mode 100644 (file)
index 0000000..9c306d5
--- /dev/null
+++ b/FATE.pm
@@ -0,0 +1,111 @@
+package FATE;
+
+use strict;
+use warnings;
+
+BEGIN {
+    use Exporter;
+    our ($VERSION, @ISA, @EXPORT);
+    $VERSION = 0.1;
+    @ISA     = qw/Exporter/;
+    @EXPORT  = qw/doctype start end tag h1 trow trowa trowh td fail/;
+}
+
+# HTML helpers
+
+my %block_tags;
+my @block_tags = ('html', 'head', 'style', 'body', 'table');
+$block_tags{$_} = 1 for @block_tags;
+
+my @tags;
+
+sub doctype {
+    print q{<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">}, "\n";
+}
+
+sub opentag {
+    my ($tag, %attrs) = @_;
+    print qq{<$tag};
+    print qq{ $_="$attrs{$_}"} for keys %attrs;
+}
+
+sub start {
+    my ($tag, %attrs) = @_;
+    opentag @_;
+    print '>';
+    print "\n" if defined $block_tags{$tag};
+    push @tags, $tag;
+}
+
+sub end {
+    my ($end) = @_;
+    my $tag;
+    do {
+        $tag = pop @tags or last;
+        print "</$tag>";
+        print "\n" if defined $block_tags{$tag};
+    } while (defined $end and $tag ne $end);
+}
+
+sub tag {
+    opentag @_;
+    print "/>\n";
+}
+
+sub h1 {
+    my ($text, %attrs) = @_;
+    start 'h1', %attrs;
+    print $text;
+    end;
+    print "\n";
+}
+
+sub trow {
+    start 'tr';
+    print "<td>$_</td>" for @_;
+    end;
+    print "\n";
+}
+
+sub trowh {
+    start 'tr';
+    print "<th>$_</th>" for @_;
+    end;
+    print "\n";
+}
+
+sub trowa {
+    my $attrs = shift;
+    start 'tr', %{$attrs};
+    print "<td>$_</td>" for @_;
+    end;
+    print "\n";
+}
+
+sub td {
+    my ($text, %attrs) = @_;
+    start 'td', %attrs;
+    print $text;
+    end;
+}
+
+sub fail {
+    my ($msg) = @_;
+    print "Content-type: text/html\r\n\r\n";
+    doctype;
+    start 'html', xmlns => "http://www.w3.org/1999/xhtml";
+    start 'head';
+    tag 'meta', 'http-equiv' => "Content-Type",
+                'content'    => "text/html; charset=utf-8";
+    print "<title>FATE error</title>\n";
+    end 'head';
+
+    start 'body';
+    h1 "FATE error", id => 'title';
+    print "$msg\n";
+    end 'body';
+    end 'html';
+    exit 1;
+}
+
+1;
diff --git a/fate-recv.sh b/fate-recv.sh
new file mode 100755 (executable)
index 0000000..f113ed2
--- /dev/null
@@ -0,0 +1,38 @@
+#! /bin/sh
+
+set -e
+
+die(){
+    echo "$@"
+    exit 1
+}
+
+fatedir=/tmp/fate-reports
+
+reptmp=$(mktemp -d)
+trap 'rm -r $reptmp' EXIT
+cd $reptmp
+
+tar xz
+
+header=$(head -n1 report)
+date=$(expr "$header" : 'fate:0:\([0-9]*\)')
+slot=$(expr "$header" : 'fate:0:[0-9]*:\([^:]*\)')
+
+test -n "$date" && test -n "$slot" || die "Invalid report header"
+
+slotdir=$fatedir/$slot
+
+if [ -d "$slotdir" ]; then
+    owner=$(cat "$slotdir/owner")
+    test "$owner" = "$FATE_USER" || die "Slot $slot owned by somebody else"
+else
+    mkdir "$slotdir"
+    echo "$FATE_USER" >"$slotdir/owner"
+fi
+
+repdir=$slotdir/$date
+mkdir $repdir
+cp -p report *.log $repdir
+rm -f $slotdir/latest
+ln -s $date $slotdir/latest
diff --git a/fate.css b/fate.css
new file mode 100644 (file)
index 0000000..b97346a
--- /dev/null
+++ b/fate.css
@@ -0,0 +1,40 @@
+body {
+    background: white;
+    color: black;
+    font-family: sans-serif;
+}
+
+table {
+    border-collapse: collapse;
+}
+
+th {
+    background: #ccc;
+    border: solid 1px black;
+    border-bottom: solid 2px black;
+    padding: 0.5em;
+}
+
+#index td, #tests td {
+    border: solid 1px black;
+    padding: 0 0.5em;
+}
+
+.fail { background: #e33; }
+.pass { background: #5e5; }
+.warn { background: #ff3; }
+
+#index, #tests {
+    border: solid 2px black;
+    margin-top: 2em;
+}
+
+#config td:first-child {
+    font-weight: bold;
+    padding-right: 3em;
+}
+
+.diff {
+    font-family: monospace;
+    white-space: pre;
+}
diff --git a/history.cgi b/history.cgi
new file mode 100755 (executable)
index 0000000..f5e05e0
--- /dev/null
@@ -0,0 +1,67 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use CGI qw/param/;
+use FATE;
+
+our $fatedir;
+require "$ENV{FATEWEB_CONFIG}";
+
+my $slot = param 'slot';
+my $slotdir = "$fatedir/$slot";
+
+opendir D, $slotdir or fail "Slot $slot not found";
+my @reps = grep { /^[0-9]/ and -d "$slotdir/$_" } readdir D;
+close D;
+
+print "Content-type: text/html\r\n\r\n";
+
+doctype;
+start 'html', xmlns => "http://www.w3.org/1999/xhtml";
+start 'head';
+tag 'meta', 'http-equiv' => "Content-Type",
+            'content'    => "text/html; charset=utf-8";
+tag 'link', rel  => 'stylesheet',
+            type => 'text/css',
+            href => 'fate.css';
+print "<title>FATE: $slot</title>\n";
+end 'head';
+
+start 'body';
+h1 "Report history for $slot";
+
+start 'table', id => 'index';
+trowh 'Time', 'Arch', 'OS', 'Compiler', 'Rev', 'Status', 'Tests';
+for my $rep (sort { $b cmp $a } @reps) {
+    open R, "$slotdir/$rep/report";
+    my @header = split /:/, scalar <R>;
+    my @config = split /:/, scalar <R>;
+    my ($date, $slot, $rev, $err, $errstr) = @header[2..6];
+    my ($arch, $subarch, $cpu, $os, $cc) = @config[1..5];
+    my $ntest;
+    my $npass;
+    while (<R>) {
+        my @rec = split /:/;
+        $rec[1] == 0 and $npass++;
+        $ntest++;
+    }
+    close R;
+    start 'tr';
+    td $date;
+    td $subarch;
+    td $os;
+    td $cc;
+    td $rev;
+    td $errstr, class => $err? 'fail' : 'pass';
+    start 'td', class => $npass==$ntest? 'pass' : $npass? 'warn' : 'fail';
+    start 'a', href => "report.cgi?slot=$slot&time=$date";
+    print "$npass / $ntest";
+    end 'a';
+    end 'td';
+    end 'tr';
+}
+end 'table';
+end 'body';
+end 'html';
diff --git a/index.cgi b/index.cgi
new file mode 100755 (executable)
index 0000000..1d8620f
--- /dev/null
+++ b/index.cgi
@@ -0,0 +1,65 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use FATE;
+
+our $fatedir;
+require "$ENV{FATEWEB_CONFIG}";
+
+opendir D, $fatedir or fail 'Server error: $fatedir not found';
+my @slots = grep /^[^.]/, readdir D;
+closedir D;
+
+print "Content-type: text/html\r\n\r\n";
+
+doctype;
+start 'html', xmlns => "http://www.w3.org/1999/xhtml";
+start 'head';
+tag 'meta', 'http-equiv' => "Content-Type",
+            'content'    => "text/html; charset=utf-8";
+tag 'link', rel  => 'stylesheet',
+            type => 'text/css',
+            href => 'fate.css';
+print "<title>FATE</title>\n";
+end 'head';
+
+start 'body';
+h1 'FATE';
+
+start 'table', id => 'index';
+trowh 'Time', 'Arch', 'OS', 'Compiler', 'Rev', 'Status', 'Tests';
+for my $slot (@slots) {
+    open R, "$fatedir/$slot/latest/report";
+    my @header = split /:/, scalar <R>;
+    my @config = split /:/, scalar <R>;
+    my ($date, $slot, $rev, $err, $errstr) = @header[2..6];
+    my ($arch, $subarch, $cpu, $os, $cc) = @config[1..5];
+    my $ntest;
+    my $npass;
+    while (<R>) {
+        my @rec = split /:/;
+        $rec[1] == 0 and $npass++;
+        $ntest++;
+    }
+    close R;
+    start 'tr';
+    start 'td'; start 'a', href => "history.cgi?slot=$slot";
+    print $date;
+    end 'td';
+    td $subarch;
+    td $os;
+    td $cc;
+    td $rev;
+    td $errstr, class => $err? 'fail' : 'pass';
+    start 'td', class => $npass==$ntest? 'pass' : $npass? 'warn' : 'fail';
+    start 'a', href => "report.cgi?slot=$slot&time=$date";
+    print "$npass / $ntest";
+    end 'a';
+    end 'td';
+    end 'tr';
+}
+end 'table';
+end 'body';
+end 'html';
diff --git a/report.cgi b/report.cgi
new file mode 100755 (executable)
index 0000000..8cdf3ba
--- /dev/null
@@ -0,0 +1,94 @@
+#! /usr/bin/perl
+
+use strict;
+use warnings;
+
+use CGI qw/param/;
+use HTML::Entities;
+use MIME::Base64;
+use FATE;
+
+our $fatedir;
+require "$ENV{FATEWEB_CONFIG}";
+
+my $req_slot = param 'slot';
+my $req_time = param 'time';
+
+my $repdir = "$fatedir/$req_slot/$req_time";
+my $report = "$repdir/report";
+
+open R, $report or fail 'Requsted report not found';
+
+my @header = split /:/, scalar <R>;
+$header[0] eq 'fate' or die "Bad magic";
+$header[1] eq '0'    or die "Bad report version";
+my ($date, $slot, $rev, $err, $errstr) = @header[2..6];
+
+my @config = split /:/, scalar <R>;
+my ($arch, $subarch, $cpu, $os, $cc, $config) = @config[1..6];
+if ($config[0] ne 'config') {
+    print "Error in report: exptected 'config', found '$config[0]'\n";
+    exit 1;
+}
+
+my @recs;
+my %pass;
+my %fail;
+
+while (<R>) {
+    my @rec = split /:/;
+    ${$rec[1]? \%fail: \%pass}{$rec[0]} = \@rec;
+}
+
+close R;
+
+my $npass = keys %pass;
+my $nfail = keys %fail;
+my $ntest = $npass + $nfail;
+
+# main text
+
+print "Content-type: text/html\r\n\r\n";
+
+doctype;
+start 'html', xmlns => "http://www.w3.org/1999/xhtml";
+start 'head';
+tag 'meta', 'http-equiv' => "Content-Type",
+            'content'    => "text/html; charset=utf-8";
+tag 'link', rel  => 'stylesheet',
+            type => 'text/css',
+            href => 'fate.css';
+print "<title>FATE: $slot $rev</title>\n";
+end 'head';
+
+start 'body';
+h1 "$slot $rev", id => 'title';
+
+start 'table', id => 'config';
+trow 'Architecture',  $arch;
+trow 'Variant',       $subarch;
+trow 'CPU',           $cpu;
+trow 'OS',            $os;
+trow 'Compiler',      $cc;
+trow 'Configuration', $config;
+trow 'Revision',      $rev;
+trow 'Date',          $date;
+trow 'Status',        $err? $errstr : "$npass / $ntest";
+end;
+
+start 'table', id => 'tests';
+if ($nfail) {
+    trowh 'Failed tests';
+    for my $n (sort keys %fail) {
+        my $rec = $fail{$n};
+        my $diff = encode_entities decode_base64($$rec[2]), '<>&"';
+        trowa { class => 'fail' }, $$rec[0];
+        trowa { class => 'diff' }, $diff;
+    }
+} else {
+    trowa { class => 'pass' }, 'All tests successful';
+}
+end 'table';
+
+end 'body';
+end 'html';