X-Git-Url: http://git.annexia.org/?p=virt-mem.git;a=blobdiff_plain;f=lib%2Fvirt_mem.ml;h=1f21a66ea1a2628eca4d54d761e89cb722588492;hp=dd3c18a304dd567190ce3ff890049730dd236803;hb=b70c967911e197b74d6d7ad98e3df9240d82572f;hpb=6a4bf18801508eb18520b7b1ec13325fd4101764

diff --git a/lib/virt_mem.ml b/lib/virt_mem.ml
index dd3c18a..1f21a66 100644
--- a/lib/virt_mem.ml
+++ b/lib/virt_mem.ml
@@ -52,7 +52,122 @@ type kallsyms_compr =
   | Compressed of (string * MMap.addr) list * MMap.addr
   | Uncompressed of (string * MMap.addr) list
 
-let start usage_msg =
+(* When tools register themselves, they are added to this list.
+ * Later, we will alphabetize the list.
+ *)
+let tools = ref [
+  "capture", (
+    "capture",
+    s_"capture memory image for post-mortem analysis",
+    s_"Capture a memory image to a file for later post-mortem
+analysis.  Use the '-o memoryimage' option to specify the
+output file.
+
+Other tools can load the memory image using the '-t' option.",
+    false,
+    (fun _ _ -> ())
+  );
+]
+
+(* Registration function used by the tools. *)
+let register name summary description is_cmd run_fn =
+  tools := (name, (name, summary, description, is_cmd, run_fn)) :: !tools
+
+(* Main program, called from mem/virt_mem_main.ml when all the
+ * tools have had a chance to register themselves.
+ *)
+let main () =
+  (* Get the registered tools, alphabetically. *)
+  let tools = !tools in
+  let tools = List.sort ~cmp:(fun (a,_) (b,_) -> compare a b) tools in
+
+  (* Which tool did the user want to run?  Look at the executable
+   * name (eg. 'virt-dmesg' => tool == dmesg).  If we don't recognise
+   * the executable name then we must look for the first parameter
+   * which doesn't begin with a '-' character.
+   *
+   * Note that we must do all of this before using the OCaml Arg
+   * module to properly parse the command line (below), so that
+   * we can have a usage message ready.
+   *)
+  let tool =
+    let prog = Sys.executable_name in	(* eg. "/usr/bin/virt-dmesg.opt" *)
+    let prog = Filename.basename prog in(* eg. "virt-dmesg.opt" *)
+    let prog =				(* eg. "virt-dmesg" *)
+      try Filename.chop_extension prog with Invalid_argument _ -> prog in
+    let prog =				(* eg. "dmesg" *)
+      if String.starts_with prog "virt-" then
+	String.sub prog 5 (String.length prog - 5)
+      else prog in
+    try Some (List.assoc prog tools)
+    with Not_found ->
+      let arg1 =			(* First non-option argument. *)
+	match Array.to_list Sys.argv with
+	| [] -> None
+	| _::args ->
+	    let rec loop = function
+	      | [] -> None
+	      | a::args when String.length a > 0 && a.[0] = '-' -> loop args
+	      | a::_ -> Some a
+	    in
+	    loop args in
+      match arg1 with
+      | None -> None
+      | Some prog ->			(* Recognisable first argument? *)
+	  let prog =
+	    try Filename.chop_extension prog with Invalid_argument _ -> prog in
+	  let prog =
+	    if String.starts_with prog "virt-" then
+	      String.sub prog 5 (String.length prog - 5)
+	    else prog in
+	  (try Some (List.assoc prog tools) with Not_found -> None) in
+
+  (* Make a usage message. *)
+  let usage_msg =
+    match tool with
+    | None ->				(* Generic usage message. *)
+	let tools = List.map (
+	  fun (name, (_, summary, _, is_cmd, _)) ->
+	    if is_cmd then "virt-"^name, summary
+	    else           "virt-mem "^name, summary
+	) tools in
+	(* Maximum width of field in the left hand column. *)
+	let max_width =
+	  List.fold_left max 0 (List.map String.length (List.map fst tools)) in
+	let tools = List.map (fun (l,r) -> pad max_width l, r) tools in
+	let tools = List.map (fun (l,r) -> "  " ^ l ^ " - " ^ r) tools in
+	let tools = String.concat "\n" tools in
+
+	sprintf (f_"\
+
+virt-mem: Tools for providing information about virtual machines
+
+Currently available tools include:
+%s
+
+General usage is:
+  <tool> [-options] [domains...]
+
+To display extra help for a single tool, do:
+  virt-mem help <tool>
+
+Options:") tools
+
+                                        (* Tool-specific usage message. *)
+    | Some (name, summary, description, is_cmd, _) ->
+	let cmd = if is_cmd then "virt-" ^ name else "virt-mem " ^ name in
+
+	sprintf (f_"\
+
+%s: %s
+
+Description:
+%s
+
+Options:") cmd summary description in
+
+  (* Now begin proper parsing of the command line arguments. *)
+
   (* Debug messages. *)
   let debug = ref false in
 
@@ -139,7 +254,6 @@ let start usage_msg =
   ] in
 
   let anon_arg str = anon_args := str :: !anon_args in
-  let usage_msg = usage_msg ^ s_"\n\nOPTIONS" in
   Arg.parse argspec anon_arg usage_msg;
 
   let images = !images in
@@ -147,6 +261,22 @@ let start usage_msg =
   let uri = if !uri = "" then None else Some !uri in
   let anon_args = List.rev !anon_args in
 
+  (* At this point, either --help was specified on the command line
+   * (and so the program has exited) or we must have determined tool,
+   * or the user didn't give us a valid tool (eg. "virt-mem foobar").
+   * Detect that final case now and give an error.
+   *)
+  let name, _, _, _, run_fn =
+    match tool with
+    | Some t -> t
+    | None ->
+	prerr_endline (s_"\
+virt-mem: I could not work out which tool you are trying to run.
+Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
+	exit 1
+  in
+  if debug then eprintf "tool = %s\n%!" name;
+
   (* Get the kernel images. *)
   let images =
     if images = [] then (
@@ -730,4 +860,5 @@ let start usage_msg =
 	((name, arch, mem, lookup_ksym) : image)
     ) images in
 
-  debug, images
+  (* Run the actual tool. *)
+  run_fn debug images