Fix kernel_size on 32 bit architectures.

Obey list of domains passed on the command line.

diff --git a/lib/virt_mem.ml b/lib/virt_mem.ml
index 9a00ead..384a089 100644 (file)
--- a/lib/virt_mem.ml
+++ b/lib/virt_mem.ml
@@ -32,8 +32,13 @@ module MMap = Virt_mem_mmap
 let min_kallsyms_tabsize = 1_000L
 let max_kallsyms_tabsize = 250_000L
 
 let min_kallsyms_tabsize = 1_000L
 let max_kallsyms_tabsize = 250_000L
 

-let kernel_size = 0x100_0000
-let max_memory_peek = 0x1_000
+(* Make the kernel size around 16 MB, but just a bit smaller than
+ * maximum string length so we can still run this on a 32 bit platform.
+ *)
+let kernel_size =
+  if Sys.word_size = 32 then Sys.max_string_length
+  else 0x100_0000
+let max_memory_peek = 0x1000

 
 type ksym = string
 
 
 type ksym = string
 


@@ -94,6 +99,7 @@ let start usage_msg =
   (* List of kernel images. *)
   let images = ref [] in
   let uri = ref "" in
   (* List of kernel images. *)
   let images = ref [] in
   let uri = ref "" in

+  let anon_args = ref [] in

 
   let memory_image filename =
     images :=
 
   let memory_image filename =
     images :=


@@ -132,14 +138,14 @@ let start usage_msg =
       " " ^ s_"Display version and exit";
   ] in
 
       " " ^ s_"Display version and exit";
   ] in
 

-  let anon_fun str =
-    raise (Arg.Bad (sprintf (f_"%s: unknown parameter") str)) in
+  let anon_arg str = anon_args := str :: !anon_args in

   let usage_msg = usage_msg ^ s_"\n\nOPTIONS" in
   let usage_msg = usage_msg ^ s_"\n\nOPTIONS" in

-  Arg.parse argspec anon_fun usage_msg;
+  Arg.parse argspec anon_arg usage_msg;

 
   let images = !images in
   let debug = !debug in
   let uri = if !uri = "" then None else Some !uri in
 
   let images = !images in
   let debug = !debug in
   let uri = if !uri = "" then None else Some !uri in

+  let anon_args = List.rev !anon_args in

 
   (* Get the kernel images. *)
   let images =
 
   (* Get the kernel images. *)
   let images =


@@ -155,14 +161,36 @@ let start usage_msg =
          );
          exit 1 in
 
          );
          exit 1 in
 

-      (* List of active domains. *)
+      (* If we have a list of parameters, then it is the domain names / UUIDs /
+       * IDs ONLY that we wish to display.  Otherwise, display all active.
+       *)

       let doms =
       let doms =

-       let nr_active_doms = C.num_of_domains conn in
-       let active_doms =
-         Array.to_list (C.list_domains conn nr_active_doms) in
-       let active_doms =
-         List.map (D.lookup_by_id conn) active_doms in
-       active_doms in
+       if anon_args = [] then (
+         (* List of active domains. *)
+         let nr_active_doms = C.num_of_domains conn in
+         let active_doms =
+           Array.to_list (C.list_domains conn nr_active_doms) in
+         List.map (D.lookup_by_id conn) active_doms
+       ) else (
+         List.map (
+           fun arg ->
+             let dom =
+               try D.lookup_by_uuid_string conn arg
+               with _ ->
+                 try D.lookup_by_name conn arg
+                 with _ ->
+                   try D.lookup_by_id conn (int_of_string arg)
+                   with _ ->
+                     failwith (sprintf (f_"%s: unknown domain (not a UUID, name or ID of any active domain)") arg) in
+
+             (* XXX Primitive test to see if the domain is active. *)
+             let is_active = try D.get_id dom >= 0 with _ -> false in
+             if not is_active then
+               failwith (sprintf (f_"%s: domain is not running") arg);
+
+             dom
+         ) anon_args
+       ) in

 
       (* Get their XML. *)
       let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
 
       (* Get their XML. *)
       let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in


@@ -235,7 +263,11 @@ let start usage_msg =
 
          (name, arch, mem)
       ) xmls
 
          (name, arch, mem)
       ) xmls

-    ) else
+    ) else (
+      (* One or more -t options passed. *)
+      if anon_args <> [] then
+       failwith (s_"virt-mem: if -t given on command line, then no domain arguments should be listed");
+

       List.map (
        fun (wordsize, endian, arch, text_addr, filename) ->
          (* Quite a lot of limitations on the kernel images we can
       List.map (
        fun (wordsize, endian, arch, text_addr, filename) ->
          (* Quite a lot of limitations on the kernel images we can


@@ -278,7 +310,8 @@ let start usage_msg =
          let mem = MMap.set_endian mem endian in
 
          (filename, arch, mem)
          let mem = MMap.set_endian mem endian in
 
          (filename, arch, mem)

-      ) images in
+      ) images
+    ) in

 
   let images =
     List.map (
 
   let images =
     List.map (