CA-408048 remove SM plugins from DB if unavailable

ocaml/xapi-aux/dune

@@ -1,6 +1,7 @@
 (library
   (name xapi_aux)
   (modes best)
+  (modules :standard \ version_test)
   (libraries
     astring
     clock
@@ -21,3 +22,11 @@
   (wrapped false)
 )
 
+; to run this test: dune exec ./version_test.exe
+(tests
+ (names version_test)
+  (modes (best exe))
+  (modules version_test)
+  (package xapi)
+  (libraries
+    xapi_aux alcotest))

ocaml/xapi-aux/version.ml

@@ -0,0 +1,85 @@
+(*
+   Copyright (c) Cloud Software Group, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; version 2.1 only. with the special
+   exception on linking described in file LICENSE.
+
+   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 Lesser General Public License for more details.
+ *)
+
+(* Simple abstraction for version information that enforces a simple
+   format and predicatable semantics *)
+
+exception Format of string
+
+(** in decreasing oder of sginificance *)
+type t = int list
+
+let of_string str =
+  let int str = Scanf.sscanf str "%u%!" Fun.id in
+  try String.split_on_char '.' str |> List.map int with _ -> raise (Format str)
+
+let to_string t =
+  let str int = Printf.sprintf "%d" int in
+  t |> List.map str |> String.concat "."
+
+(** Total order over versions; 1.2.3 is equal to 1.2.3.0 *)
+let rec compare v1 v2 =
+  match (v1, v2) with
+  | [], [] ->
+      0
+  | 0 :: xs, [] ->
+      compare xs []
+  | _, [] ->
+      1
+  | [], 0 :: ys ->
+      compare [] ys
+  | [], _ ->
+      -1
+  | x :: xs, y :: ys when x = y ->
+      compare xs ys
+  | x :: _, y :: _ when x < y ->
+      -1
+  | _ ->
+      1
+
+let ne x y = compare x y <> 0
+
+let eq x y = compare x y = 0
+
+let le x y = compare x y <= 0
+
+let ge x y = compare x y >= 0
+
+let gt x y = compare x y > 0
+
+let lt x y = compare x y < 0
+
+let is_valid str =
+  try
+    ignore (of_string str) ;
+    true
+  with Format _ -> false
+
+module String = struct
+  let wrap f v1 v2 = f (of_string v1) (of_string v2)
+
+  let compare = wrap compare
+
+  let ne = wrap ne
+
+  let eq = wrap eq
+
+  let le = wrap le
+
+  let ge = wrap ge
+
+  let gt = wrap gt
+
+  let lt = wrap lt
+end

ocaml/xapi-aux/version.mli

@@ -0,0 +1,76 @@
+(*
+   Copyright (c) Cloud Software Group, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU Lesser General Public License as published
+   by the Free Software Foundation; version 2.1 only. with the special
+   exception on linking described in file LICENSE.
+
+   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 Lesser General Public License for more details.
+ *)
+
+(** a version, derived from a string representation - see below *)
+type t
+
+(** A version string violates the supported syntax *)
+exception Format of string
+
+val of_string : string -> t
+(** Parse a version; may raise [Format]. A version is a sequence of
+    unsigned integers separated by a dot; for axample "1.2.3" is a legal
+    version. Must have at least one component. Examples:
+    - 3
+    - 3.10
+    - 3.10.4
+    - 3.10.4.0.0
+    - 3.10.4.0.1
+    - 0
+    - 0.2
+    *)
+
+val to_string : t -> string
+(** represent a version as a string *)
+
+val compare : t -> t -> int
+(** Total order over versions; yields one of -1, 0, 1 as by convention.
+  - 1.2.3 = 1.2.3.0 
+  - 1.10.2 > 1.9.1
+  - 0.1.0.0 = 0.1
+  *)
+
+(* version equality relations *)
+val eq : t -> t -> bool
+
+val ge : t -> t -> bool
+
+val gt : t -> t -> bool
+
+val le : t -> t -> bool
+
+val lt : t -> t -> bool
+
+val ne : t -> t -> bool
+
+(* Validate the format of a version string *)
+val is_valid : string -> bool
+
+(* Operations over version strings for convenience. Each function may
+   raise [Format] *)
+module String : sig
+  val compare : string -> string -> int
+
+  val ne : string -> string -> bool
+
+  val eq : string -> string -> bool
+
+  val le : string -> string -> bool
+
+  val ge : string -> string -> bool
+
+  val gt : string -> string -> bool
+
+  val lt : string -> string -> bool
+end

ocaml/xapi-aux/version_test.ml

@@ -0,0 +1,25 @@
+open Alcotest
+
+let format () =
+  check bool __LOC__ true (Version.is_valid "3") ;
+  check bool __LOC__ true (Version.is_valid "0") ;
+  check bool __LOC__ true (Version.is_valid "3.1") ;
+  check bool __LOC__ true (Version.is_valid "3.1.4") ;
+  check bool __LOC__ true (Version.is_valid "3.14") ;
+  check bool __LOC__ false (Version.is_valid "") ;
+  check bool __LOC__ false (Version.is_valid "3a") ;
+  check bool __LOC__ false (Version.is_valid "3.1.4.") ;
+  check bool __LOC__ false (Version.is_valid "3.1.4.a") ;
+  check bool __LOC__ false (Version.is_valid "3.1.4a") ;
+  check bool __LOC__ false (Version.is_valid "3.1:4") ;
+  check bool __LOC__ false (Version.is_valid "-3.1.4")
+
+let order () =
+  check bool __LOC__ true (Version.String.eq "3" "3.0.0") ;
+  check bool __LOC__ true (Version.String.le "3" "3.0.1") ;
+  check bool __LOC__ true (Version.String.le "3.1" "3.10") ;
+  check bool __LOC__ true (Version.String.eq "0" "0.0.0")
+
+let tests = [test_case "format" `Quick format; test_case "order" `Quick order]
+
+let () = run __MODULE__ [(__MODULE__, tests)]

ocaml/xapi-aux/version_test.mli

@@ -0,0 +1 @@
+(* empty *)

ocaml/xapi/storage_access.ml

@@ -109,10 +109,16 @@ exception Message_switch_failure
 (** Synchronise the SM table with the SMAPIv1 plugins on the disk and the SMAPIv2
     plugins mentioned in the configuration file whitelist. *)
 let on_xapi_start ~__context =
+  (* An SM is either implemented as a plugin - for which we check its
+      presence, or via an API *)
+  let is_available (_rf, rc) =
+    Sys.file_exists rc.API.sM_driver_filename
+    || Version.String.ge rc.sM_required_api_version "5.0"
+  in
   let existing =
-    List.map
-      (fun (rf, rc) -> (rc.API.sM_type, (rf, rc)))
-      (Db.SM.get_all_records ~__context)
+    Db.SM.get_all_records ~__context
+    |> List.filter is_available
+    |> List.map (fun (rf, rc) -> (rc.API.sM_type, (rf, rc)))
   in
   let explicitly_configured_drivers =
     List.filter_map