[Libguestfs] [PATCH 4/6] dib: refactor output formats handling

Pino Toscano ptoscano at redhat.com
Thu Feb 2 13:43:23 UTC 2017


Implement a system similar to the operations in virt-sysprep, so each
output format has its own file and attributes (such as command line
arguments).

The result is that there is no more need to spread everywhere the job
required by each output format, such as checking for tools, or hooking
at the right point.
---
 dib/Makefile.am             |  13 +++-
 dib/cmdline.ml              |  59 ++++++---------
 dib/cmdline.mli             |   5 +-
 dib/dib.ml                  |  86 ++++------------------
 dib/output_format.ml        | 176 ++++++++++++++++++++++++++++++++++++++++++++
 dib/output_format.mli       | 122 ++++++++++++++++++++++++++++++
 dib/output_format_docker.ml |  56 ++++++++++++++
 dib/output_format_qcow2.ml  |  55 ++++++++++++++
 dib/output_format_raw.ml    |  31 ++++++++
 dib/output_format_tar.ml    |  34 +++++++++
 dib/output_format_vhd.ml    |  47 ++++++++++++
 11 files changed, 571 insertions(+), 113 deletions(-)
 create mode 100644 dib/output_format.ml
 create mode 100644 dib/output_format.mli
 create mode 100644 dib/output_format_docker.ml
 create mode 100644 dib/output_format_qcow2.ml
 create mode 100644 dib/output_format_raw.ml
 create mode 100644 dib/output_format_tar.ml
 create mode 100644 dib/output_format_vhd.ml

diff --git a/dib/Makefile.am b/dib/Makefile.am
index 2672321..42b7a5c 100644
--- a/dib/Makefile.am
+++ b/dib/Makefile.am
@@ -23,12 +23,23 @@ EXTRA_DIST = \
         virt-dib.pod
 
 SOURCES_MLI = \
-	cmdline.mli
+	cmdline.mli \
+	output_format.mli
+
+# Filenames output_format_<name>.ml in alphabetical order.
+formats = \
+	docker \
+	qcow2 \
+	raw \
+	tar \
+	vhd
 
 SOURCES_ML = \
 	utils.ml \
+	output_format.ml \
 	cmdline.ml \
 	elements.ml \
