Preserve VDI tags on migration

ocaml/xapi-idl/storage/storage_interface.ml

@@ -231,6 +231,7 @@ type vdi_info = {
     persistent: bool [@default true]
   ; sharable: bool [@default false]
   ; sm_config: (string * string) list [@default []]
+  ; tags: string list [@default []]
 }
 [@@deriving rpcty]
 
@@ -998,6 +999,16 @@ module StorageAPI (R : RPC) = struct
       declare "VDI.remove_from_sm_config" []
         (dbg_p @-> sr_p @-> vdi_p @-> key_p @-> returning unit_p err)
 
+    (** [add_tags] task sr vdi key value] adds [key] to [vdi] tags *)
+    let add_tags =
+      declare "VDI.add_tags" []
+        (dbg_p @-> sr_p @-> vdi_p @-> key_p @-> returning unit_p err)
+
+    (** [remove_tags dbg sr vdi key] removes [key] from [vdi] tags *)
+    let remove_tags =
+      declare "VDI.remove_tags" []
+        (dbg_p @-> sr_p @-> vdi_p @-> key_p @-> returning unit_p err)
+
     (** [enable_cbt dbg sr vdi] enables changed block tracking for [vdi] *)
     let enable_cbt =
       declare "VDI.enable_cbt" []
@@ -1627,6 +1638,12 @@ module type Server_impl = sig
     val remove_from_sm_config :
       context -> dbg:debug_info -> sr:sr -> vdi:vdi -> key:string -> unit
 
+    val add_tags :
+      context -> dbg:debug_info -> sr:sr -> vdi:vdi -> key:string -> unit
+
+    val remove_tags :
+      context -> dbg:debug_info -> sr:sr -> vdi:vdi -> key:string -> unit
+
     val enable_cbt : context -> dbg:debug_info -> sr:sr -> vdi:vdi -> unit
 
     val disable_cbt : context -> dbg:debug_info -> sr:sr -> vdi:vdi -> unit
@@ -1831,6 +1848,12 @@ module Server (Impl : Server_impl) () = struct
     S.VDI.remove_from_sm_config (fun dbg sr vdi key ->
         Impl.VDI.remove_from_sm_config () ~dbg ~sr ~vdi ~key
     ) ;
+    S.VDI.add_tags (fun dbg sr vdi key ->
+        Impl.VDI.add_tags () ~dbg ~sr ~vdi ~key
+    ) ;
+    S.VDI.remove_tags (fun dbg sr vdi key ->
+        Impl.VDI.remove_tags () ~dbg ~sr ~vdi ~key
+    ) ;
     S.VDI.enable_cbt (fun dbg sr vdi -> Impl.VDI.enable_cbt () ~dbg ~sr ~vdi) ;
     S.VDI.disable_cbt (fun dbg sr vdi -> Impl.VDI.disable_cbt () ~dbg ~sr ~vdi) ;
     S.VDI.data_destroy (fun dbg sr vdi -> Impl.VDI.data_destroy () ~dbg ~sr ~vdi) ;

ocaml/xapi-idl/storage/storage_skeleton.ml

@@ -164,6 +164,12 @@ module VDI = struct
   let remove_from_sm_config ctx ~dbg ~sr ~vdi ~key =
     Storage_interface.unimplemented __FUNCTION__
 
+  let add_tags ctx ~dbg ~sr ~vdi ~key =
+    Storage_interface.unimplemented __FUNCTION__
+
+  let remove_tags ctx ~dbg ~sr ~vdi ~key =
+    Storage_interface.unimplemented __FUNCTION__
+
   let enable_cbt ctx ~dbg ~sr ~vdi =
     Storage_interface.unimplemented __FUNCTION__
 

ocaml/xapi-storage-script/main.ml

@@ -367,6 +367,8 @@ let _is_a_snapshot_key = "is_a_snapshot"
 
 let _snapshot_of_key = "snapshot_of"
 
+let _vdi_tags_key = "tags"
+
 module Script = struct
   (** We cache (lowercase script name -> original script name) mapping for the
       scripts in the root directory of every registered plugin. *)
@@ -740,6 +742,19 @@ let vdi_of_volume x =
         v |> of_string
   in
   let find_string = find ~of_string:Fun.id in
