diff mbox

[OSSTEST,7/8] ts-hosts-allocate-Executive: Support diverse-CLASS hostflag

Message ID 1467819074-16310-8-git-send-email-ian.jackson@eu.citrix.com (mailing list archive)
State New, archived
Headers show

Commit Message

Ian Jackson July 6, 2016, 3:31 p.m. UTC
Specifically:
 * Parse it out of the hostflags when constructing the hid
 * Look for the `hostalloc-diverse-FLIGHT-CLASS' ClientNote in
   the resource plan, to avoid inappropriately planning to reuse hosts.
 * Look for the `diversehosts_CLASS' runvar in other jobs in this flight,
   to find out who might have allocated with the same CLASS.  (This
   sort of duplicates information in *hostflags and *host, but digging
   the information out of the latter two would be very tiresome.)
 * Check each of the above for each candidate host.
 * Set the ClientNote when we are preparing a booking.
 * Set the runvar when we do the allocation.
 * Document the ClientNote.

Signed-off-by: Ian Jackson <Ian.Jackson@eu.citrix.com>
CC: Wei Liu <wei.liu2@citrix.com>
---
 README.planner              |  3 +++
 ts-hosts-allocate-Executive | 59 +++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 60 insertions(+), 2 deletions(-)
diff mbox

Patch

diff --git a/README.planner b/README.planner
index 80c2506..bb18432 100644
--- a/README.planner
+++ b/README.planner
@@ -335,3 +335,6 @@  Note key name (key in ClientNotes):
 	Note value format:
 
 (none yet defined)
+
+hostalloc-diverse-<flight>-<class>
+	{ <hostname> => 'info for debug', ... }
diff --git a/ts-hosts-allocate-Executive b/ts-hosts-allocate-Executive
index d4a96d5..72283de 100755
--- a/ts-hosts-allocate-Executive
+++ b/ts-hosts-allocate-Executive
@@ -213,7 +213,7 @@  sub compute_hids () {
     our %equivs;
 
     foreach my $ident (@ARGV) {
-        my $hid= { Conds => { host => [] } };
+        my $hid= { Conds => { host => [] }, Diverse => [] };
         my $override_use;
         if ($ident =~ m/\=/) {
             $hid->{OverrideUse}= $'; #'
@@ -251,6 +251,11 @@  sub compute_hids () {
                 my $equiv= $hid->{Equiv}= $equivs{$formalclass};
                 print DEBUG "HID $ident FLAG $flag EQUIV $equiv->{Wanted}\n";
                 next;
+            } elsif ($flag =~ m/^diverse-/) {
+                my $dclass= $'; #'
+		push @{ $hid->{Diverse} }, $dclass;
+		print DEBUG "HID $ident FLAG $flag DIVERSE $dclass\n";
+                next;
             } elsif ($flag =~ m/^\w+:/) {
 		my (@c) = split /:/, $flag;
 		my $o;
@@ -322,9 +327,40 @@  END
 	     LIMIT 1;
 END
 
+    # we are looking for other jobs where the runvar diversehosts_CLASS
+    # (a space-separated list of hostnames) has been set
+    my $diverseq = $dbh_tests->prepare(<<END);
+            SELECT r.job, r.val
+              FROM runvars r
+             WHERE r.flight = ?
+               AND r.name = ?
+END
+
     my @candidates;
     my $any=0;
 
+    my %diverse_excluded;
+    # $diverse_excluded{CLASS}{HOST} = 1
+    foreach my $dclass (@{ $hid->{Diverse} }) {
+	print DEBUG "HID $hid->{Ident} DIVERSE $dclass:";
+	# look for allocated
+	$diverseq->execute($flight, "diversehosts_$dclass");
+	my ($djob, $dhosts) = $diverseq->fetchrow_array();
+	my $excl = sub {
+	    my ($dh,$why) = @_;
+	    print DEBUG " $dh ($why)";
+	    $diverse_excluded{$dclass}{$dh} = $why;
+	};
+	if (defined $dhosts) {
+	    $excl->($_, "alloc'd job $job") foreach split / /, $dhosts;
+	}
+	# look for booked
+	my $notekey = "hostalloc-diverse-$flight-$dclass";
+	my $booked = $plan->{ClientNotes}{$notekey};
+	$excl->($_, "boooked ".$booked->{$_}) foreach sort keys %$booked;
+	print DEBUG ".\n";
+    }
+
   CANDIDATE:
     while (my $candrow= $findhostsq->fetchrow_hashref()) {
         $candrow->{Warnings}= [ ];
@@ -375,6 +411,13 @@  END
                 "specified host lacks flags @missingflags";
         }
 
+	foreach my $dclass (@{ $hid->{Diverse} }) {
+	    my $excl = $diverse_excluded{$dclass}{ $candrow->{resname} };
+	    next unless defined $excl;
+	    print DEBUG "$dbg excluded by diverse-$dclass ($excl)\n";
+	    next CANDIDATE unless defined $use;
+	}
+
 	foreach my $c (@{ $hid->{Conds}{$candrow->{restype}} }) {
 	    if (!$c->check($candrow->{restype}, $candrow->{resname})) {
 		print DEBUG "$dbg failed $c condition\n";
@@ -629,6 +672,13 @@  sub alloc_hosts () {
         my $use= $r{ $hid->{Ident} };
         next if defined $use;
         store_runvar($hid->{Ident}, $sel->{resname});
+	foreach my $dclass (@{ $hid->{Diverse} }) {
+	    my $drk = "diversehosts_$dclass";
+	    my %dused;
+	    $dused{$_} = 1 foreach split / /, ($r{$drk} // '');
+	    $dused{$sel->{resname}} = 1;
+	    store_runvar($drk, join ' ', sort keys %dused);
+	}
     }
 
     logm("host allocation: all successful and recorded.");
@@ -697,6 +747,7 @@  sub attempt_allocation {
 
 sub compute_booking_list () {
     my @bookings;
+    my %cnotes;
     foreach my $hid (@hids) {
 	my $sel= $hid->{Selected};
 	my $alloc= $hid->{Allocated};
@@ -712,8 +763,12 @@  sub compute_booking_list () {
 	$book->{Start}= $best->{Start};
 	$book->{End}= $best->{Start} + $best->{Duration};
 	push @bookings, $book;
+	foreach my $dclass (@{ $hid->{Diverse} }) {
+	    my $notekey = "hostalloc-diverse-$flight-$dclass";
+	    $cnotes{$notekey}{$sel->{resname}} = "$job $hid->{Ident}";
+	}
     }
-    return { Bookings => \@bookings };
+    return { Bookings => \@bookings, ClientNotes => \%cnotes };
 }
 
 #---------- actually allocate things ----------