+	$(patsubst %,output_format_%.ml,$(formats)) \
 	dib.ml
 
 SOURCES_C = \
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index 418dbbd..875f617 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -42,8 +42,6 @@ type cmdline = {
   root_label : string option;
   install_type : string;
   image_cache : string option;
-  compressed : bool;
-  qemu_img_options : string option;
   mkfs_options : string option;
   is_ramdisk : bool;
   ramdisk_element : string;
@@ -52,10 +50,9 @@ type cmdline = {
   network : bool;
   smp : int option;
   delete_on_failure : bool;
-  formats : string list;
+  formats : Output_format.set;
   arch : string;
   envvars : string list;
-  docker_target : string option;
   checksum : bool;
 }
 
@@ -106,16 +103,17 @@ read the man page virt-dib(1).
   let smp = ref None in
   let set_smp arg = smp := Some arg in
 
-  let formats = ref ["qcow2"] in
+  let formats = ref None in
   let set_format arg =
     let fmts = remove_duplicates (String.nsplit "," arg) in
-    List.iter (
-      function
-      | "qcow2" | "tar" | "raw" | "vhd" | "docker" -> ()
-      | fmt ->
-        error (f_"invalid format '%s' in --formats") fmt
-    ) fmts;
-    formats := fmts in
+    let fmtset =
+      List.fold_left (
+        fun fmtset fmt ->
+          try Output_format.add_to_set fmt fmtset
+          with Not_found ->
+            error (f_"invalid format '%s' in --formats") fmt
+      ) Output_format.empty_set fmts in
+    formats := Some fmtset in
 
   let envvars = ref [] in
   let append_envvar arg = push_front arg envvars in
@@ -137,16 +135,11 @@ read the man page virt-dib(1).
   let image_cache = ref None in
   let set_image_cache arg = image_cache := Some arg in
 
-  let compressed = ref true in
-
   let delete_on_failure = ref true in
 
   let is_ramdisk = ref false in
   let ramdisk_element = ref "ramdisk" in
 
-  let qemu_img_options = ref None in
-  let set_qemu_img_options arg = qemu_img_options := Some arg in
-
   let mkfs_options = ref None in
   let set_mkfs_options arg = mkfs_options := Some arg in
 
@@ -156,9 +149,6 @@ read the man page virt-dib(1).
   let append_extra_packages arg =
     prepend (List.rev (String.nsplit "," arg)) extra_packages in
 
-  let docker_target = ref None in
-  let set_docker_target arg = docker_target := Some arg in
-
   let checksum = ref false in
 
   let argspec = [
@@ -172,14 +162,10 @@ read the man page virt-dib(1).
     [ L"root-label" ], Getopt.String ("label", set_root_label), s_"Label for the root fs";
     [ L"install-type" ], Getopt.Set_string ("type", install_type),  s_"Installation type";
     [ L"image-cache" ], Getopt.String ("directory", set_image_cache), s_"Location for cached images";
-    [ S 'u' ],           Getopt.Clear compressed,      "Do not compress the qcow2 image";
-    [ L"qemu-img-options" ], Getopt.String ("option", set_qemu_img_options),
-                                              s_"Add qemu-img options";
     [ L"mkfs-options" ], Getopt.String ("option", set_mkfs_options),
                                               s_"Add mkfs options";
     [ L"extra-packages" ], Getopt.String ("pkg,...", append_extra_packages),
       s_"Add extra packages to install";
-    [ L"docker-target" ], Getopt.String ("target", set_docker_target), s_"Repo and tag for docker";
     [ L"checksum" ],   Getopt.Set checksum,          s_"Generate MD5 and SHA256 checksum files";
 
     [ L"ramdisk" ],    Getopt.Set is_ramdisk,        "Switch to a ramdisk build";
@@ -204,6 +190,7 @@ read the man page virt-dib(1).
     [ L"debug" ],      Getopt.Int ("level", set_debug),         s_"Set debug level";
     [ S 'B' ],           Getopt.Set_string ("path", basepath),   s_"Base path of diskimage-builder library";
   ] in
+  let argspec = argspec @ Output_format.extra_args () in
 
   let opthandle = create_standard_options argspec ~anon_fun:append_element usage_msg in
   Getopt.parse opthandle;
@@ -229,33 +216,32 @@ read the man page virt-dib(1).
   let root_label = !root_label in
   let install_type = !install_type in
   let image_cache = !image_cache in
-  let compressed = !compressed in
   let delete_on_failure = !delete_on_failure in
   let is_ramdisk = !is_ramdisk in
   let ramdisk_element = !ramdisk_element in
-  let qemu_img_options = !qemu_img_options in
   let mkfs_options = !mkfs_options in
   let machine_readable = !machine_readable in
   let extra_packages = List.rev !extra_packages in
-  let docker_target = !docker_target in
   let checksum = !checksum in
 
   (* No elements and machine-readable mode?  Print some facts. *)
   if elements = [] && machine_readable then (
     printf "virt-dib\n";
-    printf "output:qcow2\n";
-    printf "output:tar\n";
-    printf "output:raw\n";
-    printf "output:vhd\n";
-    printf "output:docker\n";
+    let formats_list = Output_format.list_formats () in
+    List.iter (printf "output:%s\n") formats_list;
     exit 0
   );
 
   if basepath = "" then
     error (f_"-B must be specified");
 
-  if formats = [] then
-    error (f_"the list of output formats cannot be empty");
+  let formats =
+    match formats with
+    | None -> Output_format.add_to_set "qcow2" Output_format.empty_set
+    | Some fmtset ->
+      if Output_format.set_cardinal fmtset = 0 then
+        error (f_"the list of output formats cannot be empty");
+      fmtset in
 
   if elements = [] then
     error (f_"at least one distribution root element must be specified");
@@ -265,11 +251,10 @@ read the man page virt-dib(1).
     excluded_scripts = excluded_scripts; use_base = use_base; drive = drive;
     drive_format = drive_format; image_name = image_name; fs_type = fs_type;
     size = size; root_label = root_label; install_type = install_type;
-    image_cache = image_cache; compressed = compressed;
-    qemu_img_options = qemu_img_options; mkfs_options = mkfs_options;
+    image_cache = image_cache; mkfs_options = mkfs_options;
     is_ramdisk = is_ramdisk; ramdisk_element = ramdisk_element;
     extra_packages = extra_packages; memsize = memsize; network = network;
     smp = smp; delete_on_failure = delete_on_failure;
     formats = formats; arch = arch; envvars = envvars;
-    docker_target = docker_target; checksum = checksum;
+    checksum = checksum;
   }
