Libguestfs - Jan 2022 - [PATCH v2v 1/3] lib/utils.ml: Make with_nbd_connect_unix meta_contexts erasable

Make the meta_contexts parameter of Utils.with_nbd_connect_unix
optional and erasable.  This involves three connected changes, we
first make it optional (ie. '?meta_contexts'), providing the obvious
default of empty list.  We then need to move it to the first parameter
so OCaml can erase it even if we partially apply this function.
Finally remove the label from the function parameter 'f'.

I'm not quite sure why the last change is necessary, but OCaml cannot
erase ?meta_contexts without it, and in any case it's not necessary to
label this parameter as it doesn't add any extra type safety and you
wouldn't want callers to swap over the socket and function parameter
because that would make calling code less clear.  (The same applies to
~socket but I didn't change that).
---
 lib/utils.ml  | 4 ++--
 lib/utils.mli | 6 +++---
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/lib/utils.ml b/lib/utils.ml
index d6861d0889..863cfc4eb0 100644
--- a/lib/utils.ml
+++ b/lib/utils.ml
@@ -165,7 +165,7 @@ let rec wait_for_file filename timeout  
 let metaversion = Digest.to_hex (Digest.string Config.package_version_full)
 
-let with_nbd_connect_unix ~socket ~meta_contexts ~f +let with_nbd_connect_unix
?(meta_contexts = []) ~socket f    let nbd = NBD.create () in
   protect
     ~f:(fun () ->
@@ -181,7 +181,7 @@ let get_disk_allocated ~dir ~disknr    let socket = sprintf
"%s/out%d" dir disknr
   and alloc_ctx = "base:allocation" in
   with_nbd_connect_unix ~socket ~meta_contexts:[alloc_ctx]
-    ~f:(fun nbd ->
+    (fun nbd ->
          if NBD.can_meta_context nbd alloc_ctx then (
            (* Get the list of extents, using a 2GiB chunk size as hint. *)
            let size = NBD.get_size nbd
diff --git a/lib/utils.mli b/lib/utils.mli
index 3096eb1466..76a2ec8c40 100644
--- a/lib/utils.mli
+++ b/lib/utils.mli
@@ -78,9 +78,9 @@ val metaversion : string
     Eventually we may switch to using an "open metadata" format
instead
     (eg. XML). *)
 
-val with_nbd_connect_unix : socket:string ->
-                            meta_contexts:string list ->
-                            f:(NBD.t -> 'a) ->
+val with_nbd_connect_unix : ?meta_contexts:string list ->
+                            socket:string ->
+                            (NBD.t -> 'a) ->
                             'a
 (** [with_nbd_connect_unix socket meta_contexts f] calls function [f] with the
     NBD server at Unix domain socket [socket] connected, and the metadata
-- 
2.32.0

Instead of calling NBD.connect directly, use our helper function
Utils.with_nbd_connect_unix.  This changes the semantics slightly
since errors in shutdown/close will no longer be ignored, but I would
argue that we want to see those errors since they would indicate
something going wrong in the NBD server that we'd probably want to
know about.
---
 output/output.ml | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/output/output.ml b/output/output.ml
index 2e51743ba2..943c9e8b32 100644
--- a/output/output.ml
+++ b/output/output.ml
@@ -58,13 +58,7 @@ let get_disks dir    let rec loop acc i      let socket =
sprintf "%s/in%d" dir i in
     if Sys.file_exists socket then (
-      let nbd = NBD.create () in
-      NBD.connect_unix nbd socket;
-      let size = NBD.get_size nbd in
-      (try
-         NBD.shutdown nbd;
-         NBD.close nbd
-       with NBD.Error _ -> ());
+      let size : int64 = Utils.with_nbd_connect_unix ~socket NBD.get_size in
       loop ((i, size) :: acc) (i+1)
     )
     else
-- 
2.32.0

If using virt-v2v in verbose mode, pass the debug flag when using
libnbd.  This provides additional debugging.
---
 lib/utils.ml | 1 +
 1 file changed, 1 insertion(+)

diff --git a/lib/utils.ml b/lib/utils.ml
index 863cfc4eb0..4c43a4b516 100644
--- a/lib/utils.ml
+++ b/lib/utils.ml
@@ -169,6 +169,7 @@ let with_nbd_connect_unix ?(meta_contexts = []) ~socket f   
let nbd = NBD.create () in
   protect
     ~f:(fun () ->
+          NBD.set_debug nbd (verbose ());
           List.iter (NBD.add_meta_context nbd) meta_contexts;
           NBD.connect_unix nbd socket;
           protect
-- 
2.32.0

On 01/11/22 13:49, Richard W.M. Jones wrote:
> Make the meta_contexts parameter of Utils.with_nbd_connect_unix
> optional and erasable.  This involves three connected changes, we
> first make it optional (ie. '?meta_contexts'), providing the
obvious
> default of empty list.  We then need to move it to the first parameter
> so OCaml can erase it even if we partially apply this function.
> Finally remove the label from the function parameter 'f'.
> 
> I'm not quite sure why the last change is necessary, but OCaml cannot
> erase ?meta_contexts without it,
The OCaml book I use writes:

    [...]
    ? The order of labeled arguments does not matter, except when a
      label occurs more than once.
    [...]

    The reason for following an optional parameter with an unlabeled one
    is that, otherwise, it isn?t possible to know when an optional
    argument has been omitted. The compiler produces a warning for
    function definitions with a final optional parameter.

      # let f ~x ?(y = 1) = x - y;;
      Characters 15-16:
      Warning X: this optional argument cannot be erased.
        let f ~x ?(y = 1) = x - y;;
                        ^
      val f : x:int -> ?y:int -> int = <fun>

    There is a slight difference between labeled and unlabeled arguments
    with respect to optional arguments. When an optional argument is
    followed only by labeled arguments, then it is no longer possible to
    omit the argument. In contrast, an unlabeled argument ?forces? the
    omission.

      # let add1 ?(x = 1) ~y ~z = x + y + z;;
      val add1 : ?x:int -> y:int -> z:int -> int = <fun>

      # add1 ~y:2 ~z:3;;
      - : ?x:int -> int = <fun>

      # let add2 ?(x = 1) ~y z = x + y + z;;
      val add2 : ?x:int -> y:int -> int -> int = <fun>

      # add2 ~y:2 3;;
      - : int = 6

I think in our case the add1 / add2 examples apply.
> and in any case it's not necessary to
> label this parameter as it doesn't add any extra type safety and you
> wouldn't want callers to swap over the socket and function parameter
> because that would make calling code less clear.  (The same applies to
> ~socket but I didn't change that).
> ---
>  lib/utils.ml  | 4 ++--
>  lib/utils.mli | 6 +++---
>  2 files changed, 5 insertions(+), 5 deletions(-)
> 
> diff --git a/lib/utils.ml b/lib/utils.ml
> index d6861d0889..863cfc4eb0 100644
> --- a/lib/utils.ml
> +++ b/lib/utils.ml
> @@ -165,7 +165,7 @@ let rec wait_for_file filename timeout >  
>  let metaversion = Digest.to_hex (Digest.string
Config.package_version_full)
>  
> -let with_nbd_connect_unix ~socket ~meta_contexts ~f > +let
with_nbd_connect_unix ?(meta_contexts = []) ~socket f >    let nbd =
NBD.create () in
>    protect
>      ~f:(fun () ->
> @@ -181,7 +181,7 @@ let get_disk_allocated ~dir ~disknr >    let socket
= sprintf "%s/out%d" dir disknr
>    and alloc_ctx = "base:allocation" in
>    with_nbd_connect_unix ~socket ~meta_contexts:[alloc_ctx]
> -    ~f:(fun nbd ->
> +    (fun nbd ->
>           if NBD.can_meta_context nbd alloc_ctx then (
>             (* Get the list of extents, using a 2GiB chunk size as hint. *)
>             let size = NBD.get_size nbd
> diff --git a/lib/utils.mli b/lib/utils.mli
> index 3096eb1466..76a2ec8c40 100644
> --- a/lib/utils.mli
> +++ b/lib/utils.mli
> @@ -78,9 +78,9 @@ val metaversion : string
>      Eventually we may switch to using an "open metadata" format
instead
>      (eg. XML). *)
>  
> -val with_nbd_connect_unix : socket:string ->
> -                            meta_contexts:string list ->
> -                            f:(NBD.t -> 'a) ->
> +val with_nbd_connect_unix : ?meta_contexts:string list ->
> +                            socket:string ->
> +                            (NBD.t -> 'a) ->
>                              'a
>  (** [with_nbd_connect_unix socket meta_contexts f] calls function [f] with
the
>      NBD server at Unix domain socket [socket] connected, and the metadata
> 
Reviewed-by: Laszlo Ersek <lersek at redhat.com>