+  let extract_prefixed_list prefix =
+    List.filter_map
+      (fun (k, _) ->
+        if String.starts_with ~prefix k then
+          Some
+            (String.sub k (String.length prefix)
+               (String.length k - String.length prefix)
+            )
+        else
+          None
+      )
+      x.Xapi_storage.Control.keys
+  in
   let open Storage_interface in
   {
     vdi= Vdi.of_string x.Xapi_storage.Control.key
@@ -777,6 +792,7 @@ let vdi_of_volume x =
         x.Xapi_storage.Control.keys
   ; sharable= x.Xapi_storage.Control.sharable
   ; persistent= true
+  ; tags= extract_prefixed_list _vdi_tags_key
   }
 
 let choose_datapath ?(persistent = true) response =
@@ -1741,6 +1757,22 @@ module VDIImpl (M : META) = struct
     let* () = unset ~dbg ~sr ~vdi ~key:(_sm_config_prefix_key ^ key) in
     return ()
 
+  let vdi_add_tags_impl dbg sr vdi key =
+    wrap
+    @@
+    let* sr = Attached_SRs.find sr in
+    let vdi = Storage_interface.Vdi.string_of vdi in
+    let* () = set ~dbg ~sr ~vdi ~key:(_vdi_tags_key ^ key) ~value:key in
+    return ()
+
+  let vdi_remove_tags_impl dbg sr vdi key =
+    wrap
+    @@
+    let* sr = Attached_SRs.find sr in
+    let vdi = Storage_interface.Vdi.string_of vdi in
+    let* () = unset ~dbg ~sr ~vdi ~key:(_vdi_tags_key ^ key) in
+    return ()
+
   let similar_content_impl _dbg _sr _vdi = wrap @@ return []
 end
 
@@ -1945,6 +1977,8 @@ let bind ~volume_script_dir =
   S.VDI.set_content_id VDI.vdi_set_content_id_impl ;
   S.VDI.add_to_sm_config VDI.vdi_add_to_sm_config_impl ;
   S.VDI.remove_from_sm_config VDI.vdi_remove_from_sm_config_impl ;
+  S.VDI.add_tags VDI.vdi_add_tags_impl ;
+  S.VDI.remove_tags VDI.vdi_remove_tags_impl ;
   S.VDI.similar_content VDI.similar_content_impl ;
 
   let module DP = DPImpl (RuntimeMeta) in
@@ -2152,6 +2186,7 @@ let self_test_plugin ~root_dir plugin =
         ; persistent= false
         ; sm_config= []
         ; sharable= false
+        ; tags= []
         }
       in
       Test.VDI.create rpc dbg sr vdi_info >>= fun vdi_info ->

ocaml/xapi-storage-script/python-self-test.t