diff --git a/dib/cmdline.mli b/dib/cmdline.mli
index 2e004a0..acfce5a 100644
--- a/dib/cmdline.mli
+++ b/dib/cmdline.mli
@@ -34,8 +34,6 @@ type cmdline = {
   root_label : string option;
   install_type : string;
   image_cache : string option;
-  compressed : bool;
-  qemu_img_options : string option;
   mkfs_options : string option;
   is_ramdisk : bool;
   ramdisk_element : string;
@@ -44,10 +42,9 @@ type cmdline = {
   network : bool;
   smp : int option;
   delete_on_failure : bool;
-  formats : string list;
+  formats : Output_format.set;
   arch : string;
   envvars : string list;
-  docker_target : string option;
   checksum : bool;
 }
 
diff --git a/dib/dib.ml b/dib/dib.ml
index 3f36997..71b1f7f 100644
--- a/dib/dib.ml
+++ b/dib/dib.ml
@@ -475,6 +475,9 @@ let run_install_packages ~debug ~blockdev ~log_file
   flush_all ();
   out
 
+(* Finalize the list of output formats. *)
+let () = Output_format.bake ()
+
 let main () =
   let cmdline = parse_cmdline () in
   let debug = cmdline.debug in
@@ -488,15 +491,7 @@ let main () =
 
   (* Check for required tools. *)
   require_tool "uuidgen";
-  if List.mem "docker" cmdline.formats then (
-    require_tool "docker";
-    if cmdline.docker_target = None then
-      error (f_"docker: a target was not specified, use '--docker-target'");
-  );
-  if List.mem "qcow2" cmdline.formats then
-    require_tool "qemu-img";
-  if List.mem "vhd" cmdline.formats then
-    require_tool "vhd-util";
+  Output_format.check_formats_prerequisites cmdline.formats;
   if cmdline.checksum then
     List.iter (fun x -> require_tool (tool_of_checksum x)) checksums;
 
@@ -600,13 +595,6 @@ let main () =
 
   let rootfs_uuid = uuidgen () in
 
-  let formats_img, formats_archive = List.partition (
-    function
-    | "qcow2" | "raw" | "vhd" -> true
-    | _ -> false
-  ) cmdline.formats in
-  let formats_img_nonraw = List.filter ((<>) "raw") formats_img in
-
   prepare_aux ~envvars ~dib_args ~dib_vars ~log_file ~out_name:image_basename
               ~rootfs_uuid ~arch ~network:cmdline.network ~root_label
               ~install_type:cmdline.install_type ~debug
@@ -618,10 +606,11 @@ let main () =
   let delete_output_file = ref cmdline.delete_on_failure in
   let delete_file () =
     if !delete_output_file then (
+      let filenames = Output_format.get_filenames cmdline.formats cmdline.image_name in
       List.iter (
-        fun fmt ->
-          try Unix.unlink (output_filename cmdline.image_name fmt) with _ -> ()
-      ) cmdline.formats
+        fun fn ->
+          try Unix.unlink fn with _ -> ()
+      ) filenames
     )
   in
   at_exit delete_file;
