CA-400060: Sm feature intersection

NEW Sm features that are found during an upgrde will now only be
available when they are available on all of the hosts. Add logic to
keep track of features that are only availabe on some of the hosts in
the pool, and declare them in `Sm.feature` only when all of the hosts
have declared this.

Also move `Storage_access.on_xapi_start` to `dbsync_slave` as this needs
to be run on all hosts for each sm to get a chance to say what features
they have.

Signed-off-by: Vincent Liu <[email protected]>

ocaml/tests/test_sm_features.ml

@@ -160,6 +160,21 @@ let test_sequences =
     }
   ]
 
+let test_intersection_sequences =
+  ( {
+      raw= ["VDI_MIRROR"]
+    ; smapiv1_features= [(Vdi_mirror, 1L)]
+    ; smapiv2_features= ["VDI_MIRROR/1"]
+    ; sm= {capabilities= ["VDI_MIRROR"]; features= [("VDI_MIRROR", 1L)]}
+    }
+  , {
+      raw= ["VDI_MIRROR"]
+    ; smapiv1_features= [(Vdi_mirror, 2L)]
+    ; smapiv2_features= ["VDI_MIRROR/2"]
+    ; sm= {capabilities= ["VDI_MIRROR"]; features= [("VDI_MIRROR", 1L)]}
+    }
+  )
+
 module ParseSMAPIv1Features = Generic.MakeStateless (struct
   module Io = struct
     type input_t = string list
@@ -249,11 +264,38 @@ module CreateSMObject = Generic.MakeStateful (struct
       )
 end)
 
