tapctl: Return Option instead of raising Not_found

Some of the users of the function did not handle exceptions correctly - make
the "not found" case explicit with an option.

Signed-off-by: Andrii Sultanov <[email protected]>

Author: last-genius

ocaml/tapctl/tapctl.ml

@@ -533,11 +533,7 @@ let of_device ctx path =
   let major = stat.Unix.st_rdev / 256 in
   let minor = stat.Unix.st_rdev mod 256 in
   if driver_of_major major <> "tapdev" then raise Not_blktap ;
-  match List.filter (fun (tapdev, _, _) -> tapdev.minor = minor) (list ctx) with
-  | [t] ->
-      t
-  | _ ->
-      raise Not_found
+  List.find_opt (fun (tapdev, _, _) -> tapdev.minor = minor) (list ctx)
 
 let find ctx ~pid ~minor =
   match list ~t:{minor; tapdisk_pid= pid} ctx with

ocaml/tapctl/tapctl.mli

@@ -91,7 +91,7 @@ exception Not_blktap
 (** Thrown by [of_device x] when [x] is not a device *)
 exception Not_a_device
 
-val of_device : context -> string -> t
+val of_device : context -> string -> t option
 (** Given a path to a device, return the corresponding tap information *)
 
 val find : context -> pid:int -> minor:int -> t

ocaml/vhd-tool/cli/sparse_dd.ml

@@ -244,14 +244,14 @@ let with_paused_tapdisk path f =
   let path = find_backend_device path |> Opt.default path in
   let context = Tapctl.create () in
   match Tapctl.of_device context path with
-  | tapdev, _, Some (_driver, path) ->
+  | Some (tapdev, _, Some (_driver, path)) ->
       debug "pausing tapdisk for %s" path ;
       Tapctl.pause context tapdev ;
       after f (fun () ->
           debug "unpausing tapdisk for %s" path ;
           Tapctl.unpause context tapdev path Tapctl.Vhd
       )
-  | _, _, _ ->
+  | _ ->
       failwith (Printf.sprintf "Failed to pause tapdisk for %s" path)
 
 (* Record when the binary started for performance measuring *)

ocaml/vhd-tool/src/image.ml

@@ -66,11 +66,11 @@ let image_behind_nbd_device image =
 
 let of_device path =
   match Tapctl.of_device (Tapctl.create ()) path with
-  | _, _, Some ("vhd", vhd) ->
+  | Some (_, _, Some ("vhd", vhd)) ->
       Some (`Vhd vhd)
-  | _, _, Some ("aio", vhd) ->
+  | Some (_, _, Some ("aio", vhd)) ->
       Some (`Raw vhd)
-  | _, _, _ ->
+  | _ ->
       None
   | exception Tapctl.Not_blktap ->
       get_nbd_device path |> image_behind_nbd_device

ocaml/xapi/storage_smapiv1_migrate.ml

@@ -108,18 +108,18 @@ let tapdisk_of_attach_info (backend : Storage_interface.backend) =
       let path = blockdevice.Storage_interface.path in
       try
         match Tapctl.of_device (Tapctl.create ()) path with
-        | tapdev, _, _ ->
+        | Some (tapdev, _, _) ->
             Some tapdev
+        | None ->
+            D.debug "Device %s has an unknown driver" path ;
+            None
       with
       | Tapctl.Not_blktap ->
           D.debug "Device %s is not controlled by blktap" path ;
           None
       | Tapctl.Not_a_device ->
           D.debug "%s is not a device" path ;
           None
-      | _ ->
-          D.debug "Device %s has an unknown driver" path ;
-          None
     )
   | _, nbd :: _ -> (
     try
@@ -295,8 +295,8 @@ module Copy = struct
       perform_cleanup_actions !on_fail ;
       raise e
 
-  (** [copy_into_sr] does not requires a dest vdi to be provided, instead, it will 
-  find the nearest vdi on the [dest] sr, and if there is no such vdi, it will 
+  (** [copy_into_sr] does not requires a dest vdi to be provided, instead, it will
+  find the nearest vdi on the [dest] sr, and if there is no such vdi, it will
   create one. *)
   let copy_into_sr ~task ~dbg ~sr ~vdi ~vm ~url ~dest ~verify_dest =
     D.debug "copy sr:%s vdi:%s url:%s dest:%s verify_dest:%B"

ocaml/xapi/xapi_vdi_helpers.ml

@@ -399,7 +399,8 @@ let find_backend_device path =
 let backing_info_of_device path =
   let tapdisk_of_path path =
     try
-      let _, _, backing_info = Tapctl.of_device (Tapctl.create ()) path in
+      let ( let* ) = Option.bind in
+      let* _, _, backing_info = Tapctl.of_device (Tapctl.create ()) path in
       backing_info
     with
     | Tapctl.Not_a_device ->