From 52abc179ef4fb671165db9cbb911c720b5983c60 Mon Sep 17 00:00:00 2001
From: Christian Lindig <christian.lindig@citrix.com>
Date: Tue, 19 Jul 2022 15:15:18 +0100
Subject: [PATCH] CA-368437 remove duplicate keys from SM.features

Backport of 2386ed7fee57380fadf949f9a8d1df8dbd376979

The association list SM.features frequently contains duplicate keys.
This is problematic because they could bind to different values (which
are versions in this case).

When parsing the features from a list of strings, eliminate duplicate
keys. In addition, simplify the implementation and avoid duplicate work
by using List.filter_map.

Signed-off-by: Christian Lindig <christian.lindig@cloud.com>
---
 ocaml/tests/test_sm_features.ml | 70 ++++++++++++++++-----------------
 ocaml/xapi/smint.ml             | 51 +++++++++++-------------
 2 files changed, 58 insertions(+), 63 deletions(-)

diff --git a/ocaml/tests/test_sm_features.ml b/ocaml/tests/test_sm_features.ml
index 3aff2f31723..506d467b56f 100644
--- a/ocaml/tests/test_sm_features.ml
+++ b/ocaml/tests/test_sm_features.ml
@@ -47,55 +47,53 @@ let test_sequences =
     {
       raw=
         [
-          "SR_PROBE"
-        ; "SR_UPDATE"
+          "ATOMIC_PAUSE"
         ; "SR_CACHING"
-        ; (* xapi ignores this. *)
-          "VDI_CREATE"
-        ; "VDI_DELETE"
+        ; "SR_PROBE"
+        ; "SR_UPDATE"
         ; "VDI_ATTACH"
-        ; "VDI_DETACH"
-        ; "VDI_UPDATE"
         ; "VDI_CLONE"
-        ; "VDI_SNAPSHOT"
-        ; "VDI_RESIZE"
+        ; "VDI_CONFIG_CBT"
+        ; "VDI_CREATE"
+        ; "VDI_DELETE"
+        ; "VDI_DETACH"
         ; "VDI_GENERATE_CONFIG"
         ; "VDI_RESET_ON_BOOT/2"
-        ; "VDI_CONFIG_CBT"
-        ; "ATOMIC_PAUSE"
-          (* xapi ignores this *)
+        ; "VDI_RESIZE"
+        ; "VDI_SNAPSHOT"
+        ; "VDI_UPDATE"
         ]
     ; smapiv1_features=
         [
           (Sr_probe, 1L)
         ; (Sr_update, 1L)
+        ; (Vdi_attach, 1L)
+        ; (Vdi_clone, 1L)
+        ; (Vdi_configure_cbt, 1L)
         ; (Vdi_create, 1L)
         ; (Vdi_delete, 1L)
-        ; (Vdi_attach, 1L)
         ; (Vdi_detach, 1L)
-        ; (Vdi_update, 1L)
-        ; (Vdi_clone, 1L)
-        ; (Vdi_snapshot, 1L)
-        ; (Vdi_resize, 1L)
         ; (Vdi_generate_config, 1L)
         ; (Vdi_reset_on_boot, 2L)
-        ; (Vdi_configure_cbt, 1L)
+        ; (Vdi_resize, 1L)
+        ; (Vdi_snapshot, 1L)
+        ; (Vdi_update, 1L)
         ]
     ; smapiv2_features=
         [
           "SR_PROBE/1"
         ; "SR_UPDATE/1"
+        ; "VDI_ATTACH/1"
+        ; "VDI_CLONE/1"
+        ; "VDI_CONFIG_CBT/1"
         ; "VDI_CREATE/1"
         ; "VDI_DELETE/1"
-        ; "VDI_ATTACH/1"
         ; "VDI_DETACH/1"
-        ; "VDI_UPDATE/1"
-        ; "VDI_CLONE/1"
-        ; "VDI_SNAPSHOT/1"
-        ; "VDI_RESIZE/1"
         ; "VDI_GENERATE_CONFIG/1"
         ; "VDI_RESET_ON_BOOT/2"
-        ; "VDI_CONFIG_CBT/1"
+        ; "VDI_RESIZE/1"
+        ; "VDI_SNAPSHOT/1"
+        ; "VDI_UPDATE/1"
         ]
     ; sm=
         {
@@ -103,33 +101,33 @@ let test_sequences =
             [
               "SR_PROBE"
             ; "SR_UPDATE"
+            ; "VDI_ATTACH"
+            ; "VDI_CLONE"
+            ; "VDI_CONFIG_CBT"
             ; "VDI_CREATE"
             ; "VDI_DELETE"
-            ; "VDI_ATTACH"
             ; "VDI_DETACH"
-            ; "VDI_UPDATE"
-            ; "VDI_CLONE"
-            ; "VDI_SNAPSHOT"
-            ; "VDI_RESIZE"
             ; "VDI_GENERATE_CONFIG"
             ; "VDI_RESET_ON_BOOT"
-            ; "VDI_CONFIG_CBT"
+            ; "VDI_RESIZE"
+            ; "VDI_SNAPSHOT"
+            ; "VDI_UPDATE"
             ]
         ; features=
             [
               ("SR_PROBE", 1L)
             ; ("SR_UPDATE", 1L)
+            ; ("VDI_ATTACH", 1L)
+            ; ("VDI_CLONE", 1L)
+            ; ("VDI_CONFIG_CBT", 1L)
             ; ("VDI_CREATE", 1L)
             ; ("VDI_DELETE", 1L)
-            ; ("VDI_ATTACH", 1L)
             ; ("VDI_DETACH", 1L)
-            ; ("VDI_UPDATE", 1L)
-            ; ("VDI_CLONE", 1L)
-            ; ("VDI_SNAPSHOT", 1L)
-            ; ("VDI_RESIZE", 1L)
             ; ("VDI_GENERATE_CONFIG", 1L)
             ; ("VDI_RESET_ON_BOOT", 2L)
-            ; ("VDI_CONFIG_CBT", 1L)
+            ; ("VDI_RESIZE", 1L)
+            ; ("VDI_SNAPSHOT", 1L)
+            ; ("VDI_UPDATE", 1L)
             ]
         }
     }
