@@ -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.
new file mode 100755
@@ -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->();
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