Libguestfs - Jul 2022 - [PATCH v2v 1/3] qemu-nbd: Implement output compression for qcow2 files

---
 lib/qemuNBD.ml    | 11 +++++++++--
 lib/qemuNBD.mli   |  5 +++++
 output/output.ml  | 38 +++++++++++++++++++++++++++++++++++---
 output/output.mli |  1 +
 4 files changed, 50 insertions(+), 5 deletions(-)

diff --git a/lib/qemuNBD.ml b/lib/qemuNBD.ml
index ae21b17c7d..bbb65f4155 100644
--- a/lib/qemuNBD.ml
+++ b/lib/qemuNBD.ml
@@ -55,14 +55,16 @@ type cmd = {
   disk : string;
   mutable snapshot : bool;
   mutable format : string option;
+  mutable imgopts : bool;
 }
 
-let create disk = { disk; snapshot = false; format = None }
+let create disk = { disk; snapshot = false; format = None; imgopts = false }
 
 let set_snapshot cmd snap = cmd.snapshot <- snap
 let set_format cmd format = cmd.format <- format
+let set_image_opts cmd imgopts = cmd.imgopts <- imgopts
 
-let run_unix socket { disk; snapshot; format } +let run_unix socket { disk;
snapshot; format; imgopts }    assert (disk <> "");
 
   (* Create a temporary directory where we place the PID file. *)
@@ -85,6 +87,11 @@ let run_unix socket { disk; snapshot; format }    (* -s adds
a protective overlay. *)
   if snapshot then List.push_back args "-s";
 