diff --git a/ocaml/xapi/smint.ml b/ocaml/xapi/smint.ml
index 69cb55231e3..ddec92f2c3b 100644
--- a/ocaml/xapi/smint.ml
+++ b/ocaml/xapi/smint.ml
@@ -106,34 +106,31 @@ let has_capability (c : capability) fl = List.mem_assoc c fl
 
 let capability_of_feature : feature -> capability = fst
 
-let parse_string_int64_features strings =
-  let text_features =
-    List.filter
-      (fun s ->
-        let s = List.hd (Stdext.Xstringext.String.split '/' s) in
-        let p = List.mem s (List.map fst string_to_capability_table) in
-        if not p then debug "SM.feature: unknown feature %s" s ;
-        p
-      )
-      strings
-  in
-  List.map
-    (fun c ->
-      match Stdext.Xstringext.String.split '/' c with
-      | [] ->
-          failwith "parse_feature" (* not possible *)
-      | [cs] ->
-          (cs, 1L) (* default version *)
-      | [cs; vs] | cs :: vs :: _ -> (
-        try
-          let v = int_of_string vs in
-          (cs, if v < 1 then 1L else Int64.of_int v)
-        with _ ->
-          debug "SM.feature %s has bad version %s, defaulting to 1" cs vs ;
-          (cs, 1L)
-      )
+let known_features = List.map fst string_to_capability_table
+
+let parse_string_int64_features features =
+  let scan feature =
+    match String.split_on_char '/' feature with
+    | [] ->
+        None
+    | [feature] when List.mem feature known_features ->
+        Some (feature, 1L)
+    | feature :: version :: _ when List.mem feature known_features -> (
+      try
+        let v = Int64.(max 1L (of_string version)) in
+        Some (feature, v)
+      with _ ->
+        debug "SM.feature: %s has bad version %s, defaulting to 1" feature
+          version ;
+        Some (feature, 1L)
     )
-    text_features
+    | feature :: _ ->
+        error "SM.feature: unknown feature %s" feature ;
+        None
+  in
+  features
+  |> List.filter_map scan
+  |> List.sort_uniq (fun (x, _) (y, _) -> compare x y)
 
 let parse_capability_int64_features strings =
   List.map