[Libguestfs] [PATCH 1/3] get-kernel: split command line handling in own function

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