From 80831868395d161af8c47edf2f54234c63581d8d Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Fri, 28 Jan 2022 09:30:29 +0000
Subject: [PATCH] qemu-nbd: Implement output compression for qcow2 files

Reviewed-by: Laszlo Ersek <lersek@redhat.com>
(cherry picked from commit 71c4301909cb307def02ebcd0e89beee4138e7f2)
---
 lib/qemuNBD.ml    | 11 +++++++++--
 lib/qemuNBD.mli   |  5 +++++
 output/output.ml  | 39 ++++++++++++++++++++++++++++++++++++---
 output/output.mli |  1 +
 4 files changed, 51 insertions(+), 5 deletions(-)

diff --git a/lib/qemuNBD.ml b/lib/qemuNBD.ml
index ae21b17c..bbb65f41 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 e10d3106..afe9d944 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 5c6670b9..23c3932d 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,24 @@ 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
 
+  if compressed then (
+    (* Only allow compressed with -of qcow2. *)
+    if output_format <> "qcow2" then
+      error (f_"‘-oo compressed’ is only allowed when the output format \
+                is a local qcow2-format file, i.e. ‘-of qcow2’");
+
+    (* 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 version =
+      NBD.create () |> NBD.get_version |>
+      String.nsplit "." |> List.map int_of_string in
+    if version < [1; 13; 5] then
+      error (f_"-oo compressed option requires nbdcopy >= 1.13.5")
+  );
+
   let g = open_guestfs () in
   let preallocation =
     match output_alloc with
@@ -103,9 +121,24 @@ let output_to_local_file ?(changeuid = fun f -> f ())
      On_exit.kill pid
 
   | "qcow2" ->
-     let cmd = QemuNBD.create filename in
+     let cmd =
+       if compressed then (
+         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
+       )
+       else (* not compressed *) (
+         let cmd = QemuNBD.create filename in
+         QemuNBD.set_format cmd (Some "qcow2");
+         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 8d3d6865..c1f0f53d 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