@@ -21,16 +21,16 @@ pids and uuids
   [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/SR.stat[PID] succeeded: {"sr": "file:///tmp/dummy", "name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "total_space": 0, "free_space": 0, "datasources": [], "clustered": false, "health": ["Healthy", ""]}
 
   [INFO] {"method":"Volume.create","params":[{"sharable":false,"size":0,"description":"vdi description","name":"vdi name","sr":"file:///tmp/dummy","dbg":"debug"}],"id":12}
-  [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/Volume.create[PID] succeeded: {"name": "vdi name", "description": "vdi description", "key": "UUID", "uuid": "UUID", "read_write": true, "sharable": false, "virtual_size": 0, "physical_utilisation": 0, "uri": ["raw+file:///tmp/disk.raw"], "keys": {}}
+  [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/Volume.create[PID] succeeded: {"name": "vdi name", "description": "vdi description", "key": "UUID", "uuid": "UUID", "read_write": true, "sharable": false, "virtual_size": 0, "physical_utilisation": 0, "uri": ["raw+file:///tmp/disk.raw"], "keys": {}, "tags": ["tag1"]}
 
   [INFO] {"method":"Volume.set","params":[{"v":"redolog","k":"vdi-type","key":"UUID","sr":"file:///tmp/dummy","dbg":"debug"}],"id":13}
   [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/Volume.set[PID] succeeded: null
 
   [INFO] {"method":"Volume.stat","params":[{"key":"UUID","sr":"file:///tmp/dummy","dbg":"debug"}],"id":15}
-  [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/Volume.stat[PID] succeeded: {"name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "key": "UUID", "uuid": "UUID", "read_write": true, "virtual_size": 0, "physical_utilisation": 0, "sharable": false, "uri": ["raw+file:///tmp/disk.raw"], "keys": {}}
+  [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/Volume.stat[PID] succeeded: {"name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "key": "UUID", "uuid": "UUID", "read_write": true, "virtual_size": 0, "physical_utilisation": 0, "sharable": false, "uri": ["raw+file:///tmp/disk.raw"], "keys": {}, "tags": ["tag1"]}
 
   [INFO] {"method":"Volume.stat","params":[{"key":"UUID","sr":"file:///tmp/dummy","dbg":"debug"}],"id":17}
-  [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/Volume.stat[PID] succeeded: {"name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "key": "UUID", "uuid": "UUID", "read_write": true, "virtual_size": 0, "physical_utilisation": 0, "sharable": false, "uri": ["raw+file:///tmp/disk.raw"], "keys": {}}
+  [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/Volume.stat[PID] succeeded: {"name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "key": "UUID", "uuid": "UUID", "read_write": true, "virtual_size": 0, "physical_utilisation": 0, "sharable": false, "uri": ["raw+file:///tmp/disk.raw"], "keys": {}, "tags": ["tag1"]}
 
   [INFO] {"method":"Volume.destroy","params":[{"key":"UUID","sr":"file:///tmp/dummy","dbg":"debug"}],"id":18}
   [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/Volume.destroy[PID] succeeded: null
@@ -39,7 +39,7 @@ pids and uuids
   [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/SR.stat[PID] succeeded: {"sr": "file:///tmp/dummy", "name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "total_space": 0, "free_space": 0, "datasources": [], "clustered": false, "health": ["Healthy", ""]}
 
   [INFO] {"method":"SR.ls","params":[{"sr":"file:///tmp/dummy","dbg":"debug"}],"id":22}
-  [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/SR.ls[PID] succeeded: [{"name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "key": "file1", "uuid": "file1", "read_write": true, "virtual_size": 0, "physical_utilisation": 0, "sharable": false, "uri": ["raw+file:///tmp/disk.raw"], "keys": {}}]
+  [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/SR.ls[PID] succeeded: [{"name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "key": "file1", "uuid": "file1", "read_write": true, "virtual_size": 0, "physical_utilisation": 0, "sharable": false, "uri": ["raw+file:///tmp/disk.raw"], "keys": {}, "tags": ["tag1"]}]
 
   [INFO] {"method":"SR.probe","params":[{"configuration":{"uri":"file:///tmp/dummy"},"dbg":"debug"}],"id":24}
   [INFO] $TESTCASE_ROOT/test/volume/org.xen.xapi.storage.dummyv5/SR.probe[PID] succeeded: [{"configuration": {"uri": "file:///tmp/dummy"}, "complete": true, "extra_info": {}}, {"configuration": {"uri": "file:///tmp/dummy", "sr_uuid": "myuuid"}, "sr": {"sr": "file:///tmp/dummy", "name": "dummy SR plugin", "description": "Dummy v5 SR for unit tests.", "total_space": 0, "free_space": 0, "datasources": [], "clustered": false, "health": ["Healthy", ""]}, "complete": true, "extra_info": {}}]

ocaml/xapi-storage-script/test/volume/org.xen.xapi.storage.dummyv5/sr.py

@@ -39,6 +39,7 @@ def ls(self, dbg, sr):
             "sharable": False,
             "uri": ["raw+file:///tmp/disk.raw"],
             "keys": {},
+            "tags": ["tag1"],
             }]
 
     def stat(self, dbg, sr):

ocaml/xapi-storage-script/test/volume/org.xen.xapi.storage.dummyv5/volume.py

@@ -30,6 +30,7 @@ def create(self, dbg, sr, name, description, size, sharable):
             "physical_utilisation": 0,
             "uri": ["raw+file:///tmp/disk.raw"],
             "keys": {},
+            "tags": ["tag1"],
         }
 
     def destroy(self, dbg, sr, key):
@@ -50,6 +51,7 @@ def stat(self, dbg, sr, key):
                 "sharable": False,
                 "uri": ["raw+file:///tmp/disk.raw"],
                 "keys": {},
+                "tags": ["tag1"],
         }
 
     def set(self, dbg, sr, key, k, v):

ocaml/xapi-storage/rpc-light/SR.ls/response

@@ -14,6 +14,7 @@
                                                             <member><name>keys</name><value><struct></struct></value></member>
                                                             <member><name>volume_type</name><value>Data</value></member>
                                                             <member><name>cbt_enabled</name><value>false</value></member>
+                                                            <member><name>tags</name><value><array><data><value>tag1</value></data></array></value></member>
                                        </struct></value></data>
                                   </array></value></member>
     </struct></value></param></params>

ocaml/xapi-storage/rpc-light/Volume.clone/response

@@ -13,6 +13,7 @@
                                                          <member><name>keys</name><value><struct></struct></value></member>
                                                          <member><name>volume_type</name><value>Data</value></member>
                                                          <member><name>cbt_enabled</name><value>false</value></member>
+                                                         <member><name>tags</name><value><array><data><value>tag1</value></data></array></value></member>
                                          </struct>
                                  </value></member>
    </struct></value></param>

ocaml/xapi-storage/rpc-light/Volume.create/response

@@ -13,6 +13,7 @@
                                                          <member><name>keys</name><value><struct></struct></value></member>
                                                          <member><name>volume_type</name><value>Data</value></member>
                                                          <member><name>cbt_enabled</name><value>false</value></member>
+                                                         <member><name>tags</name><value><array><data><value>tag1</value></data></array></value></member>
                                          </struct>
                                  </value></member>
    </struct></value></param>

ocaml/xapi-storage/rpc-light/Volume.snapshot/response

@@ -13,6 +13,7 @@
                                                          <member><name>keys</name><value><struct></struct></value></member>
                                                          <member><name>volume_type</name><value>Data</value></member>
                                                          <member><name>cbt_enabled</name><value>false</value></member>
+                                                         <member><name>tags</name><value><array><data><value>tag1</value></data></array></value></member>
                                          </struct>
                                  </value></member>
    </struct></value></param>

ocaml/xapi/storage_mux.ml

@@ -741,6 +741,24 @@ module Mux = struct
       end)) in
       C.VDI.remove_from_sm_config (Debug_info.to_string di) sr vdi key
 
+    let add_tags () ~dbg ~sr ~vdi ~key =
+      with_dbg ~name:"VDI.add_tags" ~dbg @@ fun di ->
+      info "VDI.add_tags dbg:%s sr:%s vdi:%s key:%s" dbg (s_of_sr sr)
+        (s_of_vdi vdi) key ;
+      let module C = StorageAPI (Idl.Exn.GenClient (struct
+        let rpc = of_sr sr
+      end)) in
+      C.VDI.add_tags (Debug_info.to_string di) sr vdi key
+
+    let remove_tags () ~dbg ~sr ~vdi ~key =
+      with_dbg ~name:"VDI.remove_tags" ~dbg @@ fun di ->
+      info "VDI.remove_tags dbg:%s sr:%s vdi:%s key:%s" dbg (s_of_sr sr)
+        (s_of_vdi vdi) key ;
+      let module C = StorageAPI (Idl.Exn.GenClient (struct
+        let rpc = of_sr sr
+      end)) in
+      C.VDI.remove_tags (Debug_info.to_string di) sr vdi key
+
     let get_url () ~dbg ~sr ~vdi =
       with_dbg ~name:"VDI.get_url" ~dbg @@ fun di ->
       info "VDI.get_url dbg:%s sr:%s vdi:%s" dbg (s_of_sr sr) (s_of_vdi vdi) ;

ocaml/xapi/storage_smapiv1.ml

@@ -80,6 +80,7 @@ let vdi_info_of_vdi_rec __context vdi_rec =
   ; persistent= vdi_rec.API.vDI_on_boot = `persist
   ; sharable= vdi_rec.API.vDI_sharable
   ; sm_config= vdi_rec.API.vDI_sm_config
+  ; tags= vdi_rec.API.vDI_tags
   }
 
 let redirect _sr =
@@ -1050,6 +1051,28 @@ module SMAPIv1 : Server_impl = struct
           Db.VDI.remove_from_sm_config ~__context ~self ~key
       )
 
+    let add_tags _context ~dbg ~sr ~vdi ~key =
+      with_dbg ~name:"VDI.add_to_tags" ~dbg @@ fun di ->
+      info "VDI.add_tags dbg:%s sr:%s vdi:%s key:[%s]" di.log (s_of_sr sr)
+        (s_of_vdi vdi) key ;
+      let dbg = Debug_info.to_string di in
+      Server_helpers.exec_with_new_task "VDI.add_tags"
+        ~subtask_of:(Ref.of_string dbg) (fun __context ->
+          let vdi, _ = find_vdi ~__context sr vdi in
+          Db.VDI.add_tags ~__context ~self:vdi ~value:key
+      )
+
+    let remove_tags _context ~dbg ~sr ~vdi ~key =
+      with_dbg ~name:"VDI.remove_tags" ~dbg @@ fun di ->
+      info "VDI.remove_tags dbg:%s sr:%s vdi:%s key:%s" di.log (s_of_sr sr)
+        (s_of_vdi vdi) key ;
+      let dbg = Debug_info.to_string di in
+      Server_helpers.exec_with_new_task "VDI.remove_tags"
+        ~subtask_of:(Ref.of_string dbg) (fun __context ->
+          let self = find_vdi ~__context sr vdi |> fst in
+          Db.VDI.remove_tags ~__context ~self ~value:key
+      )
+
     let get_url _context ~dbg ~sr ~vdi =
       with_dbg ~name:"VDI.get_url" ~dbg @@ fun di ->
       info "VDI.get_url dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ;

ocaml/xapi/storage_smapiv1_migrate.ml

@@ -631,6 +631,14 @@ module MIRROR : SMAPIv2_MIRROR = struct
     try
       let vdi_info = {vdi_info with sm_config= [("base_mirror", id)]} in
       let leaf = SMAPI.VDI.create dbg sr vdi_info in
+
+      List.iter
+        (fun tag ->
+          Local.VDI.remove_tags dbg sr leaf.vdi tag ;
+          Local.VDI.add_tags dbg sr leaf.vdi tag
+        )
+        vdi_info.tags ;
+
       D.info "Created leaf VDI for mirror receive: %s" (string_of_vdi_info leaf) ;
       on_fail := (fun () -> SMAPI.VDI.destroy dbg sr leaf.vdi) :: !on_fail ;
       (* dummy VDI is created so that the leaf VDI becomes a differencing disk,

ocaml/xapi/storage_smapiv1_wrapper.ml

@@ -908,6 +908,20 @@ functor
         let dbg = Debug_info.to_string di in
         Impl.VDI.remove_from_sm_config context ~dbg ~sr ~vdi ~key
 
+      let add_tags context ~dbg ~sr ~vdi ~key =
+        with_dbg ~name:"VDI.add_tags" ~dbg @@ fun di ->
+        info "VDI.add_tags dbg:%s sr:%s vdi:%s key:%s" di.log (s_of_sr sr)
+          (s_of_vdi vdi) key ;
+        let dbg = Debug_info.to_string di in
+        Impl.VDI.add_tags context ~dbg ~sr ~vdi ~key
+
+      let remove_tags context ~dbg ~sr ~vdi ~key =
+        with_dbg ~name:"VDI.remove_tags" ~dbg @@ fun di ->
+        info "VDI.remove_tags dbg:%s sr:%s vdi:%s key:%s" di.log (s_of_sr sr)
+          (s_of_vdi vdi) key ;
+        let dbg = Debug_info.to_string di in
+        Impl.VDI.remove_tags context ~dbg ~sr ~vdi ~key
+
       let get_url context ~dbg ~sr ~vdi =
         with_dbg ~name:"VDI.get_url" ~dbg @@ fun di ->
         info "VDI.get_url dbg:%s sr:%s vdi:%s" di.log (s_of_sr sr) (s_of_vdi vdi) ;