+module CompatSMFeatures = Generic.MakeStateless (struct
+  module Io = struct
+    type input_t = (string * string) list
+
+    type output_t = string list
+
+    let string_of_input_t = Test_printers.(list (fun (x, y) -> x ^ "," ^ y))
+
+    let string_of_output_t = Test_printers.(list Fun.id)
+  end
+
+  let transform l =
+    List.split l |> fun (x, y) ->
+    (Smint.parse_string_int64_features x, Smint.parse_string_int64_features y)
+    |> fun (x, y) -> Smint.compat_features x y |> List.map Smint.unparse_feature
+
+  let tests =
+    let r1, r2 = test_intersection_sequences in
+    `QuickAndAutoDocumented
+      [
+        ( List.combine r1.smapiv2_features r2.smapiv2_features
+        , r1.smapiv2_features
+        )
+      ]
+end)
+
 let tests =
   List.map
     (fun (s, t) -> (Format.sprintf "sm_features_%s" s, t))
     [
       ("parse_smapiv1_features", ParseSMAPIv1Features.tests)
     ; ("create_smapiv2_features", CreateSMAPIv2Features.tests)
     ; ("create_sm_object", CreateSMObject.tests)
+    ; ("compat_sm_features", CompatSMFeatures.tests)
     ]

ocaml/xapi/dbsync_master.ml

@@ -373,7 +373,6 @@ let update_env __context =
      in the db for cancelling *)
   Cancel_tasks.cancel_tasks_on_host ~__context ~host_opt:None ;
   (* Update the SM plugin table *)
-  Storage_access.on_xapi_start ~__context ;
   if !Xapi_globs.create_tools_sr then
     create_tools_sr_noexn __context ;
   ensure_vm_metrics_records_exist_noexn __context ;

ocaml/xapi/dbsync_slave.ml

@@ -362,6 +362,9 @@ let update_env __context sync_keys =
   switched_sync Xapi_globs.sync_refresh_localhost_info (fun () ->
       refresh_localhost_info ~__context info
   ) ;
+  switched_sync Xapi_globs.sync_sm_records (fun () ->
+      Storage_access.on_xapi_start ~__context
+  ) ;
   switched_sync Xapi_globs.sync_local_vdi_activations (fun () ->
       Storage_access.refresh_local_vdi_activations ~__context
   ) ;

ocaml/xapi/smint.ml

@@ -15,6 +15,8 @@
  * @group Storage
 *)
 
+module Listext = Xapi_stdext_std.Listext
+
 module D = Debug.Make (struct let name = "smint" end)
 
 open D
@@ -110,6 +112,8 @@ let capability_of_feature : feature -> capability = fst
 
 let known_features = List.map fst string_to_capability_table
 
+let unparse_feature (f, v) = f ^ "/" ^ Int64.to_string v
+
 let parse_string_int64_features features =
   let scan feature =
     match String.split_on_char '/' feature with
@@ -134,6 +138,21 @@ let parse_string_int64_features features =
   |> List.filter_map scan
   |> List.sort_uniq (fun (x, _) (y, _) -> compare x y)
 
+(** [compat_features features1 features2] finds the compatiable features in the input
+features lists. We assume features backwards compatible, i.e. if there are FOO/1 and
+  FOO/2 are present, then we assume they can both do FOO/1*)
+let compat_features features1 features2 =
+  let features2 = List.to_seq features2 |> Hashtbl.of_seq in
+  List.filter_map
+    (fun (f1, v1) ->
+      match Hashtbl.find_opt features2 f1 with
+      | Some v2 ->
+          Some (f1, Int64.min v1 v2)
+      | None ->
+          None
+    )
+    features1
+
 let parse_capability_int64_features strings =
   List.map
     (function c, v -> (List.assoc c string_to_capability_table, v))

ocaml/xapi/xapi_globs.ml

@@ -340,6 +340,8 @@ let sync_switch_off = "nosync"
 (* dbsync_slave *)
 let sync_local_vdi_activations = "sync_local_vdi_activations"
 
+let sync_sm_records = "sync_sm_records"
+
 let sync_create_localhost = "sync_create_localhost"
 
 let sync_set_cache_sr = "sync_set_cache_sr"

ocaml/xapi/xapi_sm.ml

@@ -18,6 +18,8 @@
 (* The SMAPIv1 plugins are a static set in the filesystem.
    The SMAPIv2 plugins are a dynamic set hosted in driver domains. *)
 
+module Listext = Xapi_stdext_std.Listext
+
 let finally = Xapi_stdext_pervasives.Pervasiveext.finally
 
 (* We treat versions as '.'-separated integer lists under the usual
@@ -36,27 +38,75 @@ let create_from_query_result ~__context q =
   if String.lowercase_ascii q.driver <> "storage_access" then (
     let features = Smint.parse_string_int64_features q.features in
     let capabilities = List.map fst features in
-    info "Registering SM plugin %s (version %s)"
+    info "%s Registering SM plugin %s (version %s)" __FUNCTION__
       (String.lowercase_ascii q.driver)
       q.version ;
     Db.SM.create ~__context ~ref:r ~uuid:u
       ~_type:(String.lowercase_ascii q.driver)
       ~name_label:q.name ~name_description:q.description ~vendor:q.vendor
       ~copyright:q.copyright ~version:q.version
       ~required_api_version:q.required_api_version ~capabilities ~features
-      ~configuration:q.configuration ~other_config:[]
+      ~host_pending_features:[] ~configuration:q.configuration ~other_config:[]
       ~driver_filename:(Sm_exec.cmd_name q.driver)
       ~required_cluster_stack:q.required_cluster_stack
   )
 
+let find_pending_features existing_features features =
+  Listext.List.set_difference features existing_features
+
+let update_pending_hosts_features ~__context self new_features =
+  let host = Helpers.get_localhost ~__context in
+  let new_features =
+    List.map (fun (f, v) -> Smint.unparse_feature (f, v)) new_features
+  in
+  let curr_pending_features =
+    Db.SM.get_host_pending_features ~__context ~self
+    |> List.remove_assoc host
+    |> List.cons (host, new_features)
+  in
+  Db.SM.set_host_pending_features ~__context ~self ~value:curr_pending_features ;
+  List.iter
+    (fun (h, f) ->
+      debug "%s: current pending features for host %s, sm %s, features %s"
+        __FUNCTION__ (Ref.string_of h) (Ref.string_of self) (String.concat "," f)
+    )
+    curr_pending_features ;
+  List.map
+    (fun (h, f) -> (h, Smint.parse_string_int64_features f))
+    curr_pending_features
+
+let valid_hosts_pending_features ~__context pending_features =
+  if List.length pending_features <> List.length (Db.Host.get_all ~__context)
+  then (
+    debug "%s: Not enough hosts have registered their sm features" __FUNCTION__ ;
+    []
+  ) else
+    List.map snd pending_features |> fun l ->
+    List.fold_left Smint.compat_features
+      (* The list in theory cannot be empty due to the if condition check, but do
+         this just in case *)
+      (List.nth_opt l 0 |> Option.fold ~none:[] ~some:Fun.id)
+      (List.tl l)
+
 let update_from_query_result ~__context (self, r) q_result =
   let open Storage_interface in
   let _type = String.lowercase_ascii q_result.driver in
   if _type <> "storage_access" then (
     let driver_filename = Sm_exec.cmd_name q_result.driver in
-    let features = Smint.parse_string_int64_features q_result.features in
+    let existing_features = Db.SM.get_features ~__context ~self in
+    let new_features =
+      Smint.parse_string_int64_features q_result.features
+      |> find_pending_features existing_features
+      |> update_pending_hosts_features ~__context self
+      |> valid_hosts_pending_features ~__context
+    in
+    let features = existing_features @ new_features in
+    List.iter
+      (fun (f, v) -> debug "%s: declaring new features %s:%Ld" __FUNCTION__ f v)
+      new_features ;
+
     let capabilities = List.map fst features in
-    info "Registering SM plugin %s (version %s)"
+    info "%s Registering SM plugin %s (version %s)" __FUNCTION__
       (String.lowercase_ascii q_result.driver)
       q_result.version ;
     if r.API.sM_type <> _type then