@@ -673,7 +662,7 @@ let main () =
       (* If "raw" is among the selected outputs, use it as main backing
        * disk, otherwise create a temporary disk.
        *)
-      if not is_ramdisk_build && List.mem "raw" formats_img then
+      if not is_ramdisk_build && Output_format.set_mem "raw" cmdline.formats then
         cmdline.image_name
       else
         Filename.temp_file ~temp_dir:tmpdir "image." "" in
@@ -889,26 +878,7 @@ let main () =
 
   flush_all ();
 
-  List.iter (
-    fun fmt ->
-      let fn = output_filename cmdline.image_name fmt in
-      match fmt with
-      | "tar" ->
-        message (f_"Compressing the image as tar");
-        g#tar_out ~excludes:[| "./sys/*"; "./proc/*" |] "/" fn
-      | "docker" ->
-        let docker_target =
-          match cmdline.docker_target with
-          | None -> assert false (* checked earlier *)
-          | Some t -> t in
-        message (f_"Importing the image to docker as '%s'") docker_target;
-        let dockertmp =
-          Filename.temp_file ~temp_dir:tmpdir "docker." ".tar" in
-        g#tar_out ~excludes:[| "./sys/*"; "./proc/*" |] "/" dockertmp;
-        let cmd = [ "sudo"; "docker"; "import"; dockertmp; docker_target ] in
-        if run_command cmd <> 0 then exit 1
-      | _ as fmt -> error "unhandled format: %s" fmt
-  ) formats_archive;
+  Output_format.run_formats_on_filesystem cmdline.formats g cmdline.image_name tmpdir;
 
   message (f_"Umounting the disks");
 
@@ -925,40 +895,14 @@ let main () =
   flush_all ();
 
   (* Don't produce images as output when doing a ramdisk build. *)
-  if not is_ramdisk_build then (
-    List.iter (
-      fun fmt ->
-        let fn = output_filename cmdline.image_name fmt in
-        message (f_"Converting to %s") fmt;
-        match fmt with
-        | "qcow2" ->
-          let cmd = [ "qemu-img"; "convert" ] @
-            (if cmdline.compressed then [ "-c" ] else []) @
-            [ "-f"; tmpdiskfmt; tmpdisk; "-O"; fmt ] @
-            (match cmdline.qemu_img_options with
-            | None -> []
-            | Some opt -> [ "-o"; opt ]) @
-            [ qemu_input_filename fn ] in
-          if run_command cmd <> 0 then exit 1;
-        | "vhd" ->
-          let fn_intermediate = Filename.temp_file ~temp_dir:tmpdir "vhd-intermediate." "" in
-          let cmd = [ "vhd-util"; "convert"; "-s"; "0"; "-t"; "1";
-                      "-i"; tmpdisk; "-o"; fn_intermediate ] in
-          if run_command cmd <> 0 then exit 1;
-          let cmd = [ "vhd-util"; "convert"; "-s"; "1"; "-t"; "2";
-                      "-i"; fn_intermediate; "-o"; fn ] in
-          if run_command cmd <> 0 then exit 1;
-          if not (Sys.file_exists fn) then
-            error (f_"VHD output not produced, most probably vhd-util is old or not patched for 'convert'")
-        | _ as fmt -> error "unhandled format: %s" fmt
-    ) formats_img_nonraw;
-  );
+  if not is_ramdisk_build then
+    Output_format.run_formats_on_file cmdline.formats cmdline.image_name (tmpdisk, tmpdiskfmt) tmpdir;
 
   if not is_ramdisk_build && cmdline.checksum then (
     let file_flags = [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC; Unix.O_CLOEXEC; ] in
+    let filenames = Output_format.get_filenames cmdline.formats cmdline.image_name in
     List.iter (
-      fun fmt ->
-        let fn = output_filename cmdline.image_name fmt in
+      fun fn ->
         message (f_"Generating checksums for %s") fn;
         let pids =
           List.map (
@@ -998,7 +942,7 @@ let main () =
                 csum_tool i
           );
         done;
-    ) formats_img;
+    ) filenames;
   );
 
   message (f_"Done")
