[OSSTEST PATCH 3/3] anointments: Introduce anointment scheme, and mg-anoint script

[Ian Jackson <ian.jackson@eu.citrix.com>]

CC: Roger Pau Monne <roger.pau@citrix.com>
Signed-off-by: Ian Jackson <Ian.Jackson@eu.citrix.com>
---
 README.planner |   4 +
 mg-anoint      | 347 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 351 insertions(+)
 create mode 100755 mg-anoint

diff --git a/README.planner b/README.planner
index b3b41a9..255460b 100644
--- a/README.planner
+++ b/README.planner
@@ -133,6 +133,10 @@ Types of task
    mg-execute-flight).  They are automatically created and destroyed -
    see above.
 
+ * `anoint' tasks.  These are not really ongoing tasks; but they
+   represent something that can `own' a flight.  Each anointment kind
+   is represented by an `anoint' task.
+
  * `xdbref' tasks.  These are used to own resources whose allocation
    authority has been transferred to a separate database, eg a test
    database.  The refkey is an indication of the other database.
diff --git a/mg-anoint b/mg-anoint
new file mode 100755
index 0000000..4bb8ab0
--- /dev/null
+++ b/mg-anoint
@@ -0,0 +1,347 @@
+#!/usr/bin/perl -w
+#
+# usage:
+#
+#  ./mg-anoint prepare [PARAM...] REFKEY DESCRIPTION
+#        REFKEY should be 'SCOPE DETAILS...'
+#     PARAMs are:
+#        --keep=<number to keep>                 default is 3
+#        --blessings=<allowable-blessing>,...    default is just "real"
+#
+#  ./mg-anoint destroy REFKEY
+#
+#  ./mg-anoint anoint [ANOINT-OPTION...] REFKEY FLIGHT JOB
+#     ANOINT-OPTIONs are:
+#        --allow-blessed=BLESSING,...       default is from `prepare'
+#        --allow-job-status=STATUS,...      default is only `pass'
+#
+#  ./mg-anoint retrieve REFKEY
+#      => FLIGHT JOB
+#         if nothing anointed yet, prints nothing and exits 0
+#         if anointment not prepared, fails
+#
+#  ./mg-anoint list
+#      => human-readable output
+
+# This is part of "osstest", an automated testing framework for Xen.
+# Copyright (C) 2009-2013,2017 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/>.
+
+# Each flavour of anointment is represented by a row in tasks:
+#
+# type      anoint
+# refkey    <scope> <details...>
+#   the flavour, eg   freebsd build <bsdbranch> <arch>
+# username  NULL
+# comment   <for human consumption>
+# live      t
+# refinfo   keep=<number-to-keep> blessings=<blessing>,...
+#
+# Each anointment is represented by a row in resources:
+#
+# restype    'share-flight'
+# resname    <flight>
+# owntaskid  <the anointment flavour taskid>
+# shareix    <initially, the anointment flavour taskid>
+# subtask    <job>
+
+
+use strict qw(vars refs);
+use DBI;
+unshift @INC, qw(.);
+use Osstest;
+use Osstest::TestSupport;
+use Osstest::Executive;
+use IO::Handle;
+
+csreadconfig();
+
+our @o;
+sub pr_o () { print $_, "\n" or die $! foreach @o; }
+
+our $anointments_qtxt = <<END;
+      anointments AS (
+        SELECT f.flight   flight,
+               f.started  started,
+               r.shareix  shareix,
+               r.subtask  job
+          FROM resources r
+          JOIN flights   f
+            ON r.restype   = 'share-flight'
+           AND r.resname   = text(f.flight)
+           AND r.owntaskid = ?
+           AND f.started IS NOT NULL
+      )
+END
+
+our $task_q;
+our $mostrecent_q;
+
+sub prep_queries {
+    $task_q = $dbh_tests->prepare(<<END);
+        SELECT taskid, refinfo FROM tasks WHERE type='anoint' AND refkey=?
+END
+
+    $mostrecent_q = $dbh_tests->prepare(<<END);
+	    WITH $anointments_qtxt
+          SELECT * FROM anointments
+	ORDER BY started DESC LIMIT 1
+END
+}
+
+sub cmd_prepare {
+    my %params = (keep => 3,
+		  blessings => 'real');
+    while (@ARGV && $ARGV[0] =~ m/^-/) {
+	$_= shift @ARGV;
+	last if m/^\-\-?$/;
+	if (m/^--(keep)=(\d+)$/) {
+	    $params{$1} = $2 + 0;
+	} elsif (m/^--(blessings)=([-+0-9a-z,]+)$/) {
+	    $params{$1} = $2;
+	} else {
+	    die "unknown option $_ ?";
+	}
+    }
+    die "usage: mg-anoint prepare [OPTIONS] 'SCOPE DETAILS...' DESCRIPTION"
+	unless @ARGV==2 || $ARGV[0] =~ m/ /;
+    my ($refkey, $description) = @ARGV;
+    my $dq = $dbh_tests->prepare(<<END);
+        DELETE FROM tasks WHERE type='anoint' AND refkey=?
+END
+    my $iq = $dbh_tests->prepare(<<END);
+        INSERT INTO tasks (type,live, refkey,comment,refinfo)
+                    VALUES ('anoint','t', ?,?,?)
+END
+    my $refinfo = join ' ', map { "$_=$params{$_}" } sort keys %params;
+    db_retry($dbh_tests, [], sub {
+        @o = ();
+        $dq->execute($refkey);
+        $iq->execute($refkey, $description, $refinfo);
+    });
+    pr_o();
+}
+
+sub cmd_destroy {
+    die unless @ARGV==1;
+    die if $ARGV[0] =~ m/^-/;
+    my ($refkey) = @ARGV;
+    my $rdq = $dbh_tests->prepare(<<END);
+        DELETE FROM resources
+              WHERE restype='share-flight'
+                AND owntaskid = (SELECT taskid
+				   FROM tasks
+				  WHERE type='anoint'
+				    AND refkey=?)
+END
+    my $tdq = $dbh_tests->prepare(<<END);
+        DELETE FROM tasks WHERE type='anoint' AND refkey=?
+END
+    db_retry($dbh_tests, [], sub {
+        @o = ();
+        $rdq->execute($refkey);
+        $tdq->execute($refkey);
+    });
+    pr_o();
+}
+
+sub cmd_anoint {
+    my $allow_blessed = '';
+    my $allow_jobstatus = '';
+    while (@ARGV && $ARGV[0] =~ m/^-/) {
+	$_= shift @ARGV;
+	last if m/^\-\-?$/;
+	if (m/^--allow-blessed=/) {
+	    $allow_blessed = $';	
+	} elsif (m/^--allow-job-status=/) {
+	    $allow_jobstatus = $';	
+	} else {
+	    die "unknown option $_ ?";
+	}
+    }
+    die unless @ARGV==3;
+    my ($refkey, $flight, $job) = @ARGV;
+
+    prep_queries();
+
+    my $newflight_q = $dbh_tests->prepare(<<END);
+        SELECT * FROM flights WHERE flight=?
+END
+    my $newjob_q = $dbh_tests->prepare(<<END);
+        SELECT status FROM jobs WHERE flight=? AND job=?
+END
+
+    my $count_q = $dbh_tests->prepare(<<END);
+	    WITH $anointments_qtxt
+          SELECT count(*) FROM anointments
+END
+    my $todelete_q = $dbh_tests->prepare(<<END);
+	     WITH $anointments_qtxt
+           SELECT *
+             FROM anointments
+         ORDER BY started ASC
+            LIMIT ?
+END
+    my $delete_res_q = $dbh_tests->prepare(<<END);
+            DELETE FROM resources
+             WHERE restype   = 'share-flight'
+               AND owntaskid = ?
+               AND resname   = ?
+               AND shareix   = ?
+END
+    my $insert_q = $dbh_tests->prepare(<<END);
+       INSERT INTO resources
+                   (restype, resname,owntaskid,shareix,subtask)
+            VALUES ('share-flight', ?,?,?,?)
+END
+
+    db_retry($dbh_tests, [], sub {
+	@o = ();
+        $task_q->execute($refkey);
+
+	# find the task row (ie, the anointment kind)
+	my ($task, $refinfo) = $task_q->fetchrow_array();
+	die "no such anointment kind \`$refkey' (no prepare?)\n"
+	    unless defined $task;
+	my %params;
+	foreach (split /\s+/, $refinfo) {
+	    die unless m/=/;
+	    $params{$`} = $';
+	}
+	my %blessings;
+	$blessings{$_}++ foreach
+	    grep /./,
+	    (split /,/, $params{blessings}),
+	    (split /,/, $allow_blessed);
+
+	my %jobstatus;
+	$jobstatus{pass}++;
+	$jobstatus{$_}++ foreach grep /./, split /,/, $allow_jobstatus;
+
+	# check the to-be-anointed flight's blessing
+	$newflight_q->execute($flight);
+	my $frow = $newflight_q->fetchrow_hashref();
+	die "flight $flight missing" unless $frow;
+	die "flight $flight not started" unless defined $frow->{started};
+
+	# check the job status
+	$newjob_q->execute($flight, $job);
+	my ($jstatus) = $newjob_q->fetchrow_array();
+	die "job $flight.$job missing" unless defined $jstatus;
+	die "job $flight.$job status $jstatus" unless $jobstatus{$jstatus};
+
+	push @o, "flight $flight blessed $frow->{blessing}".
+	         " started ".show_abs_time($frow->{started});
+
+	die "flight $flight blessing $frow->{blessing}".
+	    " (not $params{blessings} / $allow_blessed)"
+	    unless $blessings{ $frow->{blessing} };
+
+	# check to-be-annointed flight is most recent
+	$mostrecent_q->execute($task);
+	my $mostrecent = $mostrecent_q->fetchrow_hashref();
+	die "flight $flight not newer than $mostrecent->{flight}"
+	    unless $frow->{started} > ($mostrecent->{started} // 0);
+
+	# expire old anointments
+	$count_q->execute($task);
+	my ($current) = $count_q->fetchrow_array();
+	my $want_delete = ($current+1) - $params{keep};
+	push @o, "anointment $refkey: currently $current anointed";
+	if ($want_delete > 0) {
+	    $todelete_q->execute($task, $want_delete);
+	    while (my $d = $todelete_q->fetchrow_hashref()) {
+		push @o, " expiring $d->{flight}.$d->{job} [/$d->{shareix}]".
+		    " started ".show_abs_time($d->{started});
+		$delete_res_q->execute($task, $d->{flight}, $d->{shareix});
+	    }
+	}
+
+	# at last!
+	$insert_q->execute($flight,$task,$task,$job);
+	push @o, "anointed $flight.$job";
+    });
+    pr_o();
+}    
+
+sub cmd_retrieve {
+    die unless @ARGV==1;
+    die if $ARGV[0] =~ m/^-/;
+    my ($refkey) = @ARGV;
+
+    prep_queries();
+
+    db_retry($dbh_tests, [], sub {
+        @o = ();
+        $task_q->execute($refkey);
+	my ($task) = $task_q->fetchrow_array();
+	die "no such anointment kind \`$refkey'" unless defined $task;
+
+	$mostrecent_q->execute($task);
+	my $row = $mostrecent_q->fetchrow_hashref();
+	if ($row) {
+	    push @o, "$row->{flight} $row->{job}";
+	} else {
+	    print STDERR "warning: nothing anointed $refkey\n";
+	}
+    });
+    pr_o();
+};
+
+sub cmd_list {
+    die "no options to list" if @ARGV;
+
+    my $tq = $dbh_tests->prepare(<<END);
+        SELECT *
+          FROM tasks
+         WHERE type = 'anoint'
+      ORDER BY refkey
+END
+    my $rq = $dbh_tests->prepare(<<END);
+        SELECT *
+          FROM resources
+         WHERE owntaskid = ?
+END
+
+    db_retry($dbh_tests, [], sub {
+        @o = ();
+        db_readonly_report();
+	$tq->execute();
+	while (my $t = $tq->fetchrow_hashref()) {
+	    push @o, sprintf "%s [%s] (%s)",
+		$t->{refkey}, $t->{refinfo}, $t->{comment};
+	    push @o, " ! NOT LIVE" unless $t->{live};
+	    push @o, " ! username=$t->{username}" if defined $t->{username};
+	    $rq->execute($t->{taskid});
+	    while (my $r = $rq->fetchrow_hashref()) {
+		if ($r->{restype} eq 'share-flight') {
+		    push @o, "  $r->{resname}.$r->{subtask}";
+		} else {
+		    push @o, "  ! $r->{restype}/$r->{resname}/$r->{subtask}";
+		}
+	    }
+	}
+    });
+    pr_o();
+}
+
+die 'need operation' unless @ARGV;
+die 'no global options understood' if $ARGV[0] =~ m/^-/;
+
+my $subcmd= shift @ARGV;
+$subcmd =~ s/-/_/g;
+my $subcmdproc = ${*::}{"cmd_$subcmd"};
+die "unknown subcommand" unless $subcmdproc;
+$subcmdproc->();
-- 
2.1.4


_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xen.org
https://lists.xen.org/xen-devel