[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]

[Libguestfs] [PATCH 1/2] dib: Make the interface between cmdline.ml and dib.ml explicit.



---
 dib/Makefile.am |   5 ++-
 dib/cmdline.ml  |  49 +++++++++++++++++++++---
 dib/cmdline.mli |  51 +++++++++++++++++++++++++
 dib/dib.ml      | 113 ++++++++++++++++++++++++++++++--------------------------
 4 files changed, 158 insertions(+), 60 deletions(-)
 create mode 100644 dib/cmdline.mli

diff --git a/dib/Makefile.am b/dib/Makefile.am
index 0786d64..ad1fd6a 100644
--- a/dib/Makefile.am
+++ b/dib/Makefile.am
@@ -18,11 +18,14 @@
 include $(top_srcdir)/subdir-rules.mk
 
 EXTRA_DIST = \
-	$(SOURCES_ML) $(SOURCES_C) \
+	$(SOURCES_MLI) $(SOURCES_ML) $(SOURCES_C) \
         virt-dib.pod
 
 CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o virt-dib
 
+SOURCES_MLI = \
+	cmdline.mli
+
 SOURCES_ML = \
 	utils.ml \
 	cmdline.ml \
diff --git a/dib/cmdline.ml b/dib/cmdline.ml
index 4aa6a53..3a97366 100644
--- a/dib/cmdline.ml
+++ b/dib/cmdline.ml
@@ -25,7 +25,37 @@ open Utils
 
 open Printf
 
