Merge pull request xapi-project#5535 from minglumlu/private/mingl/CA-…

…384483

CA-384483: Can't export VDI to VHD file with base VDI

ocaml/xapi/stream_vdi.ml

@@ -163,6 +163,31 @@ let get_nbd_device path =
   else
     None
 
+(* Copied from vhd-tool/src/image.ml.
+ * Just keep the situation of xapi doesn't depend on vhd-tool OCaml module.
+ *)
+let image_behind_nbd_device = function
+  | Some (path, _exportname) as image ->
+      (* 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 _) ->
+              None
+      )
+  | _ ->
+      None
+
 type extent = {flags: int32; length: int64} [@@deriving rpc]
 
 type extent_list = extent list [@@deriving rpc]

ocaml/xapi/vhd_tool_wrapper.ml

@@ -170,9 +170,16 @@ let vhd_of_device path =
       | _, _, _ ->
           raise Not_found
     with
-    | Tapctl.Not_blktap ->
+    | Tapctl.Not_blktap -> (
         debug "Device %s is not controlled by blktap" path ;
-        None
+        (* Check if it is a VHD behind a NBD deivce *)
+        Stream_vdi.(get_nbd_device path |> image_behind_nbd_device) |> function
+        | Some ("vhd", vhd) ->
+            debug "%s is a VHD behind NBD device %s" vhd path ;
+            Some vhd
+        | _ ->
+            None
+      )
     | Tapctl.Not_a_device ->
         debug "%s is not a device" path ;
         None
@@ -186,15 +193,18 @@ let send progress_cb ?relative_to (protocol : string) (dest_format : string)
     (s : Unix.file_descr) (path : string) (size : Int64.t) (prefix : string) =
   let s' = Uuidx.(to_string (make ())) in
   let source_format, source =
-    match (Stream_vdi.get_nbd_device path, vhd_of_device path) with
-    | Some (nbd_server, exportname), _ ->
+    match (Stream_vdi.get_nbd_device path, vhd_of_device path, relative_to) with
+    | Some (nbd_server, exportname), _, None ->
         ( "nbdhybrid"
         , Printf.sprintf "%s:%s:%s:%Ld" path nbd_server exportname size
         )
-    | None, Some vhd ->
+    | Some _, Some vhd, Some _ | None, Some vhd, _ ->
         ("hybrid", path ^ ":" ^ vhd)
-    | None, None ->
+    | None, None, None ->
         ("raw", path)
+    | _, None, Some _ ->
+        let msg = "Cannot compute differences on non-VHD images" in
+        error "%s" msg ; failwith msg
   in
   let relative_to =
     match relative_to with