ts-hosts-allocate-Executive: Support diverse-CLASS hostflag

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>

diff --git a/README.planner b/README.planner
index 80c2506976eb4f09bd6a6628b7d493e1f27ffd51..bb18432877e889818bb980f3d831c7fbf193073d 100644 (file)
--- 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 6a03d32551ecc0fb24595885746b5ccb131133b9..706ab6d5a5ca7df089b5428737ceff89adf71f1e 100755 (executable)
--- 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 ----------