11:06 a.m.
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
11:06 a.m.
New subject: [PATCH 2/3] get-kernel: refactor list and download code
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
11:06 a.m.
New subject: [PATCH 3/3] get-kernel: respect -q
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
3:19 p.m.
New subject: [PATCH 3/3] get-kernel: respect -q
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
3404
days inactive
3404
days old
3 comments
2 participants
participants (2)
-
Pino Toscano -
Richard W.M. Jones