Libguestfs - Sep 2015 - [PATCH 3/3] get-kernel: respect -q

Simple refactoring, no actual behaviour changes.
---
 get-kernel/get_kernel.ml | 188 ++++++++++++++++++++++++-----------------------
 1 file changed, 95 insertions(+), 93 deletions(-)

diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index 8ca7ca0..3b27740 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -23,104 +23,106 @@ module G = Guestfs
 
 open Printf
 
-(* Main program. *)
-let main () -  let add, output, unversioned, prefix -    let domain = ref None
in
-    let file = ref None in
-    let libvirturi = ref "" in
-    let format = ref "" in
-    let output = ref "" in
-    let machine_readable = ref false in
-    let unversioned = ref false in
-    let prefix = ref None in
-
-    let set_file arg -      if !file <> None then
-        error (f_"--add option can only be given once");
-      let uri -        try URI.parse_uri arg
-        with Invalid_argument "URI.parse_uri" ->
-          error (f_"error parsing URI '%s'. Look for error
messages printed above.") arg in
-      file := Some uri
-    and set_domain dom -      if !domain <> None then
-        error (f_"--domain option can only be given once");
-      domain := Some dom
-    and set_prefix p -      if !prefix <> None then
-        error (f_"--prefix option can only be given once");
-      prefix := Some p in
-
-    let ditto = " -\"-" in
-    let argspec = [
-      "-a",        Arg.String set_file,       s_"file" ^
" " ^ s_"Add disk image file";
-      "--add",     Arg.String set_file,       s_"file" ^
" " ^ s_"Add disk image file";
-      "-c",        Arg.Set_string libvirturi, s_"uri" ^
" " ^ s_"Set libvirt URI";
-      "--connect", Arg.Set_string libvirturi, s_"uri" ^
" " ^ s_"Set libvirt URI";
-      "-d",        Arg.String set_domain,     s_"domain" ^
" " ^ s_"Set libvirt guest name";
-      "--domain",  Arg.String set_domain,     s_"domain" ^
" " ^ s_"Set libvirt guest name";
-      "--format",  Arg.Set_string format,     s_"format" ^
" " ^ s_"Format of input disk";
-      "--machine-readable", Arg.Set machine_readable, " " ^
s_"Make output machine readable";
-      "-o",        Arg.Set_string output, s_"directory" ^
" " ^ s_"Output directory";
-      "--output",  Arg.Set_string output,     ditto;
-      "--unversioned-names", Arg.Set unversioned,
-                                              " " ^ s_"Use
unversioned names for files";
-      "--prefix",  Arg.String set_prefix,     "prefix" ^
" " ^ s_"Prefix for files";
-    ] in
-    let argspec = set_standard_options argspec in
-    let anon_fun _ = raise (Arg.Bad (s_"extra parameter on the command
line")) in
-    let usage_msg -      sprintf (f_"\
+let parse_cmdline () +  let domain = ref None in
+  let file = ref None in
+  let libvirturi = ref "" in
+  let format = ref "" in
+  let output = ref "" in
+  let machine_readable = ref false in
+  let unversioned = ref false in
+  let prefix = ref None in
+
+  let set_file arg +    if !file <> None then
+      error (f_"--add option can only be given once");
+    let uri +      try URI.parse_uri arg
+      with Invalid_argument "URI.parse_uri" ->
+        error (f_"error parsing URI '%s'. Look for error messages
printed above.") arg in
+    file := Some uri
+  and set_domain dom +    if !domain <> None then
+      error (f_"--domain option can only be given once");
+    domain := Some dom
+  and set_prefix p +    if !prefix <> None then
+      error (f_"--prefix option can only be given once");
+    prefix := Some p in
+
+  let ditto = " -\"-" in
+  let argspec = [
+    "-a",        Arg.String set_file,       s_"file" ^
" " ^ s_"Add disk image file";
+    "--add",     Arg.String set_file,       s_"file" ^
" " ^ s_"Add disk image file";
+    "-c",        Arg.Set_string libvirturi, s_"uri" ^
" " ^ s_"Set libvirt URI";
+    "--connect", Arg.Set_string libvirturi, s_"uri" ^
" " ^ s_"Set libvirt URI";
+    "-d",        Arg.String set_domain,     s_"domain" ^
" " ^ s_"Set libvirt guest name";
+    "--domain",  Arg.String set_domain,     s_"domain" ^
" " ^ s_"Set libvirt guest name";
+    "--format",  Arg.Set_string format,     s_"format" ^
" " ^ s_"Format of input disk";
+    "--machine-readable", Arg.Set machine_readable, " " ^
s_"Make output machine readable";
+    "-o",        Arg.Set_string output, s_"directory" ^
" " ^ s_"Output directory";
+    "--output",  Arg.Set_string output,     ditto;
+    "--unversioned-names", Arg.Set unversioned,
+                                            " " ^ s_"Use
unversioned names for files";
+    "--prefix",  Arg.String set_prefix,     "prefix" ^
" " ^ s_"Prefix for files";
+  ] in
+  let argspec = set_standard_options argspec in
+  let anon_fun _ = raise (Arg.Bad (s_"extra parameter on the command
line")) in
+  let usage_msg +    sprintf (f_"\
 %s: extract kernel and ramdisk from a guest
 
 A short summary of the options is given below.  For detailed help please
 read the man page virt-get-kernel(1).
 ")
-        prog in
-    Arg.parse argspec anon_fun usage_msg;
-
-    (* Machine-readable mode?  Print out some facts about what
-     * this binary supports.
-     *)
-    if !machine_readable then (
-      printf "virt-get-kernel\n";
-      exit 0
-    );
-
-    (* Check -a and -d options. *)
-    let file = !file in
-    let domain = !domain in
-    let libvirturi = match !libvirturi with "" -> None | s ->
Some s in
-    let add -      match file, domain with
-      | None, None ->
-        error (f_"you must give either -a or -d options.  Read
virt-get-kernel(1) man page for further information.")
-      | Some _, Some _ ->
-        error (f_"you cannot give -a and -d options together.  Read
virt-get-kernel(1) man page for further information.")
-      | None, Some dom ->
-        fun (g : Guestfs.guestfs) ->
-          let readonlydisk = "ignore" (* ignore CDs, data drives *)
in
-          ignore (g#add_domain
-                    ~readonly:true ~allowuuid:true ~readonlydisk
-                    ?libvirturi dom)
-      | Some uri, None ->
-        fun g ->
-          let { URI.path = path; protocol = protocol;
-                server = server; username = username;
-                password = password } = uri in
-          let format = match !format with "" -> None | s ->
Some s in
-          g#add_drive
-            ~readonly:true ?format ~protocol ?server ?username ?secret:password
-            path
-    in
-
-    (* Dereference the rest of the args. *)
-    let output = match !output with "" -> None | str -> Some
str in
-    let unversioned = !unversioned in
-    let prefix = !prefix in
-
-    add, output, unversioned, prefix in
+      prog in
+  Arg.parse argspec anon_fun usage_msg;
+
+  (* Machine-readable mode?  Print out some facts about what
+   * this binary supports.
+   *)
+  if !machine_readable then (
+    printf "virt-get-kernel\n";
+    exit 0
+  );
+
+  (* Check -a and -d options. *)
+  let file = !file in
+  let domain = !domain in
+  let libvirturi = match !libvirturi with "" -> None | s ->
Some s in
+  let add +    match file, domain with
+    | None, None ->
+      error (f_"you must give either -a or -d options.  Read
virt-get-kernel(1) man page for further information.")
+    | Some _, Some _ ->
+      error (f_"you cannot give -a and -d options together.  Read
virt-get-kernel(1) man page for further information.")
+    | None, Some dom ->
+      fun (g : Guestfs.guestfs) ->
+        let readonlydisk = "ignore" (* ignore CDs, data drives *) in
+        ignore (g#add_domain
+                  ~readonly:true ~allowuuid:true ~readonlydisk
+                  ?libvirturi dom)
+    | Some uri, None ->
+      fun g ->
+        let { URI.path = path; protocol = protocol;
+              server = server; username = username;
+              password = password } = uri in
+        let format = match !format with "" -> None | s -> Some
s in
+        g#add_drive
+          ~readonly:true ?format ~protocol ?server ?username ?secret:password
+          path
+  in
+
+  (* Dereference the rest of the args. *)
+  let output = match !output with "" -> None | str -> Some str
in
+  let unversioned = !unversioned in
+  let prefix = !prefix in
+
+  add, output, unversioned, prefix
+
+(* Main program. *)
+let main () +  let add, output, unversioned, prefix = parse_cmdline () in
 
   (* Connect to libguestfs. *)
   let g = new G.guestfs () in
-- 
2.1.0

Split in an own function the code dong the mounting, the inspection of
the kernel files, and the downloading, including a per-OS function for
the actual kernel files.  This gives few advantages:
- the download phease is not repeated for all the files to fetch
- it is easier to eventually support multi-root disk images
- it is possible to support OSes different than Linux; virt-get-kernel
  now will just report the unsupported OS, instead of a generic
  "no kernel found" message

This is mostly code refactoring, with (on Linux) no actual behaviour
change.
---
 get-kernel/get_kernel.ml | 80 +++++++++++++++++++++++++++++-------------------
 1 file changed, 49 insertions(+), 31 deletions(-)

diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index 3b27740..233d459 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -120,24 +120,7 @@ read the man page virt-get-kernel(1).
 
   add, output, unversioned, prefix
 
-(* Main program. *)
-let main () -  let add, output, unversioned, prefix = parse_cmdline () in
-
-  (* Connect to libguestfs. *)
-  let g = new G.guestfs () in
-  if trace () then g#set_trace true;
-  if verbose () then g#set_verbose true;
-  add g;
-  g#launch ();
-
-  let roots = g#inspect_os () in
-  if Array.length roots = 0 then
-    error (f_"no operating system found");
-  if Array.length roots > 1 then
-    error (f_"dual/multi-boot images are not supported by this
tool");
-  let root = roots.(0) in
-
+let rec do_fetch ~transform_fn ~outputdir g root    (* Mount up the disks. *)
   let mps = g#inspect_get_mountpoints root in
   let cmp (a,_) (b,_) = compare (String.length a) (String.length b) in
@@ -148,6 +131,24 @@ let main ()        with Guestfs.Error msg -> warning
(f_"%s (ignored)") msg
   ) mps;
 
+  let files +    let typ = g#inspect_get_type root in
+    match typ with
+    | "linux" -> pick_kernel_files_linux g root
+    | typ ->
+      error (f_"operating system '%s' not supported") typ in
+
+  (* Download the files. *)
+  List.iter (
+    fun f ->
+      let dest = outputdir // transform_fn f in
+      printf "download: %s -> %s\n%!" f dest;
+      g#download f dest;
+  ) files;
+
+  g#umount_all ()
+
+and pick_kernel_files_linux g root    (* Get all kernels and initramfses. *)
   let glob w = Array.to_list (g#glob_expand w) in
   let kernels = glob "/boot/vmlinuz-*" in
@@ -164,7 +165,34 @@ let main ()    let initrds = List.rev (List.sort
compare_version initrds) in
 
   if kernels = [] then
-    error (f_"no kernel found");
+    error (f_"no kernel found in %s") root;
+
+  (* Pick the latest. *)
+  let kernel = [List.hd kernels] in
+  let initrd +    match initrds with
+    | [] -> []
+    | initrd :: _ -> [initrd] in
+
+  kernel @ initrd
+
+(* Main program. *)
+let main () +  let add, output, unversioned, prefix = parse_cmdline () in
+
+  (* Connect to libguestfs. *)
+  let g = new G.guestfs () in
+  if trace () then g#set_trace true;
+  if verbose () then g#set_verbose true;
+  add g;
+  g#launch ();
+
+  let roots = g#inspect_os () in
+  if Array.length roots = 0 then
+    error (f_"no operating system found");
+  if Array.length roots > 1 then
+    error (f_"dual/multi-boot images are not supported by this
tool");
+  let root = roots.(0) in
 
   let dest_filename fn      let fn = Filename.basename fn in
@@ -175,22 +203,12 @@ let main ()      | None -> fn
     | Some p -> p ^ "-" ^ fn in
 
-  (* Download the latest. *)
   let outputdir      match output with
     | None -> Filename.current_dir_name
     | Some dir -> dir in
-  let kernel_in = List.hd kernels in
-  let kernel_out = outputdir // dest_filename kernel_in in
-  printf "download: %s -> %s\n%!" kernel_in kernel_out;
-  g#download kernel_in kernel_out;
-
-  if initrds <> [] then (
-    let initrd_in = List.hd initrds in
-    let initrd_out = outputdir // dest_filename initrd_in in
-    printf "download: %s -> %s\n%!" initrd_in initrd_out;
-    g#download initrd_in initrd_out
-  );
+
+  do_fetch ~transform_fn:dest_filename ~outputdir g root;
 
   (* Shutdown. *)
   g#shutdown ();
-- 
2.1.0

Now that virt-get-kernel has -q/--quiet, support it by printing the
download messages only if not specified.
---
 get-kernel/get_kernel.ml | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/get-kernel/get_kernel.ml b/get-kernel/get_kernel.ml
index 233d459..8786bf3 100644
--- a/get-kernel/get_kernel.ml
+++ b/get-kernel/get_kernel.ml
@@ -142,7 +142,8 @@ let rec do_fetch ~transform_fn ~outputdir g root   
List.iter (
     fun f ->
       let dest = outputdir // transform_fn f in
-      printf "download: %s -> %s\n%!" f dest;
+      if not (quiet ()) then
+        printf "download: %s -> %s\n%!" f dest;
       g#download f dest;
   ) files;
 
-- 
2.1.0

On Tue, Sep 01, 2015 at 06:06:34PM +0200, Pino Toscano
wrote:
> Now that virt-get-kernel has -q/--quiet, support it by printing the
> download messages only if not specified.
> ---
>  get-kernel/get_kernel.ml | 3 ++-
>  1 file changed, 2 insertions(+), 1 deletion(-)
ACK series.

Thanks, Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v