diff --git a/dib/output_format.ml b/dib/output_format.ml
new file mode 100644
index 0000000..f311b8d
--- /dev/null
+++ b/dib/output_format.ml
@@ -0,0 +1,176 @@
+(* virt-dib
+ * Copyright (C) 2012-2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Common_utils
+open Common_gettext.Gettext
+open Getopt.OptionName
+
+open Utils
+
+type format = {
+  name : string;
+  extra_args : extra_arg list;
+  output_to_file : bool;
+  check_prerequisites : (unit -> unit) option;
+  run_on_filesystem : (Guestfs.guestfs -> string -> string -> unit) option;
+  run_on_file : (string -> (string * string) -> string -> unit) option;
+}
+and extra_arg = {
+  extra_argspec : Getopt.keys * Getopt.spec * Getopt.doc;
+}
+
+let defaults = {
+  name = "";
+  extra_args = [];
+  output_to_file = true;
+  check_prerequisites = None;
+  run_on_filesystem = None;
+  run_on_file = None;
+}
+
+let all_formats = ref []
+
+module FormatSet = Set.Make (
+  struct
+    type t = format
+    let compare a b = compare a.name b.name
+  end
+)
+type set = FormatSet.t
+
+let empty_set = FormatSet.empty
+
+let add_to_set name set =
+  let op = List.find (fun { name = n } -> name = n) !all_formats in
+  FormatSet.add op set
+
+let set_mem x set =
+  FormatSet.exists (fun { name = n } -> n = x) set
+
+let set_cardinal set =
+  FormatSet.cardinal set
+
+let register_format op =
+  push_front op all_formats
+
+let baked = ref false
+let rec bake () =
+  (* Note we actually want all_formats to be sorted by name,
+   * ignoring the order field.
+   *)
+  let ops =
+    List.sort (fun { name = a } { name = b } -> compare a b) !all_formats in
+  check_no_dupes ops;
+  List.iter check ops;
+  all_formats := ops;
+  baked := true
+and check_no_dupes ops =
+  ignore (
+    List.fold_left (
+      fun opset op ->
+        if FormatSet.mem op opset then
+          error (f_"duplicate format name (%s)") op.name;
+        add_to_set op.name opset
+    ) empty_set ops
+  )
+and check op =
+  let n = String.length op.name in
+  if n = 0 then
+    error (f_"format name is an empty string");
+  for i = 0 to n-1 do
+    match String.unsafe_get op.name i with
+    | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' -> ()
+    | c ->
+      error (f_"disallowed character (%c) in format name") c
+  done
+
+let extra_args () =
+  assert !baked;
+
+  List.flatten (
+    List.map (fun { extra_args = extra_args } ->
+      List.map (fun { extra_argspec = argspec } -> argspec) extra_args
+    ) !all_formats
+  )
+
+let list_formats () =
+  assert !baked;
+
+  List.map (fun { name = n } -> n) !all_formats
+
+let compare_formats { name = n1 } { name = n2 } =
+  compare n1 n2
+
+let check_formats_prerequisites ~formats =
+  assert !baked;
+
+  (* Run the formats in alphabetical, rather than random order. *)
+  let formats = List.sort compare_formats (FormatSet.elements formats) in
+
+  List.iter (
+    function
+    | { check_prerequisites = Some fn } ->
+      fn ()
+    | { check_prerequisites = None } -> ()
+  ) formats
+
+let run_formats_on_filesystem ~formats g image_name tmpdir =
+  assert !baked;
+
+  (* Run the formats in alphabetical, rather than random order. *)
+  let formats = List.sort compare_formats (FormatSet.elements formats) in
+
+  List.iter (
+    function
+    | { run_on_filesystem = Some fn; name; output_to_file } ->
+      let filename =
+        if output_to_file then output_filename image_name name
+        else "" in
+      fn g filename tmpdir
+    | { run_on_filesystem = None } -> ()
+  ) formats
+
+let run_formats_on_file ~formats image_name tmpdisk tmpdir  =
+  assert !baked;
+
+  (* Run the formats in alphabetical, rather than random order. *)
+  let formats = List.sort compare_formats (FormatSet.elements formats) in
+
+  List.iter (
+    function
+    | { run_on_file = Some fn; name; output_to_file } ->
+      let filename =
+        if output_to_file then output_filename image_name name
+        else "" in
+      fn filename tmpdisk tmpdir
+    | { run_on_file = None } -> ()
+  ) formats
+
+let get_filenames ~formats image_name =
+  assert !baked;
+
+  (* Run the formats in alphabetical, rather than random order. *)
+  let formats = List.sort compare_formats (FormatSet.elements formats) in
+
+  filter_map (
+    function
+    | { output_to_file = true; name } ->
+      Some (output_filename image_name name)
+    | { output_to_file = false } ->
+      None
+  ) formats
diff --git a/dib/output_format.mli b/dib/output_format.mli
new file mode 100644
index 0000000..e935f6f
--- /dev/null
+++ b/dib/output_format.mli
@@ -0,0 +1,122 @@
+(* virt-dib
+ * Copyright (C) 2012-2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** Handling of output formats. *)
+
+(** Structure used to describe output formats. *)
+type format = {
+  name : string;
+  (** The name of the format, which is exposed via the [--formats]
+      command line parameter.  Must contain only alphanumeric and
+      '-' (dash) character. *)
+
+  extra_args : extra_arg list;
+  (** Extra command-line arguments, if any.  eg. The [docker]
+      format has an extra [--docker-target] parameter.
+
+      For a description of each list element, see {!extra_arg} below.
+
+      You can decide the types of the arguments, whether they are
+      mandatory etc. *)
+
+  output_to_file : bool;
+  (** Whether the format writes to a file.  Most of the formats
+      produce a file as result, although some (e.g. docker) do
+      not. *)
+
+  check_prerequisites : (unit -> unit) option;
+  (** The function which is called after the command line processing
+      to check whether the requirements for this format (available
+      tools, values for command line arguments, etc) are fulfilled. *)
+
+  run_on_filesystem : (Guestfs.guestfs -> string -> string -> unit) option;
+  (** The function which is called to perform the export while the
+      guest is mounted.
+
+      The parameters are:
+      - [g]: the libguestfs handle
+      - [filename]: the output filename for the format, or an empty
+        string if {!output_to_file} is [false]
+      - [tmpdir]: the temporary directory currently in use *)
+
+  run_on_file : (string -> (string * string) -> string -> unit) option;
+  (** The function which is called to perform the export using the
+      temporary disk as reference.
+
+      The parameters are:
+      - [filename]: the output filename for the format, or an empty
+        string if {!output_to_file} is [false]
+      - [tmpdisk]: a tuple representing the temporary disk, as
+        [(filename, format)]
+      - [tmpdir]: the temporary directory currently in use *)
+}
+
+and extra_arg = {
+  extra_argspec : Getopt.keys * Getopt.spec * Getopt.doc;
+  (** The argspec.  See [Getopt] module in [mllib]. *)
+}
+
+val defaults : format
+(** This is so formats can write [let op = { defaults with ... }]. *)
+
+val register_format : format -> unit
+(** Register a format. *)
+
+val bake : unit -> unit
+(** 'Bake' is called after all modules have been registered.  We
+    finalize the list of formats, sort it, and run some checks. *)
+
+val extra_args : unit -> Getopt.speclist
+(** Get the list of extra arguments for the command line. *)
+
+val list_formats : unit -> string list
+(** List supported formats. *)
+
+type set
+(** A (sub-)set of formats. *)
+
+val empty_set : set
+(** Empty set of formats. *)
+
+val add_to_set : string -> set -> set
+(** [add_to_set name set] adds the format named [name] to [set].
+
+    Note that this will raise [Not_found] if [name] is not
+    a valid format name. *)
+
+val set_mem : string -> set -> bool
+(** Check whether the specified format is in the set. *)
+
+val set_cardinal : set -> int
+(** Return the size of the formats set. *)
+
+val check_formats_prerequisites : formats:set -> unit
+(** Check the prerequisites in all the formats listed in the [formats] set. *)
+
+val run_formats_on_filesystem : formats:set -> Guestfs.guestfs -> string -> string -> unit
+(** Run the filesystem-based export for all the formats listed in the
+    [formats] set. *)
+
+val run_formats_on_file : formats:set -> string -> (string * string) -> string -> unit
+(** Run the disk-based export for all the formats listed in the
+    [formats] set. *)
+
+val get_filenames : formats:set -> string -> string list
+(** Return the list of all the output filenames for formats in the
+    [formats] set.  Only formats with {!output_to_file} as [true]
+    will be taken into account. *)
diff --git a/dib/output_format_docker.ml b/dib/output_format_docker.ml
new file mode 100644
index 0000000..5303cf9
--- /dev/null
+++ b/dib/output_format_docker.ml
@@ -0,0 +1,56 @@
+(* virt-dib
+ * Copyright (C) 2016-2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Common_utils
+open Common_gettext.Gettext
+open Getopt.OptionName
+
+open Utils
+open Output_format
+
+let docker_target = ref None
+let set_docker_target arg = docker_target := Some arg
+
+let docker_check () =
+  require_tool "docker";
+  if !docker_target = None then
+    error (f_"docker: a target was not specified, use '--docker-target'")
+
+let docker_run_fs (g : Guestfs.guestfs) _ temp_dir =
+  let docker_target =
+    match !docker_target with
+    | None -> assert false (* checked earlier *)
+    | Some t -> t in
+  message (f_"Importing the image to docker as '%s'") docker_target;
+  let dockertmp = Filename.temp_file ~temp_dir "docker." ".tar" in
+  g#tar_out ~excludes:[| "./sys/*"; "./proc/*" |] "/" dockertmp;
+  let cmd = [ "sudo"; "docker"; "import"; dockertmp; docker_target ] in
+  if run_command cmd <> 0 then exit 1
+
+let fmt = {
+  defaults with
+    name = "docker";
+    output_to_file = false;
+    extra_args = [
+      { extra_argspec = [ L"docker-target" ], Getopt.String ("target", set_docker_target), s_"Repo and tag for docker"; };
+    ];
+    check_prerequisites = Some docker_check;
+    run_on_filesystem = Some docker_run_fs;
+}
+
+let () = register_format fmt
diff --git a/dib/output_format_qcow2.ml b/dib/output_format_qcow2.ml
new file mode 100644
index 0000000..afb564c
--- /dev/null
+++ b/dib/output_format_qcow2.ml
@@ -0,0 +1,55 @@
+(* virt-dib
+ * Copyright (C) 2015-2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Common_utils
+open Common_gettext.Gettext
+open Getopt.OptionName
+
+open Utils
+open Output_format
+
+let compressed = ref true
+let qemu_img_options = ref None
+let set_qemu_img_options arg = qemu_img_options := Some arg
+
+let qcow2_check () =
+  require_tool "qemu-img"
+
+let qcow2_run_file filename (tmpdisk, tmpdiskfmt) _ =
+  message (f_"Converting to qcow2");
+  let cmd = [ "qemu-img"; "convert" ] @
+    (if !compressed then [ "-c" ] else []) @
+    [ "-f"; tmpdiskfmt; tmpdisk; "-O"; "qcow2" ] @
+    (match !qemu_img_options with
+    | None -> []
+    | Some opt -> [ "-o"; opt ]) @
+    [ qemu_input_filename filename ] in
+  if run_command cmd <> 0 then exit 1
+
+let fmt = {
+  defaults with
+    name = "qcow2";
+    extra_args = [
+      { extra_argspec = [ S 'u' ], Getopt.Clear compressed, s_"Do not compress the qcow2 image"; };
+      { extra_argspec = [ L"qemu-img-options" ], Getopt.String ("option", set_qemu_img_options), s_"Add qemu-img options"; };
+    ];
+    check_prerequisites = Some qcow2_check;
+    run_on_file = Some qcow2_run_file;
+}
+
+let () = register_format fmt
diff --git a/dib/output_format_raw.ml b/dib/output_format_raw.ml
new file mode 100644
index 0000000..b130907
--- /dev/null
+++ b/dib/output_format_raw.ml
@@ -0,0 +1,31 @@
+(* virt-dib
+ * Copyright (C) 2015-2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Output_format
+
+(* The raw format is currently handled on its own in virt-dib,
+ * so this is merely to add the output format to the available
+ * ones.  This might change in the future, though.
+ *)
+
+let fmt = {
+  defaults with
+    name = "raw";
+}
+
+let () = register_format fmt
diff --git a/dib/output_format_tar.ml b/dib/output_format_tar.ml
new file mode 100644
index 0000000..d8d5bfa
--- /dev/null
+++ b/dib/output_format_tar.ml
@@ -0,0 +1,34 @@
+(* virt-dib
+ * Copyright (C) 2015-2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Common_utils
+open Common_gettext.Gettext
+
+open Output_format
+
+let tar_run_fs (g : Guestfs.guestfs) filename _ =
+  message (f_"Compressing the image as tar");
+  g#tar_out ~excludes:[| "./sys/*"; "./proc/*" |] "/" filename
+
+let fmt = {
+  defaults with
+    name = "tar";
+    run_on_filesystem = Some tar_run_fs;
+}
+
+let () = register_format fmt
diff --git a/dib/output_format_vhd.ml b/dib/output_format_vhd.ml
new file mode 100644
index 0000000..2e31f93
--- /dev/null
+++ b/dib/output_format_vhd.ml
@@ -0,0 +1,47 @@
+(* virt-dib
+ * Copyright (C) 2015-2017 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Common_utils
+open Common_gettext.Gettext
+
+open Utils
+open Output_format
+
+let vhd_check () =
+  require_tool "vhd-util"
+
+let vhd_run_file filename (tmpdisk, _) temp_dir =
+  message (f_"Converting to VHD");
+  let fn_intermediate = Filename.temp_file ~temp_dir "vhd-intermediate." "" in
+  let cmd = [ "vhd-util"; "convert"; "-s"; "0"; "-t"; "1";
+              "-i"; tmpdisk; "-o"; fn_intermediate ] in
+  if run_command cmd <> 0 then exit 1;
+  let cmd = [ "vhd-util"; "convert"; "-s"; "1"; "-t"; "2";
+              "-i"; fn_intermediate; "-o"; filename ] in
+  if run_command cmd <> 0 then exit 1;
+  if not (Sys.file_exists filename) then
+    error (f_"VHD output not produced, most probably vhd-util is old or not patched for 'convert'")
+
+let fmt = {
+  defaults with
+    name = "vhd";
+    check_prerequisites = Some vhd_check;
+    run_on_file = Some vhd_run_file;
+}
+
+let () = register_format fmt
-- 
2.9.3




More information about the Libguestfs mailing list