+  (* --image-opts reinterprets the filename parameter as a set of
+   * image options.
+   *)
+  if imgopts then List.push_back args "--image-opts";
+
   if have_selinux && qemu_nbd_has_selinux_label_option () then (
     List.push_back args "--selinux-label";
     List.push_back args "system_u:object_r:svirt_socket_t:s0"
diff --git a/lib/qemuNBD.mli b/lib/qemuNBD.mli
index e10d3106c7..afe9d944e1 100644
--- a/lib/qemuNBD.mli
+++ b/lib/qemuNBD.mli
@@ -43,6 +43,11 @@ val set_snapshot : cmd -> bool -> unit
 val set_format : cmd -> string option -> unit
 (** Set the format [--format] parameter. *)
 
+val set_image_opts : cmd -> bool -> unit
+(** Set whether the [--image-opts] parameter is used.  This changes
+    the meaning of the [filename] parameter to a set of image options.
+    Consult the qemu-nbd man page for more details. *)
+
 val run_unix : string -> cmd -> string * int
 (** Start qemu-nbd command listening on a Unix domain socket,
     waiting for the process to start up.
diff --git a/output/output.ml b/output/output.ml
index 5c6670b99c..5fe8555a7a 100644
--- a/output/output.ml
+++ b/output/output.ml
@@ -69,7 +69,7 @@ let error_if_disk_count_gt dir n    if Sys.file_exists socket
then
     error (f_"this output module doesn't support copying more than %d
disks") n
 
-let output_to_local_file ?(changeuid = fun f -> f ())
+let output_to_local_file ?(changeuid = fun f -> f ()) ?(compressed = false)
       output_alloc output_format filename size socket    (* Check nbdkit is
installed and has the required plugin. *)
   if not (Nbdkit.is_installed ()) then
@@ -78,6 +78,10 @@ let output_to_local_file ?(changeuid = fun f -> f ())
     error (f_"nbdkit-file-plugin is not installed or not working");
   let nbdkit_config = Nbdkit.config () in
 
+  (* Only allow compressed with -of qcow2. *)
+  if compressed && output_format <> "qcow2" then
+    error (f_"?-oo compressed? is only allowed when the output format is a
local qcow2-format file, ie ?-of qcow2?");
+
   let g = open_guestfs () in
   let preallocation      match output_alloc with
@@ -103,9 +107,37 @@ let output_to_local_file ?(changeuid = fun f -> f ())
      On_exit.kill pid
 
   | "qcow2" ->
-     let cmd = QemuNBD.create filename in
+     let cmd +       if not compressed then (
+         let cmd = QemuNBD.create filename in
+         QemuNBD.set_format cmd (Some "qcow2");
+         cmd
+       )
+       else (
+         (* Check nbdcopy is new enough.  This assumes that
+          * the version of libnbd is the same as the version
+          * of nbdcopy, but parsing this is easier.  We can
+          * remove this check when we build-depend on
+          * libnbd >= 1.14.
+          *)
+         let () +           let version = NBD.create () |> NBD.get_version
in
+           let version = String.nsplit "." version in
+           let version = List.map int_of_string version in
+           if version < [1; 13; 5] then
+             error (f_"-oo compressed option requires nbdcopy >=
1.13.5") in
+
+         let qemu_quote str = String.replace str "," ",,"
in
+         let image_opts = [ "driver=compress";
+                            "file.driver=qcow2";
+                            "file.file.driver=file";
+                            "file.file.filename=" ^ qemu_quote
filename ] in
+         let image_opts = String.concat "," image_opts in
+         let cmd = QemuNBD.create image_opts in
+         QemuNBD.set_image_opts cmd true;
+         cmd
+       ) in
      QemuNBD.set_snapshot cmd false;
-     QemuNBD.set_format cmd (Some "qcow2");
      let _, pid = QemuNBD.run_unix socket cmd in
      On_exit.kill pid
 
diff --git a/output/output.mli b/output/output.mli
index 8d3d686594..c1f0f53d8e 100644
--- a/output/output.mli
+++ b/output/output.mli
@@ -84,6 +84,7 @@ val error_if_disk_count_gt : string -> int -> unit
     called. *)
 
 val output_to_local_file : ?changeuid:((unit -> unit) -> unit) ->
+                           ?compressed:bool ->
                            Types.output_allocation ->
                            string -> string -> int64 -> string ->
                            unit
-- 
2.37.0.rc2

On 07/01/22 13:01, Richard W.M. Jones wrote:
> ---
>  lib/qemuNBD.ml    | 11 +++++++++--
>  lib/qemuNBD.mli   |  5 +++++
>  output/output.ml  | 38 +++++++++++++++++++++++++++++++++++---
>  output/output.mli |  1 +
>  4 files changed, 50 insertions(+), 5 deletions(-)
(Can you update your git diff order so that *.mli be put before *.ml?)
> 
> diff --git a/lib/qemuNBD.ml b/lib/qemuNBD.ml
> index ae21b17c7d..bbb65f4155 100644
> --- a/lib/qemuNBD.ml
> +++ b/lib/qemuNBD.ml
> @@ -55,14 +55,16 @@ type cmd = {
>    disk : string;
>    mutable snapshot : bool;
>    mutable format : string option;
> +  mutable imgopts : bool;
>  }
>  
> -let create disk = { disk; snapshot = false; format = None }
> +let create disk = { disk; snapshot = false; format = None; imgopts = false
}
>  
>  let set_snapshot cmd snap = cmd.snapshot <- snap
>  let set_format cmd format = cmd.format <- format
> +let set_image_opts cmd imgopts = cmd.imgopts <- imgopts
>  
> -let run_unix socket { disk; snapshot; format } > +let run_unix socket {
disk; snapshot; format; imgopts } >    assert (disk <> "");
>  
>    (* Create a temporary directory where we place the PID file. *)
> @@ -85,6 +87,11 @@ let run_unix socket { disk; snapshot; format } >   
(* -s adds a protective overlay. *)
>    if snapshot then List.push_back args "-s";
>  
> +  (* --image-opts reinterprets the filename parameter as a set of
> +   * image options.
> +   *)
> +  if imgopts then List.push_back args "--image-opts";
> +
>    if have_selinux && qemu_nbd_has_selinux_label_option () then (
>      List.push_back args "--selinux-label";
>      List.push_back args "system_u:object_r:svirt_socket_t:s0"
> diff --git a/lib/qemuNBD.mli b/lib/qemuNBD.mli
> index e10d3106c7..afe9d944e1 100644
> --- a/lib/qemuNBD.mli
> +++ b/lib/qemuNBD.mli
> @@ -43,6 +43,11 @@ val set_snapshot : cmd -> bool -> unit
>  val set_format : cmd -> string option -> unit
>  (** Set the format [--format] parameter. *)
>  
> +val set_image_opts : cmd -> bool -> unit
> +(** Set whether the [--image-opts] parameter is used.  This changes
> +    the meaning of the [filename] parameter to a set of image options.
> +    Consult the qemu-nbd man page for more details. *)
> +
>  val run_unix : string -> cmd -> string * int
>  (** Start qemu-nbd command listening on a Unix domain socket,
>      waiting for the process to start up.
> diff --git a/output/output.ml b/output/output.ml
> index 5c6670b99c..5fe8555a7a 100644
> --- a/output/output.ml
> +++ b/output/output.ml
> @@ -69,7 +69,7 @@ let error_if_disk_count_gt dir n >    if
Sys.file_exists socket then
>      error (f_"this output module doesn't support copying more
than %d disks") n
>  
> -let output_to_local_file ?(changeuid = fun f -> f ())
> +let output_to_local_file ?(changeuid = fun f -> f ()) ?(compressed =
false)
>        output_alloc output_format filename size socket >    (* Check
nbdkit is installed and has the required plugin. *)
>    if not (Nbdkit.is_installed ()) then
> @@ -78,6 +78,10 @@ let output_to_local_file ?(changeuid = fun f -> f ())
>      error (f_"nbdkit-file-plugin is not installed or not
working");
>    let nbdkit_config = Nbdkit.config () in
>  
> +  (* Only allow compressed with -of qcow2. *)
> +  if compressed && output_format <> "qcow2" then
> +    error (f_"?-oo compressed? is only allowed when the output format
is a local qcow2-format file, ie ?-of qcow2?");
> +
Can you wrap this line?

(Although I notice there's another quite long line (another error
message) in this file, about nbdkit not being installed.)

I suggest "i.e.," rather than "ie".

>    let g = open_guestfs () in
>    let preallocation >      match output_alloc with
> @@ -103,9 +107,37 @@ let output_to_local_file ?(changeuid = fun f -> f
())
>       On_exit.kill pid
>  
>    | "qcow2" ->
> -     let cmd = QemuNBD.create filename in
> +     let cmd > +       if not compressed then (
IMO, whenever we have an "else" branch, it's better to simplify
the
condition by dropping "not", and swapping around the branches.
> +         let cmd = QemuNBD.create filename in
> +         QemuNBD.set_format cmd (Some "qcow2");
> +         cmd
> +       )
> +       else (
> +         (* Check nbdcopy is new enough.  This assumes that
> +          * the version of libnbd is the same as the version
> +          * of nbdcopy, but parsing this is easier.  We can
> +          * remove this check when we build-depend on
> +          * libnbd >= 1.14.
> +          *)
> +         let () 
What is the purpose of "let ()" here specifically?

(I know what it's good for in general, from your earlier reference
<https://baturin.org/docs/ocaml-faq/>, but I don't remember seeing it
much outside of the outermost scope.)
> +           let version = NBD.create () |> NBD.get_version in
> +           let version = String.nsplit "." version in
> +           let version = List.map int_of_string version in
> +           if version < [1; 13; 5] then
(Huh, didn't know such comparison existed, great!)
> +             error (f_"-oo compressed option requires nbdcopy >=
1.13.5") in
> +
> +         let qemu_quote str = String.replace str ","
",," in
> +         let image_opts = [ "driver=compress";
> +                            "file.driver=qcow2";
> +                            "file.file.driver=file";
> +                            "file.file.filename=" ^ qemu_quote
filename ] in
> +         let image_opts = String.concat "," image_opts in
> +         let cmd = QemuNBD.create image_opts in
> +         QemuNBD.set_image_opts cmd true;
> +         cmd
> +       ) in
>       QemuNBD.set_snapshot cmd false;
> -     QemuNBD.set_format cmd (Some "qcow2");
Aha! This actually supports my suggestion to drop the "not" from the
"if"'s condition, and swap the branches around -- that way the
patch
reads more easily. I first thought that the "set_format" call on the
not-compressed branch above materialized from thin air.
>       let _, pid = QemuNBD.run_unix socket cmd in
>       On_exit.kill pid
>  
> diff --git a/output/output.mli b/output/output.mli
> index 8d3d686594..c1f0f53d8e 100644
> --- a/output/output.mli
> +++ b/output/output.mli
> @@ -84,6 +84,7 @@ val error_if_disk_count_gt : string -> int -> unit
>      called. *)
>  
>  val output_to_local_file : ?changeuid:((unit -> unit) -> unit) ->
> +                           ?compressed:bool ->
>                             Types.output_allocation ->
>                             string -> string -> int64 -> string
->
>                             unit
> 
Only made some style comments; feel free to pick whatever you like (even
none):

Reviewed-by: Laszlo Ersek <lersek at redhat.com>

Thanks
Laszlo