-let parse_args () =
+type cmdline = {
+  debug : int;
+  basepath : string;
+  elements : string list;
+  excluded_elements : string list;
+  element_paths : string list;
+  excluded_scripts : string list;
+  use_base : bool;
+  drive : string option;
+  image_name : string;
+  fs_type : string;
+  size : int64;
+  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;
+  extra_packages : string list;
+  memsize : int option;
+  network : bool;
+  smp : int option;
+  delete_on_failure : bool;
+  formats : string list;
+  arch : string;
+  envvars : string list;
+}
+
+let parse_cmdline () =
   let usage_msg =
     sprintf (f_"\
 %s: run diskimage-builder elements to generate images
@@ -220,8 +250,15 @@ read the man page virt-dib(1).
   if elements = [] then
     error (f_"at least one distribution root element must be specified");
 
-  debug, basepath, elements, excluded_elements, element_paths,
-  excluded_scripts, use_base, drive,
-  image_name, fs_type, size, root_label, install_type, image_cache, compressed,
-  qemu_img_options, mkfs_options, is_ramdisk, ramdisk_element, extra_packages,
-  memsize, network, smp, delete_on_failure, formats, arch, envvars
+  { debug = debug; basepath = basepath; elements = elements;
+    excluded_elements = excluded_elements; element_paths = element_paths;
+    excluded_scripts = excluded_scripts; use_base = use_base; drive = drive;
+    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;
+    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;
+  }
diff --git a/dib/cmdline.mli b/dib/cmdline.mli
new file mode 100644
index 0000000..0a1aa9d
--- /dev/null
+++ b/dib/cmdline.mli
@@ -0,0 +1,51 @@
+(* virt-dib
+ * Copyright (C) 2015 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.
+ *)
+
+(** Command line argument parsing. *)
+
+type cmdline = {
+  debug : int;
+  basepath : string;
+  elements : string list;
+  excluded_elements : string list;
+  element_paths : string list;
+  excluded_scripts : string list;
+  use_base : bool;
+  drive : string option;
+  image_name : string;
+  fs_type : string;
+  size : int64;
+  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;
+  extra_packages : string list;
+  memsize : int option;
+  network : bool;
+  smp : int option;
+  delete_on_failure : bool;
+  formats : string list;
+  arch : string;
+  envvars : string list;
+}
+
+val parse_cmdline : unit -> cmdline
diff --git a/dib/dib.ml b/dib/dib.ml
index fdb5857..4a0c9ee 100644
--- a/dib/dib.ml
+++ b/dib/dib.ml
@@ -432,28 +432,24 @@ let run_install_packages ~debug ~blockdev ~log_file
   out
 
 let main () =
-  let debug, basepath, elements, excluded_elements, element_paths,
-    excluded_scripts, use_base, drive,
-    image_name, fs_type, size, root_label, install_type, image_cache, compressed,
-    qemu_img_options, mkfs_options, is_ramdisk, ramdisk_element, extra_packages,
-    memsize, network, smp, delete_on_failure, formats, arch, envvars =
-    parse_args () in
+  let cmdline = parse_cmdline () in
+  let debug = cmdline.debug in
 
   (* Check that the specified base directory of diskimage-builder
    * has the "die" script in it, so we know the directory is the
    * right one (hopefully so, at least).
    *)
-  if not (Sys.file_exists (basepath // "die")) then
+  if not (Sys.file_exists (cmdline.basepath // "die")) then
     error (f_"the specified base path is not the diskimage-builder library");
 
   (* Check for required tools. *)
   require_tool "uuidgen";
-  if List.mem "qcow2" formats then
+  if List.mem "qcow2" cmdline.formats then
     require_tool "qemu-img";
-  if List.mem "vhd" formats then
+  if List.mem "vhd" cmdline.formats then
     require_tool "vhd-util";
 
-  let image_basename = Filename.basename image_name in
+  let image_basename = Filename.basename cmdline.image_name in
   let image_basename_d = image_basename ^ ".d" in
 
   let tmpdir = Mkdtemp.temp_dir "dib." "" in
@@ -465,15 +461,19 @@ let main () =
   let extradatatmpdir = tmpdir // "extra-data" in
   do_mkdir extradatatmpdir;
   do_mkdir (auxtmpdir // "out" // image_basename_d);
-  let elements = if use_base then ["base"] @ elements else elements in
-  let elements = if is_ramdisk then [ramdisk_element] @ elements else elements in
+  let elements =
+    if cmdline.use_base then ["base"] @ cmdline.elements
+    else cmdline.elements in
+  let elements =
+    if cmdline.is_ramdisk then [cmdline.ramdisk_element] @ elements
+    else elements in
   message (f_"Elements: %s") (String.concat " " elements);
   if debug >= 1 then (
     printf "tmpdir: %s\n" tmpdir;
-    printf "element paths: %s\n" (String.concat ":" element_paths);
+    printf "element paths: %s\n" (String.concat ":" cmdline.element_paths);
   );
 
-  let loaded_elements = load_elements ~debug element_paths in
+  let loaded_elements = load_elements ~debug cmdline.element_paths in
   if debug >= 1 then (
     printf "loaded elements:\n";
     Hashtbl.iter (
@@ -488,11 +488,11 @@ let main () =
   );
   let all_elements = load_dependencies elements loaded_elements in
   let all_elements = exclude_elements all_elements
-    (excluded_elements @ builtin_elements_blacklist) in
+    (cmdline.excluded_elements @ builtin_elements_blacklist) in
 
   message (f_"Expanded elements: %s") (String.concat " " (StringSet.elements all_elements));
 
-  let envvars = read_envvars envvars in
+  let envvars = read_envvars cmdline.envvars in
   message (f_"Carried environment variables: %s") (String.concat " " (List.map fst envvars));
   if debug >= 1 then (
     printf "carried over envvars:\n";
@@ -515,7 +515,7 @@ let main () =
   message (f_"Preparing auxiliary data");
 
   copy_elements all_elements loaded_elements
-    (excluded_scripts @ builtin_scripts_blacklist) hookstmpdir;
+    (cmdline.excluded_scripts @ builtin_scripts_blacklist) hookstmpdir;
 
   (* Re-read the hook scripts from the hooks dir, as d-i-b (and we too)
    * has basically copied over anything found in elements.
@@ -525,24 +525,24 @@ let main () =
   let log_file = "/tmp/aux/perm/" ^ (log_filename ()) in
 
   let arch =
-    match arch with
+    match cmdline.arch with
     | "" -> current_arch ()
     | arch -> arch in
 
   let root_label =
-    match root_label with
+    match cmdline.root_label with
     | None ->
       (* XFS has a limit of 12 characters for filesystem labels.
        * Not changing the default for other filesystems to maintain
        * backwards compatibility.
        *)
-      (match fs_type with
+      (match cmdline.fs_type with
       | "xfs" -> "img-rootfs"
       | _ -> "cloudimg-rootfs")
     | Some label -> label in
 
   let image_cache =
-    match image_cache with
+    match cmdline.image_cache with
     | None -> Sys.getenv "HOME" // ".cache" // "image-create"
     | Some dir -> dir in
   do_mkdir image_cache;
@@ -553,29 +553,32 @@ let main () =
     function
     | "qcow2" | "raw" | "vhd" -> true
     | _ -> false
-  ) formats in
+  ) 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 ~root_label ~install_type ~debug
-    ~extra_packages
-    auxtmpdir all_elements;
+              ~rootfs_uuid ~arch ~network:cmdline.network ~root_label
+              ~install_type:cmdline.install_type ~debug
+              ~extra_packages:cmdline.extra_packages
+              auxtmpdir all_elements;
 
-  let delete_output_file = ref delete_on_failure in
+  let delete_output_file = ref cmdline.delete_on_failure in
   let delete_file () =
     if !delete_output_file then (
       List.iter (
         fun fmt ->
-          try Unix.unlink (output_filename image_name fmt) with _ -> ()
-      ) formats
+          try Unix.unlink (output_filename cmdline.image_name fmt) with _ -> ()
+      ) cmdline.formats
     )
   in
   at_exit delete_file;
 
   prepare_external ~dib_args ~dib_vars ~out_name:image_basename ~root_label
-    ~rootfs_uuid ~image_cache ~arch ~network ~debug
-    tmpdir basepath hookstmpdir extradatatmpdir (auxtmpdir // "fake-bin")
-    all_elements element_paths;
+                   ~rootfs_uuid ~image_cache ~arch ~network:cmdline.network
+                   ~debug
+                   tmpdir cmdline.basepath hookstmpdir extradatatmpdir
+                   (auxtmpdir // "fake-bin")
+                   all_elements cmdline.element_paths;
 
   let run_hook_host hook =
     try
@@ -623,13 +626,14 @@ let main () =
 
   message (f_"Opening the disks");
 
-  let is_ramdisk_build = is_ramdisk || StringSet.mem "ironic-agent" all_elements in
+  let is_ramdisk_build =
+    cmdline.is_ramdisk || StringSet.mem "ironic-agent" all_elements in
 
   let g, tmpdisk, tmpdiskfmt, drive_partition =
     let g = open_guestfs () in
-    may g#set_memsize memsize;
-    may g#set_smp smp;
-    g#set_network network;
+    may g#set_memsize cmdline.memsize;
+    may g#set_smp cmdline.smp;
+    g#set_network cmdline.network;
 
     (* Make sure to turn SELinux off to avoid awkward interactions
      * between the appliance kernel and applications/libraries interacting
@@ -643,17 +647,19 @@ 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 image_name
-      else Filename.temp_file ~temp_dir:tmpdir "image." "" in
+      if not is_ramdisk_build && List.mem "raw" formats_img then
+        cmdline.image_name
+      else
+        Filename.temp_file ~temp_dir:tmpdir "image." "" in
     let fn = output_filename fn fmt in
     (* Produce the output image. *)
-    g#disk_create fn fmt size;
+    g#disk_create fn fmt cmdline.size;
     g#add_drive ~readonly:false ~format:fmt fn;
 
     (* Helper drive for elements and binaries. *)
     g#add_drive_scratch (unit_GB 5);
 
-    (match drive with
+    (match cmdline.drive with
     | None ->
       g#add_drive_scratch (unit_GB 5)
     | Some drive ->
@@ -667,12 +673,12 @@ let main () =
     g#mount "/dev/sdb" "/";
 
     copy_in g auxtmpdir "/";
-    copy_in g basepath "/lib";
+    copy_in g cmdline.basepath "/lib";
     g#umount "/";
 
     (* Prepare the /aux/perm partition. *)
     let drive_partition =
-      match drive with
+      match cmdline.drive with
       | None ->
         g#mkfs "ext2" "/dev/sdc";
         "/dev/sdc"
@@ -758,11 +764,11 @@ let main () =
 
   (* Create and mount the target filesystem. *)
   let mkfs_options =
-    match mkfs_options with
+    match cmdline.mkfs_options with
     | None -> []
     | Some o -> [ o ] in
   let mkfs_options =
-    (match fs_type with
+    (match cmdline.fs_type with
     | "ext4" ->
       (* Very conservative to handle images being resized a lot
        * Without -J option specified, default journal size will be set to 32M
@@ -770,10 +776,10 @@ let main () =
        *)
       [ "-i"; "4096"; "-J"; "size=64" ]
     | _ -> []
-    ) @ mkfs_options @ [ "-t"; fs_type; blockdev ] in
+    ) @ mkfs_options @ [ "-t"; cmdline.fs_type; blockdev ] in
   ignore (g#debug "sh" (Array.of_list ([ "mkfs" ] @ mkfs_options)));
   g#set_label blockdev root_label;
-  (match fs_type with
+  (match cmdline.fs_type with
   | x when String.is_prefix x "ext" -> g#set_uuid blockdev rootfs_uuid
   | _ -> ());
   g#mount blockdev "/";
@@ -805,8 +811,9 @@ let main () =
 
   run_hook_in "pre-install.d";
 
-  if extra_packages <> [] then
-    ignore (run_install_packages ~debug ~blockdev ~log_file g extra_packages);
+  if cmdline.extra_packages <> [] then
+    ignore (run_install_packages ~debug ~blockdev ~log_file g
+                                 cmdline.extra_packages);
 
   run_hook_in "install.d";
 
@@ -832,8 +839,8 @@ let main () =
 
   if g#ls out_dir <> [||] then (
     message (f_"Extracting data out of the image");
-    do_mkdir (image_name ^ ".d");
-    g#copy_out out_dir (Filename.dirname image_name);
+    do_mkdir (cmdline.image_name ^ ".d");
+    g#copy_out out_dir (Filename.dirname cmdline.image_name);
   );
 
   (* Unmount everything, and remount only the root to cleanup
@@ -849,7 +856,7 @@ let main () =
 
   List.iter (
     fun fmt ->
-      let fn = output_filename image_name fmt in
+      let fn = output_filename cmdline.image_name fmt in
       match fmt with
       | "tar" ->
         message (f_"Compressing the image as tar");
@@ -875,17 +882,17 @@ let main () =
   if not is_ramdisk_build then (
     List.iter (
       fun fmt ->
-        let fn = output_filename image_name fmt in
+        let fn = output_filename cmdline.image_name fmt in
         message (f_"Converting to %s") fmt;
         match fmt with
         | "qcow2" ->
           let cmd =
             sprintf "qemu-img convert%s -f %s %s -O %s%s %s"
-              (if compressed then " -c" else "")
+              (if cmdline.compressed then " -c" else "")
               tmpdiskfmt
               (quote tmpdisk)
               fmt
-              (match qemu_img_options with
+              (match cmdline.qemu_img_options with
               | None -> ""
               | Some opt -> " -o " ^ quote opt)
               (quote (qemu_input_filename fn)) in
-- 
2.5.0


[Date Prev][Date Next]   [Thread Prev][Thread Next]   [Thread Index] [Date Index] [Author Index]