host examination: Permanently save the logs

After this, we retain some of the logs from the last examination of
each host, in a directory in results/ named after the host.

The logic for computing the destination directory has similar env var
logic to that used in the invocation of sg-report-host-history but if
those are not set (as they usually won't be) has config-based
fallback.

In Standalone mode enough of these variables must be set to avoid
calling blessing_suffix, since we don't want the filename to depend on
a not-really-very-useful (and not implemented by intended_blessing)
Standalone flight's intended blessing.

Signed-off-by: Ian Jackson <Ian.Jackson@eu.citrix.com>

diff --git a/ts-examine-logs-save b/ts-examine-logs-save
new file mode 100755 (executable)
index 0000000..014522a
--- /dev/null
+++ b/ts-examine-logs-save
@@ -0,0 +1,106 @@
+#!/usr/bin/perl -w
+# This is part of "osstest", an automated testing framework for Xen.
+# Copyright (C) 2009-2013 Citrix Inc.
+# 
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU Affero General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+# 
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU Affero General Public License for more details.
+# 
+# You should have received a copy of the GNU Affero General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict qw(vars);
+unshift @INC, qw(.);
+use Osstest;
+use Osstest::TestSupport;
+
+use POSIX;
+use File::Path qw(rmtree);
+
+tsreadconfig();
+
+if (!$mjobdb->jobdb_enable_log_capture) {
+    die "log capturing not enabled";
+}
+
+our ($whhost) = @ARGV;
+$whhost ||= 'host';
+our $ho= selecthost($whhost);
+
+our $dstdir;
+our $td;
+
+sub blessing_suffix () {
+    my $b = intended_blessing();
+    return $b eq 'real' ? '' : "-$b";
+}
+
+sub dstdir_prep () {
+    my $hdir =
+       ($ENV{OSSTEST_HTML_DIR} //
+        ($ENV{OSSTEST_HTML_DIR} // $c{PubBaseDir}).'/'.
+        ($ENV{OSSTEST_HTML_SUBDIR} // 'results'.
+         ($ENV{OSSTEST_HTML_SUFFIX} // blessing_suffix()))).
+             '/host';
+    if (!stat "$hdir") {
+       die "$hdir $!" unless $!==ENOENT;
+       logm("$hdir: $! - not saving logs");
+       exit 0;
+    }
+    # concurrency: lock is the host allocation
+    $dstdir = "$hdir/$ho->{Name}.examine";
+    $td = "$dstdir.tmp";
+    logm("constructing in $td");
+    rmtree $td;
+    mkdir $td or die "$td: $!";
+}
+
+sub mustrename ($$) {
+    rename $_[0],$_[1] or die "@_ $!";
+}
+
+sub dstdir_commit () {
+    mustrename "$td",         "$dstdir.new";
+    rename     "$dstdir",     "$dstdir.old" or $!==ENOENT or die "$dstdir $!";
+    mustrename "$dstdir.new", "$dstdir";
+    rmtree "$dstdir.old";
+    logm("installed new $dstdir");
+}
+
+sub save_logs () {
+    my @re;
+    no warnings qw(qw);
+    foreach my $pat (qw(---var-log-dmesg
+                       ---var-log-dmesg\.0
+                       -output-cat_#proc#cpuinfo
+                       -output-cat_#proc#modules
+                       -output-cat_#proc#partitions
+                       -output-ifconfig
+                       -output-lspci_-tv)) {
+       my $re = $pat;
+       $re =~ s/^-/\Q$ho->{Name}\E-/;
+       push @re, "^$re\$";
+    }
+    my $re = join '|', @re;
+    logm("saving files matching $re");
+
+    opendir D, $stash or die "$stash $!";
+    while ($!=0, defined (my $f = readdir D)) {
+       #print STDERR ">$f<\n";
+       next unless $f =~ m/$re/o;
+       logm("saving $f");
+       link "$stash/$f", "$td/$f" or die "$stash $td $f $!";
+    }
+    die "$stash $!" if $!;
+    closedir D;
+}
+
+dstdir_prep();
+save_logs();
+dstdir_commit();