ts-host-reuse: New script, to do reuse state changes

This will be made part of the test job recipes.

We calculate the sharing scope (sharetype) by reference to a lot of
runvars, etc.

This version of the script is rather far from the finished working
one, but it seems better to preserve the actual history for how it got
the way it is.

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

diff --git a/ts-host-reuse b/ts-host-reuse
new file mode 100755 (executable)
index 0000000..e14a914
--- /dev/null
+++ b/ts-host-reuse
@@ -0,0 +1,163 @@
+#!/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/>.
+
+# usage:
+#   ./ts-host-reuse prealloc|start-test|post-test IDENT [ARGS...]
+#
+# Computes the sharing scope of the host for IDENT, and then
+#
+#   prealloc      Sets the share-* runtime hostflag appropriately
+#
+#   start-test    Expects the host to have previously been `prep'
+#                 (being prepared) or `ready'.
+#                 Marks it as `mid-test'.
+#
+#                 All the scripts before `ready' or `start-test', (at
+#                 least, ones which affect the host) should have been
+#                 marked with @, so that they are skipped when the
+#                 host is shared or reused.
+#
+#   post-test     Expects the host to have previously been `mid-test'
+#                 Does a small amount of cleanup, deleting some things
+#                 which take a lot of space.
+#                 Then marks the host as `ready' for reuse.
+#                 Must not be done if test arrangements had unexpected
+#                 failures which might leave host in an odd state.
+
+use strict qw(vars);
+use DBI;
+BEGIN { unshift @INC, qw(.); }
+use Osstest;
+use POSIX;
+use Osstest::TestSupport;
+
+tsreadconfig();
+
+die unless @ARGV==2;
+
+our ($action, $whhost) = @ARGV;
+
+our $ho;
+
+#---------- compute $sharetype ----------
+
+our $sharetype;
+
+sub sharetype_add ($$) {
+    my ($k, $v) = @_;
+    return unless defined $v;
+    $sharetype .= "/$k=$v";
+}
+
+sub compute_test_sharetype () {
+    $sharetype =
+       "test-$flight/$r{arch}/$r{xenbuildjob}/$r{kernbuildjob}/$r{buildjob}";
+
+    sharetype_add('suite', $ho->{Suite});
+    sharetype_add('di', $ho->{DiVersion});
+
+    foreach my $runvar (qw(freebsd_distpath freebsdbuildjob
+                          bios xenable_xsm toolstack kernkind)) {
+       my $val = $r{$runvar};
+       die "$runvar $val ?" if defined $val && $val =~ m{[,/\%\\]};
+       sharetype_add($runvar, $val);
+    }
+
+    return $sharetype;
+}
+
+#---------- functions ----------
+
+sub post_test_cleanup () {
+    my $script = <<'ENDQ';
+        set -e
+        cd /root
+        du -skx * | while read size thing; do
+            printf '%10d %s' "$size" "$thing"
+            if [ $size -gt 11000 ]; then
+                printf ' removing'
+                rm -rf -- "$thing"
+            fi
+            printf '\n'
+        done
+ENDQ
+    my $r_vals = sub {
+       my ($re) = @_;
+       map { $r{$_} }
+            sort
+           grep /$re/,
+           keys %r;
+    };
+    my @vgs = $r_vals->(qr{_vg$});
+    my @lvs = $r_vals->(qr{_lv$});
+    $script .= <<ENDI.<<'ENDQ';
+        for vg in @vgs; do
+            for lv in @lvs; do
+ENDI
+                dev=/dev/$vg/$lv
+                printf 'LV %s...\n' "$dev"
+                if ! test -e $dev; then continue; fi
+                dd if=/dev/urandom bs=1024 count=4096 of=$dev ||:
+                lvremove -f $dev
+            done
+        done
+ENDQ
+    target_cmd_root($ho, $script, 300);
+}
+
+#---------- functionality shared between actions ----------
+
+sub noop_if_playing () {
+    my $wantreuse = $ENV{'OSSTEST_REUSE_TEST_HOSTS'};
+    my $intended = intended_blessing();
+    if (!defined $wantreuse) {
+       $wantreuse = $intended !~ /play/;
+    }
+    if (!$wantreuse) {
+       logm("not reusing test hosts (in $intended flight)");
+       exit 0;
+    }
+}
+
+#---------- actions ----------
+
+sub act_prealloc () {
+    noop_if_playing();
+    compute_test_sharetype();
+    $ho = selecthost($whhost, undef, 1);
+    set_runtime_hostflag($ho->{Ident}, "reuse-$sharetype");
+}
+
+sub act_start_test () {
+    compute_test_sharetype();
+    $ho = selecthost($whhost);
+    return unless $ho->{Shared};
+    my %oldstate = map { $_ => 1 } qw(prep ready);
+    host_shared_mark_ready($ho, $sharetype, \%oldstate, 'mid-test');
+}
+
+sub act_post_test () {
+    compute_test_sharetype();
+    $ho = selecthost($whhost);
+    return unless $ho->{Shared};
+    die unless $ho->{Shared}{State} eq 'mid-test';
+    post_test_cleanup();
+    host_shared_mark_ready($ho, $sharetype, 'mid-test', 'ready');
+}
+
+$action =~ y/-/_/;
+&{"act_$action"}();