Merge pull request #5018 from robhoes/vdi-copy

CP-43387: Fix VDI delta copy with NBD datapath connection

ocaml/tapctl/tapctl.ml

@@ -532,3 +532,10 @@ let of_device ctx path =
       t
   | _ ->
       raise Not_found
+
+let find ctx ~pid ~minor =
+  match list ~t:{minor; tapdisk_pid= pid} ctx with
+  | [t] ->
+      t
+  | _ ->
+      raise Not_found

ocaml/tapctl/tapctl.mli

@@ -91,3 +91,6 @@ exception Not_a_device
 
 val of_device : context -> string -> t
 (** Given a path to a device, return the corresponding tap information *)
+
+val find : context -> pid:int -> minor:int -> t
+(** Find tap given a tapdisk pid and a minor number *)

ocaml/vhd-tool/src/image.ml

@@ -41,6 +41,29 @@ let get_nbd_device path =
   else
     None
 
+let image_behind_nbd_device image =
+  match image with
+  | Some (`Nbd (path, _)) ->
+      (* The nbd server path exposed by tapdisk can lead us to the actual image
+         file below. Following the symlink gives a path like
+            `/run/blktap-control/nbd<pid>.<minor>`,
+         containing the tapdisk pid and minor number. Using this information,
+         we can get the file path from tap-ctl.
+      *)
+      let default _ _ = image in
+      let filename = Unix.realpath path |> Filename.basename in
+      Scanf.ksscanf filename default "nbd%d.%d" (fun pid minor ->
+          match Tapctl.find (Tapctl.create ()) ~pid ~minor with
+          | _, _, Some ("vhd", vhd) ->
+              Some (`Vhd vhd)
+          | _, _, Some ("aio", vhd) ->
+              Some (`Raw vhd)
+          | _, _, _ | (exception _) ->
+              image
+      )
+  | _ ->
+      image
+
 let of_device path =
   match Tapctl.of_device (Tapctl.create ()) path with
   | _, _, Some ("vhd", vhd) ->
@@ -50,7 +73,7 @@ let of_device path =
   | _, _, _ ->
       None
   | exception Tapctl.Not_blktap ->
-      get_nbd_device path
+      get_nbd_device path |> image_behind_nbd_device
   | exception Tapctl.Not_a_device ->
       None
   | exception _ ->