Refactored, process table now loaded centrally.

diff --git a/MANIFEST b/MANIFEST
index 0f8a6db..3b4557c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -31,6 +31,8 @@ lib/virt_mem.mli
 lib/virt_mem_mmap.ml
 lib/virt_mem_mmap.mli
 lib/virt_mem_mmap_c.c
 lib/virt_mem_mmap.ml
 lib/virt_mem_mmap.mli
 lib/virt_mem_mmap_c.c

+lib/virt_mem_tasks.ml
+lib/virt_mem_tasks.mli

 lib/virt_mem_types.ml
 lib/virt_mem_types.mli
 lib/virt_mem_utils.ml
 lib/virt_mem_types.ml
 lib/virt_mem_types.mli
 lib/virt_mem_utils.ml

diff --git a/dmesg/virt_dmesg.ml b/dmesg/virt_dmesg.ml
index 73a671b..153d5e4 100644 (file)
--- a/dmesg/virt_dmesg.ml
+++ b/dmesg/virt_dmesg.ml
@@ -24,23 +24,24 @@ open Virt_mem_utils
 open Virt_mem_types
 open Virt_mem_mmap
 
 open Virt_mem_types
 open Virt_mem_mmap
 

-let run debug ({ domname = domname; mem = mem }, ksymmap, _) =
+let run debug { domname = domname; mem = mem } { ksyms = ksyms } =
+  let ksyms = Option.get ksyms in

   try
     (* I don't know why but this symbol doesn't exist in 2.6.9
      * even in kallsyms.  Hence this won't work with that kernel.
      * It's possible we can fall back to memory scanning. XXX
      *)
   try
     (* I don't know why but this symbol doesn't exist in 2.6.9
      * even in kallsyms.  Hence this won't work with that kernel.
      * It's possible we can fall back to memory scanning. XXX
      *)

-    let log_buf = Ksymmap.find "log_buf" ksymmap in
+    let log_buf = Ksymmap.find "log_buf" ksyms in

     let log_buf = follow_pointer mem log_buf in
     let log_buf = follow_pointer mem log_buf in

-    let log_buf_len = Ksymmap.find "log_buf_len" ksymmap in
+    let log_buf_len = Ksymmap.find "log_buf_len" ksyms in

     let log_buf_len = Int64.of_int32 (get_C_int mem log_buf_len) in
     let log_buf_len = Int64.of_int32 (get_C_int mem log_buf_len) in

-    (* let log_start = Ksymmap.find "log_start" ksymmap in
+    (* let log_start = Ksymmap.find "log_start" ksyms in

        let log_start = get_C_long mem log_start in *)
        let log_start = get_C_long mem log_start in *)

-    let log_end = Ksymmap.find "log_end" ksymmap in
+    let log_end = Ksymmap.find "log_end" ksyms in

     let log_end = get_C_long mem log_end in
     let log_end = get_C_long mem log_end in

-    (* let con_start = Ksymmap.find "con_start" ksymmap in
+    (* let con_start = Ksymmap.find "con_start" ksyms in

        let con_start = get_C_long mem con_start in *)
        let con_start = get_C_long mem con_start in *)

-    let logged_chars = Ksymmap.find "logged_chars" ksymmap in
+    let logged_chars = Ksymmap.find "logged_chars" ksyms in

     let logged_chars = get_C_long mem logged_chars in
 
     (* This is basically the same algorithm from printk.c:do_syslog
     let logged_chars = get_C_long mem logged_chars in
 
     (* This is basically the same algorithm from printk.c:do_syslog


@@ -78,4 +79,4 @@ virt-dmesg prints the kernel messages for virtual machines running
 under libvirt.  The output is similar to the ordinary dmesg command
 run inside the virtual machine."
 
 under libvirt.  The output is similar to the ordinary dmesg command
 run inside the virtual machine."
 

-let () = Virt_mem.register "dmesg" summary description ~run
+let () = Virt_mem.register "dmesg" summary description ~needs_ksyms:true ~run

diff --git a/lib/.depend b/lib/.depend
index 51d8e06..e6a321a 100644 (file)
--- a/lib/.depend
+++ b/lib/.depend
@@ -4,6 +4,7 @@ virt_mem_kallsyms.cmi: virt_mem_types.cmi
 virt_mem_ksyms.cmi: virt_mem_types.cmi 
 virt_mem.cmi: virt_mem_types.cmi 
 virt_mem_mmap.cmi: virt_mem_utils.cmo 
 virt_mem_ksyms.cmi: virt_mem_types.cmi 
 virt_mem.cmi: virt_mem_types.cmi 
 virt_mem_mmap.cmi: virt_mem_utils.cmo 

+virt_mem_tasks.cmi: virt_mem_types.cmi virt_mem_mmap.cmi 

 virt_mem_types.cmi: virt_mem_utils.cmo virt_mem_mmap.cmi 
 virt_mem_utsname.cmi: virt_mem_types.cmi 
 kernel_net_device.cmo: virt_mem_mmap.cmi kernel_net_device.cmi 
 virt_mem_types.cmi: virt_mem_utils.cmo virt_mem_mmap.cmi 
 virt_mem_utsname.cmi: virt_mem_types.cmi 
 kernel_net_device.cmo: virt_mem_mmap.cmi kernel_net_device.cmi 


@@ -25,13 +26,19 @@ virt_mem_ksyms.cmo: virt_mem_utils.cmo virt_mem_types.cmi virt_mem_mmap.cmi \
 virt_mem_ksyms.cmx: virt_mem_utils.cmx virt_mem_types.cmx virt_mem_mmap.cmx \
     virt_mem_gettext.cmx virt_mem_ksyms.cmi 
 virt_mem.cmo: virt_mem_version.cmo virt_mem_utsname.cmi virt_mem_utils.cmo \
 virt_mem_ksyms.cmx: virt_mem_utils.cmx virt_mem_types.cmx virt_mem_mmap.cmx \
     virt_mem_gettext.cmx virt_mem_ksyms.cmi 
 virt_mem.cmo: virt_mem_version.cmo virt_mem_utsname.cmi virt_mem_utils.cmo \

-    virt_mem_types.cmi virt_mem_mmap.cmi virt_mem_ksyms.cmi \
-    virt_mem_kallsyms.cmi virt_mem_gettext.cmo virt_mem.cmi 
+    virt_mem_types.cmi virt_mem_tasks.cmi virt_mem_mmap.cmi \
+    virt_mem_ksyms.cmi virt_mem_kallsyms.cmi virt_mem_gettext.cmo \
+    virt_mem.cmi 

 virt_mem.cmx: virt_mem_version.cmx virt_mem_utsname.cmx virt_mem_utils.cmx \
 virt_mem.cmx: virt_mem_version.cmx virt_mem_utsname.cmx virt_mem_utils.cmx \

-    virt_mem_types.cmx virt_mem_mmap.cmx virt_mem_ksyms.cmx \
-    virt_mem_kallsyms.cmx virt_mem_gettext.cmx virt_mem.cmi 
+    virt_mem_types.cmx virt_mem_tasks.cmx virt_mem_mmap.cmx \
+    virt_mem_ksyms.cmx virt_mem_kallsyms.cmx virt_mem_gettext.cmx \
+    virt_mem.cmi 

 virt_mem_mmap.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi 
 virt_mem_mmap.cmx: virt_mem_utils.cmx virt_mem_mmap.cmi 
 virt_mem_mmap.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi 
 virt_mem_mmap.cmx: virt_mem_utils.cmx virt_mem_mmap.cmi 

+virt_mem_tasks.cmo: virt_mem_utils.cmo virt_mem_types.cmi virt_mem_mmap.cmi \
+    virt_mem_gettext.cmo kernel_task_struct.cmi virt_mem_tasks.cmi 
+virt_mem_tasks.cmx: virt_mem_utils.cmx virt_mem_types.cmx virt_mem_mmap.cmx \
+    virt_mem_gettext.cmx kernel_task_struct.cmx virt_mem_tasks.cmi 

 virt_mem_types.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi virt_mem_types.cmi 
 virt_mem_types.cmx: virt_mem_utils.cmx virt_mem_mmap.cmx virt_mem_types.cmi 
 virt_mem_utsname.cmo: virt_mem_utils.cmo virt_mem_types.cmi virt_mem_mmap.cmi \
 virt_mem_types.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi virt_mem_types.cmi 
 virt_mem_types.cmx: virt_mem_utils.cmx virt_mem_mmap.cmx virt_mem_types.cmi 
 virt_mem_utsname.cmo: virt_mem_utils.cmo virt_mem_types.cmi virt_mem_mmap.cmi \

diff --git a/lib/Makefile.in b/lib/Makefile.in
index a92a984..35f4bf2 100644 (file)
--- a/lib/Makefile.in
+++ b/lib/Makefile.in
@@ -58,6 +58,7 @@ OBJS          = virt_mem_gettext.cmo \
                  virt_mem_ksyms.cmo \
                  virt_mem_kallsyms.cmo \
                  virt_mem_utsname.cmo \
                  virt_mem_ksyms.cmo \
                  virt_mem_kallsyms.cmo \
                  virt_mem_utsname.cmo \

+                 virt_mem_tasks.cmo \

                  virt_mem.cmo \
                  virt_mem_capture.cmo
 XOBJS          = $(OBJS:%.cmo=%.cmx)
                  virt_mem.cmo \
                  virt_mem_capture.cmo
 XOBJS          = $(OBJS:%.cmo=%.cmx)

diff --git a/lib/virt_mem.ml b/lib/virt_mem.ml
index 69a0821..22cbbc5 100644 (file)
--- a/lib/virt_mem.ml
+++ b/lib/virt_mem.ml
@@ -42,12 +42,18 @@ let kernel_size =
 let tools = ref []
 
 (* Registration function used by the tools. *)
 let tools = ref []
 
 (* Registration function used by the tools. *)

-let register ?(external_cmd = true) ?(extra_args = [])
-    ?argcheck ?beforeksyms ?beforeutsname ?run
+let register
+    ?(needs_ksyms = false) ?(needs_utsname = false)
+    ?(needs_tasks = false) ?(needs_everything = false)
+    ~run
+    ?(external_cmd = true)
+    ?(extra_args = [])
+    ?argcheck

     name summary description =
   tools :=
     name summary description =
   tools :=

-    (name, (name, summary, description, external_cmd, extra_args,
-           argcheck, beforeksyms, beforeutsname, run))
+    (name, (name, summary, description,
+           needs_ksyms, needs_utsname, needs_tasks, needs_everything,
+           run, external_cmd, extra_args, argcheck))

   :: !tools
 
 (* Main program, called from mem/virt_mem_main.ml when all the
   :: !tools
 
 (* Main program, called from mem/virt_mem_main.ml when all the


@@ -105,7 +111,7 @@ let main () =
     match tool with
     | None ->                          (* Generic usage message. *)
        let tools = List.map (
     match tool with
     | None ->                          (* Generic usage message. *)
        let tools = List.map (

-         fun (name, (_, summary, _, external_cmd, _, _, _, _, _)) ->
+         fun (name, (_, summary, _, _, _, _, _, _, external_cmd, _, _)) ->

            if external_cmd then "virt-"^name, summary
            else                 "virt-mem "^name, summary
        ) tools in
            if external_cmd then "virt-"^name, summary
            else                 "virt-mem "^name, summary
        ) tools in


@@ -127,12 +133,12 @@ General usage is:
   <tool> [-options] [domains...]
 
 To display extra help for a single tool, do:
   <tool> [-options] [domains...]
 
 To display extra help for a single tool, do:

-  virt-mem help <tool>
+  virt-mem --help <tool>

 
 Options:") tools
 
                                         (* Tool-specific usage message. *)
 
 Options:") tools
 
                                         (* Tool-specific usage message. *)

-    | Some (name, summary, description, external_cmd, _, _, _, _, _) ->
+    | Some (name, summary, description, _, _, _, _, _, external_cmd, _, _) ->

        let cmd =
          if external_cmd then "virt-" ^ name else "virt-mem " ^ name in
 
        let cmd =
          if external_cmd then "virt-" ^ name else "virt-mem " ^ name in
 


@@ -242,7 +248,7 @@ Options:") cmd summary description in
   let argspec =
     let extra_args = match tool with
       | None -> []
   let argspec =
     let extra_args = match tool with
       | None -> []

-      | Some (_, _, _, _, extra_args, _, _, _, _) -> extra_args in
+      | Some (_, _, _, _, _, _, _, _, _, extra_args, _) -> extra_args in

     let argspec = [
       "-A", Arg.String set_architecture,
         "arch " ^ s_"Set kernel architecture, endianness and word size";
     let argspec = [
       "-A", Arg.String set_architecture,
         "arch " ^ s_"Set kernel architecture, endianness and word size";


@@ -293,7 +299,9 @@ Options:") cmd summary description in
    * or the user didn't give us a valid tool (eg. "virt-mem foobar").
    * Detect that final case now and give an error.
    *)
    * 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, _, _, _, _, argcheck, beforeksyms,  beforeutsname, run =
+  let name, _, _,
+    needs_ksyms, needs_utsname, needs_tasks, needs_everything,
+    run, external_cmd, extra_args, argcheck =

     match tool with
     | Some t -> t
     | None ->
     match tool with
     | Some t -> t
     | None ->


@@ -480,68 +488,95 @@ Possibly the '-T' command line parameter was used inconsistently.");
       ) testimages
     ) in
 
       ) testimages
     ) in
 

-  (* Optional callback into the tool before we start looking for
-   * kernel symbols.
-   *)
-  (match beforeksyms with
-   | None -> ()
-   | Some beforeksyms -> beforeksyms debug images
-  );
-
-  (* If there are no more callback functions, then there is no point
-   * continuing with the rest of the program (kernel symbol analysis) ...
-   *)
-  if beforeutsname = None && run = None then exit 0;
-
-  (* Do the kernel symbol analysis. *)
+  (* Now build the kdata, depending on what the tool asked for. *)

   let images =
     List.map (
       fun image ->
   let images =
     List.map (
       fun image ->

-       (* Look for ordinary kernel symbols: *)
-       let image = Virt_mem_ksyms.find_kernel_symbols debug image in
-       (* Look for kallsyms: *)
-       let image = Virt_mem_kallsyms.find_kallsyms debug image in
-
-(*
-       (* Finally, just wrap the lookup_ksym call in something
-        * which prints the query when debug is set.
-        *)
-       let image =
-         if debug then
-           let (domid, name, arch, mem, lookup_ksym) = image in
-           let lookup_ksym sym =
-             try
-               let value = lookup_ksym sym in
-               eprintf "lookup_ksym %S = %Lx\n%!" sym value;
-               value
-             with Not_found ->
-               eprintf "lookup_ksym %S failed\n%!" sym;
-               raise Not_found
-           in
-           (domid, name, arch, mem, lookup_ksym)
-         else
-           image in
-*)
-
-       image
+       let kdata = { ksyms = None; utsname = None; tasks = None } in
+       image, kdata

     ) images in
     ) images in

+  (* Certain needs are dependent on others ... *)
+  let needs_ksyms =
+    if needs_utsname then true
+    else needs_ksyms in
+  let needs_ksyms, needs_utsname =
+    if needs_tasks then true, true
+    else needs_ksyms, needs_utsname in
+  let needs_ksyms, needs_utsname, needs_tasks =
+    if needs_everything then true, true, true
+    else needs_ksyms, needs_utsname, needs_tasks in

 
 

-  (* Before utsname analysis. *)
-  (match beforeutsname with
-   | None -> ()
-   | Some beforeutsname -> List.iter (beforeutsname debug) images
-  );
-
-  (* If there are no more callback functions, then there is no point
-   * continuing with the rest of the program (kernel version analysis) ...
-   *)
-  if run = None then exit 0;
+  (* Do the kernel symbol analysis. *)
+  let images =
+    if not needs_ksyms then images
+    else
+      List.map (
+       fun (image, kdata) ->
+         (* Look for ordinary kernel symbols: *)
+         let image, ksyms =
+           Virt_mem_ksyms.find_kernel_symbols debug image in
+
+         match ksyms with
+         | None -> image, kdata
+         | Some ksyms ->
+             (* Look for kallsyms: *)
+             let image, kallsyms =
+               Virt_mem_kallsyms.find_kallsyms debug image ksyms in
+
+             let ksyms =
+               match kallsyms with
+               | None -> ksyms (* no kallsyms, just use module symbols *)
+               | Some kallsyms -> kallsyms (* ksyms + kallsyms *) in
+
+             image, { kdata with ksyms = Some ksyms }
+      ) images in

 
   (* Get the kernel version (utsname analysis). *)
 
   (* Get the kernel version (utsname analysis). *)

-  let images = List.map (Virt_mem_utsname.find_utsname debug) images in
+  let images =
+    if not needs_utsname then images
+    else
+      List.map (
+       fun (image, ({ ksyms = ksyms } as kdata)) ->
+         match ksyms with
+         | None -> image, kdata
+         | Some ksyms ->
+             let image, utsname =
+               Virt_mem_utsname.find_utsname debug image ksyms in
+             let kdata = { kdata with utsname = utsname } in
+             image, kdata
+      ) images in
+
+  (* Get the tasks. *)
+  let images =
+    if not needs_tasks then images
+    else
+      List.map (
+       fun (image, ({ ksyms = ksyms; utsname = utsname } as kdata)) ->
+         match ksyms, utsname with
+         | Some ksyms, Some { kernel_release = kversion } ->
+             let image, tasks =
+               Virt_mem_tasks.find_tasks debug image ksyms kversion in
+             let kdata = { kdata with tasks = tasks } in
+             image, kdata
+         | _, _ -> image, kdata
+      ) images in

 
   (* Run the tool's main function. *)
 
   (* Run the tool's main function. *)

-  (match run with
-   | None -> ()
-   | Some run -> List.iter (run debug) images
-  )
+  let errors = ref 0 in
+  List.iter (
+    fun (image, kdata) ->
+      try
+       if not needs_everything then (
+         if needs_ksyms && kdata.ksyms = None then
+           failwith (s_"could not read kernel symbols")
+         else if needs_utsname && kdata.utsname = None then
+           failwith (s_"could not read kernel version")
+         else if needs_tasks && kdata.tasks = None then
+           failwith (s_"could not read process table")
+       );
+       run debug image kdata
+      with exn ->
+       eprintf "%s: %s\n" image.domname (Printexc.to_string exn);
+       incr errors
+  ) images;
+  exit (if !errors > 0 then 1 else 0)

diff --git a/lib/virt_mem.mli b/lib/virt_mem.mli
index c807365..ab5ba47 100644 (file)
--- a/lib/virt_mem.mli
+++ b/lib/virt_mem.mli
@@ -19,37 +19,45 @@
  *)
 
 val register :
  *)
 
 val register :

+  ?needs_ksyms:bool ->
+  ?needs_utsname:bool ->
+  ?needs_tasks:bool ->
+  ?needs_everything:bool ->
+  run:(bool -> Virt_mem_types.image -> Virt_mem_types.kdata -> unit) ->

   ?external_cmd:bool ->
   ?extra_args:(Arg.key * Arg.spec * Arg.doc) list ->
   ?argcheck:(bool -> unit) ->
   ?external_cmd:bool ->
   ?extra_args:(Arg.key * Arg.spec * Arg.doc) list ->
   ?argcheck:(bool -> unit) ->

-  ?beforeksyms:(bool -> Virt_mem_types.image0 list -> unit) ->
-  ?beforeutsname:(bool -> Virt_mem_types.image1 -> unit) ->
-  ?run:(bool -> Virt_mem_types.image2 -> unit) ->

   string -> string -> Arg.usage_msg ->
   unit
   (** Tools register themselves with this call.
 
   string -> string -> Arg.usage_msg ->
   unit
   (** Tools register themselves with this call.
 

-      The anonymous parameters are:
+      The required parameters are:

       - tool name (eg. "uname")
       - short summary
       - full usage message
 
       - tool name (eg. "uname")
       - short summary
       - full usage message
 

-      The optional callback functions are:
-      - [?argcheck] called after arguments have been fully parsed
-      so that the program can do any additional checks needed (eg.
-      on [extra_args]),
-      - [?beforeksyms] called after images are loaded and before
-      kernel symbols are analyzed,
-      - [?beforeutsname] called after kernel symbols are analyzed
-      and before the kernel version is detected
-      - [?run] called after everything
-      (almost all tools supply this callback function).
+      The boolean parameters specify what kernel structures the
+      tool needs before it can run.  The main program will read
+      these structures in before calling [~run].
+      - [~needs_ksyms:true] if kernel symbols are needed
+      - [~needs_utsname:true] if kernel version (utsname) is needed
+      - [~needs_task_struct:true] if all task_struct (processes) are needed
+      - [~needs_everything:true] if the tool requires as much as
+      possible (but will not fail if we cannot determine everything)
+
+      The [~run] function is the tool's run function.  This function
+      is run once for each separate domain.  It may throw any exception,
+      which is printed out, but does not abort the program.  (If for
+      some reason you need to abort the whole program, call [exit].)

 
       Pass [~external_cmd:false] if this tool doesn't have an
       external 'virt-tool' link.
 
       Pass [~extra_args:...] if this tool needs extra command
       line options.
 
       Pass [~external_cmd:false] if this tool doesn't have an
       external 'virt-tool' link.
 
       Pass [~extra_args:...] if this tool needs extra command
       line options.

+
+      Pass [~argcheck:...] so that the tool can do any additional
+      parameter checks needed (eg. for [~extra_args]).

   *)
 
 val main : unit -> unit
   *)
 
 val main : unit -> unit

diff --git a/lib/virt_mem_capture.ml b/lib/virt_mem_capture.ml
index 0c1ff57..5e51fc1 100644 (file)
--- a/lib/virt_mem_capture.ml
+++ b/lib/virt_mem_capture.ml
@@ -39,10 +39,9 @@ let argcheck debug =
     exit 1
   )
 
     exit 1
   )
 

-(* Capture the images before kernel symbol analysis is attempted.
- * Just save them to the output file(s).
- *)
-let rec beforeksyms debug = function
+(* Capture the image. *)
+let rec run debug image kdata = ()
+(*

   | [] ->
       prerr_endline
        (s_"virt-mem capture: warning: no kernel images were captured")
   | [] ->
       prerr_endline
        (s_"virt-mem capture: warning: no kernel images were captured")


@@ -77,6 +76,7 @@ and save_image { domname = domname } filename =
 
   printf (f_"virt-mem capture: wrote kernel image from %s to filename %s\n")
     domname filename
 
   printf (f_"virt-mem capture: wrote kernel image from %s to filename %s\n")
     domname filename

+*)

 
 let summary = s_"capture memory image for post-mortem analysis"
 let description = s_"Capture a memory image to a file for later post-mortem
 
 let summary = s_"capture memory image for post-mortem analysis"
 let description = s_"Capture a memory image to a file for later post-mortem


@@ -92,6 +92,6 @@ let extra_args = [
 
 let () =
   Virt_mem.register
 
 let () =
   Virt_mem.register

-    ~external_cmd:false ~extra_args
-    ~argcheck ~beforeksyms
+    ~needs_everything:true ~run
+    ~external_cmd:false ~extra_args ~argcheck

     "capture" summary description
     "capture" summary description

diff --git a/lib/virt_mem_kallsyms.ml b/lib/virt_mem_kallsyms.ml
index 2394248..631bf61 100644 (file)
--- a/lib/virt_mem_kallsyms.ml
+++ b/lib/virt_mem_kallsyms.ml
@@ -36,7 +36,7 @@ type kallsyms_compr =
   | Compressed of (string * Virt_mem_mmap.addr) list * Virt_mem_mmap.addr
   | Uncompressed of (string * Virt_mem_mmap.addr) list
 
   | Compressed of (string * Virt_mem_mmap.addr) list * Virt_mem_mmap.addr
   | Uncompressed of (string * Virt_mem_mmap.addr) list
 

-let find_kallsyms debug (({ domname = domname; mem = mem } as image), ksymmap) =
+let find_kallsyms debug ({ domname = domname; mem = mem } as image) ksymmap =

   let start_t = gettimeofday () in
 
   (* Now try to find the /proc/kallsyms table.  This is in an odd
   let start_t = gettimeofday () in
 
   (* Now try to find the /proc/kallsyms table.  This is in an odd


@@ -200,10 +200,8 @@ let find_kallsyms debug (({ domname = domname; mem = mem } as image), ksymmap) =
     let freqs = frequency kallsymtabs in
     match freqs with
     | [] ->
     let freqs = frequency kallsymtabs in
     match freqs with
     | [] ->

-       (* Can't find any kallsymtabs, just return the ksymmap
-        * map generated previously from the exported symbols.
-        *)
-       ksymmap
+       (* Can't find any kallsymtabs. *)
+       None

 
     | (_, (_, _, _, Uncompressed names)) :: _ ->
        let rec loop ksymmap = function
 
     | (_, (_, _, _, Uncompressed names)) :: _ ->
        let rec loop ksymmap = function


@@ -211,7 +209,7 @@ let find_kallsyms debug (({ domname = domname; mem = mem } as image), ksymmap) =
              loop (Ksymmap.add name value ksymmap) names
          | [] -> ksymmap
        in
              loop (Ksymmap.add name value ksymmap) names
          | [] -> ksymmap
        in

-       loop ksymmap names
+       Some (loop ksymmap names)

 
     | (_, (start_addr, num_entries, names_addr,
           Compressed (compressed_names, markers_addr))) :: _ ->
 
     | (_, (start_addr, num_entries, names_addr,
           Compressed (compressed_names, markers_addr))) :: _ ->


@@ -262,7 +260,7 @@ let find_kallsyms debug (({ domname = domname; mem = mem } as image), ksymmap) =
              loop (Ksymmap.add name value ksymmap) names
          | [] -> ksymmap
        in
              loop (Ksymmap.add name value ksymmap) names
          | [] -> ksymmap
        in

-       loop ksymmap names in
+       Some (loop ksymmap names) in

 
   if debug then (
     let end_t = gettimeofday () in
 
   if debug then (
     let end_t = gettimeofday () in


@@ -270,4 +268,4 @@ let find_kallsyms debug (({ domname = domname; mem = mem } as image), ksymmap) =
       (end_t -. start_t)
   );
 
       (end_t -. start_t)
   );
 

-  ((image, ksymmap) : image1)
+  (image, ksymmap)

diff --git a/lib/virt_mem_kallsyms.mli b/lib/virt_mem_kallsyms.mli
index 7f51831..67a9b96 100644 (file)
--- a/lib/virt_mem_kallsyms.mli
+++ b/lib/virt_mem_kallsyms.mli
@@ -20,5 +20,6 @@
    Find kallsyms in a kernel image.
  *)
 
    Find kallsyms in a kernel image.
  *)
 

-val find_kallsyms : bool -> Virt_mem_types.image1 -> Virt_mem_types.image1
+val find_kallsyms : bool -> Virt_mem_types.image -> Virt_mem_types.ksymmap
+  -> Virt_mem_types.image * Virt_mem_types.ksymmap option

 (** Find kallsyms in a kernel image. *)
 (** Find kallsyms in a kernel image. *)

diff --git a/lib/virt_mem_ksyms.ml b/lib/virt_mem_ksyms.ml
index 32031fb..4389983 100644 (file)
--- a/lib/virt_mem_ksyms.ml
+++ b/lib/virt_mem_ksyms.ml
@@ -146,7 +146,7 @@ let find_kernel_symbols debug ({ mem = mem; domname = domname } as image) =
     match freqs with
     | [] ->
        eprintf (f_"%s: cannot find start of kernel symbol table\n") domname;
     match freqs with
     | [] ->
        eprintf (f_"%s: cannot find start of kernel symbol table\n") domname;

-       Ksymmap.empty
+       None

 
     | (_, (ksymtab_addr, ksymtab_size)) :: _ ->
        if debug then
 
     | (_, (ksymtab_addr, ksymtab_size)) :: _ ->
        if debug then


@@ -177,7 +177,7 @@ let find_kernel_symbols debug ({ mem = mem; domname = domname } as image) =
          in
          loop Ksymmap.empty ksymtab in
 
          in
          loop Ksymmap.empty ksymtab in
 

-       ksymmap
+       Some ksymmap

   in
 
   if debug then (
   in
 
   if debug then (


@@ -186,4 +186,4 @@ let find_kernel_symbols debug ({ mem = mem; domname = domname } as image) =
       (end_t -. start_t)
   );
 
       (end_t -. start_t)
   );
 

-  ((image, ksymmap) : image1)
+  (image, ksymmap)

diff --git a/lib/virt_mem_ksyms.mli b/lib/virt_mem_ksyms.mli
index fb00bb3..f9a53d2 100644 (file)
--- a/lib/virt_mem_ksyms.mli
+++ b/lib/virt_mem_ksyms.mli
@@ -24,5 +24,6 @@ val common_ksyms : Virt_mem_types.ksym list
 (** The list of "common" kernel symbols which we expect to be present
     in almost any Linux kernel. *)
 
 (** The list of "common" kernel symbols which we expect to be present
     in almost any Linux kernel. *)
 

-val find_kernel_symbols : bool -> Virt_mem_types.image0 -> Virt_mem_types.image1
+val find_kernel_symbols : bool -> Virt_mem_types.image ->
+  Virt_mem_types.image * Virt_mem_types.ksymmap option

 (** Find ordinary kernel symbols in a kernel image. *)
 (** Find ordinary kernel symbols in a kernel image. *)

diff --git a/lib/virt_mem_tasks.ml b/lib/virt_mem_tasks.ml
new file mode 100644 (file)
index 0000000..c16e660
--- /dev/null
+++ b/lib/virt_mem_tasks.ml
@@ -0,0 +1,74 @@
+(* Memory info command for virtual domains.
+   (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+open Printf
+
+open Virt_mem_gettext.Gettext
+open Virt_mem_utils
+open Virt_mem_types
+
+open Kernel_task_struct
+
+let find_tasks debug image ksymmap kernel_version =
+  if not (task_struct_known kernel_version) then (
+    eprintf (f_"%s: %s: unknown kernel version
+Try a newer version of virt-mem, or if the guest is not from a
+supported Linux distribution, see this page about adding support:
+  http://et.redhat.com/~rjones/virt-mem/faq.html\n")
+      image.domname kernel_version;
+    image, None
+  ) else (
+    let task_struct_size = task_struct_size kernel_version in
+
+    let init_task_addr =
+      try Some (Ksymmap.find "init_task" ksymmap)
+      with Not_found ->
+       eprintf (f_"%s: could not find init_task in kernel image\n")
+         image.domname;
+       None in
+    match init_task_addr with
+    | None -> image, None
+    | Some init_task_addr ->
+       let init_task =
+         get_task_struct kernel_version image.mem init_task_addr in
+
+       (* Starting at init_task, navigate through the linked list of
+        * tasks (through tasks.next).  Just make sure they are mapped
+        * into memory.
+        *)
+       let image =
+         let rec loop image task =
+           let next = task.task_struct_tasks'next in
+           if next <> init_task_addr then (
+             let mapped =
+               Virt_mem_mmap.is_mapped_range image.mem next task_struct_size in
+             let image =
+               if not mapped then
+                 Virt_mem_types.load_memory image next task_struct_size
+               else
+                 image in
+             let task = get_task_struct kernel_version image.mem next in
+             loop image task
+           ) else
+             image
+         in
+         loop image init_task in
+
+       image, Some init_task_addr
+  )

diff --git a/lib/virt_mem_tasks.mli b/lib/virt_mem_tasks.mli
new file mode 100644 (file)
index 0000000..f6d6f94
--- /dev/null
+++ b/lib/virt_mem_tasks.mli
@@ -0,0 +1,26 @@
+(** Get process list from kernel. *)
+(* Memory info command for virtual domains.
+   (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
+   http://libvirt.org/
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *)
+
+val find_tasks : bool ->
+  Virt_mem_types.image ->
+  Virt_mem_types.ksymmap ->
+  string ->
+  Virt_mem_types.image * Virt_mem_mmap.addr option
+(** Find and load the process table. *)

diff --git a/lib/virt_mem_types.ml b/lib/virt_mem_types.ml
index c3da932..293d2de 100644 (file)
--- a/lib/virt_mem_types.ml
+++ b/lib/virt_mem_types.ml
@@ -29,25 +29,18 @@ type ksym = string
 
 module Ksymmap = Map.Make (String)
 
 
 module Ksymmap = Map.Make (String)
 

-type image0 = {
+type ksymmap = addr Ksymmap.t
+
+type image = {

   dom : Libvirt.ro D.t option;
   domname : string;
   dom : Libvirt.ro D.t option;
   domname : string;

-  arch : Virt_mem_utils.architecture;
+  arch : architecture;

   mem : ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t;
   kernel_min : addr;
   kernel_max : addr;
 }
 
   mem : ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t;
   kernel_min : addr;
   kernel_max : addr;
 }
 

-type image1 =
-    image0
-    * addr Ksymmap.t
-
-type image2 =
-    image0
-    * addr Ksymmap.t
-    * utsname option
-
-and utsname = {
+type utsname = {

   kernel_name : string;
   nodename : string;
   kernel_release : string;
   kernel_name : string;
   nodename : string;
   kernel_release : string;


@@ -56,6 +49,12 @@ and utsname = {
   domainname : string;
 }
 
   domainname : string;
 }
 

+type kdata = {
+  ksyms : ksymmap option;
+  utsname : utsname option;
+  tasks : Virt_mem_mmap.addr option;
+}
+

 (* This is the maximum we can download in one go over the libvirt
  * remote connection.
  *
 (* This is the maximum we can download in one go over the libvirt
  * remote connection.
  *


@@ -81,7 +80,7 @@ let _load_memory mem dom start size =
   in
   loop 0;
 
   in
   loop 0;
 

-  add_string mem str start
+  Virt_mem_mmap.add_string mem str start

 
 let load_static_memory ~dom ~domname ~arch ~wordsize ~endian
     ~kernel_min ~kernel_max start size =
 
 let load_static_memory ~dom ~domname ~arch ~wordsize ~endian
     ~kernel_min ~kernel_max start size =


@@ -110,7 +109,7 @@ let load_memory ({ dom = dom; mem = mem; kernel_min = kernel_min;
   else if start +^ Int64.of_int size > kernel_max then
     raise (LoadMemoryError (AddressOutOfRange,
                            "load_memory: start+size > kernel_max"))
   else if start +^ Int64.of_int size > kernel_max then
     raise (LoadMemoryError (AddressOutOfRange,
                            "load_memory: start+size > kernel_max"))

-  else if is_mapped_range mem start size then image
+  else if Virt_mem_mmap.is_mapped_range mem start size then image

   else (
     match dom with
     | None ->
   else (
     match dom with
     | None ->

diff --git a/lib/virt_mem_types.mli b/lib/virt_mem_types.mli
index f537664..a95b770 100644 (file)
--- a/lib/virt_mem_types.mli
+++ b/lib/virt_mem_types.mli
@@ -41,10 +41,24 @@ module Ksymmap : sig
   val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
   val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
 end
   val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int
   val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
 end

-  (** A map of kernel symbols to addresses. *)
+  (** Functions available in the map of kernel symbols to addresses. *)
+
+type ksymmap = Virt_mem_mmap.addr Ksymmap.t
+  (** Kernel symbol table (map of kernel symbols to addresses). *)

 
 (** {2 Kernel images and associated data} *)
 
 
 (** {2 Kernel images and associated data} *)
 

+type image = {
+  dom : Libvirt.ro Libvirt.Domain.t option; (** Domain, if known. *)
+  domname : string;                    (** Domain name. *)
+  arch : Virt_mem_utils.architecture;  (** Architecture, eg. i386. *)
+  mem : ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t;
+                                        (** Memory map. *)
+  kernel_min : Virt_mem_mmap.addr;     (** Minimum addr of kernel pointers. *)
+  kernel_max : Virt_mem_mmap.addr;     (** Maximum addr of kernel pointers. *)
+}
+  (** A basic kernel image. *)
+

 type utsname = {
   kernel_name : string;
   nodename : string;
 type utsname = {
   kernel_name : string;
   nodename : string;


@@ -55,49 +69,33 @@ type utsname = {
 }
   (** Kernel version, from utsname structure in the kernel. *)
 
 }
   (** Kernel version, from utsname structure in the kernel. *)
 

-type image0 = {
-  dom : Libvirt.ro Libvirt.Domain.t option; (** Domain, if known. *)
-  domname : string;                    (** Domain name. *)
-  arch : Virt_mem_utils.architecture;  (** Architecture, eg. i386. *)
-  mem : ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t;
-                                        (** Memory map. *)
-  kernel_min : Virt_mem_mmap.addr;     (** Minimum addr of kernel pointers. *)
-  kernel_max : Virt_mem_mmap.addr;     (** Maximum addr of kernel pointers. *)
+type kdata = {
+  ksyms : ksymmap option;               (** Kernel symbol lookup function. *)
+  utsname : utsname option;            (** Kernel version. *)
+  tasks : Virt_mem_mmap.addr option;    (** Linked list of tasks (processes)
+                                           starting at the address of
+                                           init_task (swapper). *)

 }
 }

-  (** A basic kernel image. *)
+  (** Optional data derived from the raw kernel image by the main
+      program and passed to the tools' [~run] functions.

 
 

-type image1 =
-    image0
-    * Virt_mem_mmap.addr Ksymmap.t     (* Kernel symbol map. *)
-  (** A kernel image, after finding kernel symbols. *)
+      What fields get filled in is controlled by the [~needs_*]
+      options passed when tools register themselves, and also of
+      course by what we are able to find out about the memory image.

 
 

-type image2 =
-    image0
-    * Virt_mem_mmap.addr Ksymmap.t     (* Kernel symbol map. *)
-    * utsname option                   (* Kernel version, etc., if found. *)
-  (** A kernel image, after finding kernel version (like 'uname'). *)
+      Note there is significant cost to filling in some of these
+      fields.
+*)

 
 (** {2 Load kernel memory} *)
 
 type load_memory_error =
 
 (** {2 Load kernel memory} *)
 
 type load_memory_error =

-  | AddressOutOfRange          (** Address not in [kernel_min..kernel_max] *)
-  | DomIsNull                  (** image.dom = None *)
+  | AddressOutOfRange          (** Address not in [kernel_min..kernel_max] *)
+  | DomIsNull                  (** image.dom = None *)

 
 exception LoadMemoryError of load_memory_error * string
 
 
 exception LoadMemoryError of load_memory_error * string
 

-val load_static_memory : dom:Libvirt.ro Libvirt.Domain.t ->
-  domname:string ->
-  arch:Virt_mem_utils.architecture ->
-  wordsize:Virt_mem_utils.wordsize -> endian:Bitstring.endian ->
-  kernel_min:Virt_mem_mmap.addr -> kernel_max:Virt_mem_mmap.addr ->
-  Virt_mem_mmap.addr -> int -> image0
-  (** [load_static_memory ~dom (*...*) start size] creates an [image0]
-      object, and initializes it with static kernel memory loaded
-      from the [start] address and [size] of [dom].
-
-      See also {!load_memory} for exceptions this can raise. *)
-
-val load_memory : image0 -> Virt_mem_mmap.addr -> int -> image0
+val load_memory : image -> Virt_mem_mmap.addr -> int -> image

   (** [load_memory img start size] tries to load [size] bytes from
       the start address into the memory map.  If the memory was loaded
       previously, then it is not requested again.
   (** [load_memory img start size] tries to load [size] bytes from
       the start address into the memory map.  If the memory was loaded
       previously, then it is not requested again.


@@ -108,3 +106,15 @@ val load_memory : image0 -> Virt_mem_mmap.addr -> int -> image0
       This function can raise many different sorts of exceptions and
       the caller is advised to catch any exceptions and deal with them
       appropriately. *)
       This function can raise many different sorts of exceptions and
       the caller is advised to catch any exceptions and deal with them
       appropriately. *)

+
+val load_static_memory : dom:Libvirt.ro Libvirt.Domain.t ->
+  domname:string ->
+  arch:Virt_mem_utils.architecture ->
+  wordsize:Virt_mem_utils.wordsize -> endian:Bitstring.endian ->
+  kernel_min:Virt_mem_mmap.addr -> kernel_max:Virt_mem_mmap.addr ->
+  Virt_mem_mmap.addr -> int -> image
+  (** [load_static_memory ~dom (*...*) start size] creates an [image0]
+      object, and initializes it with static kernel memory loaded
+      from the [start] address and [size] of [dom].
+
+      See also {!load_memory} for exceptions this can raise. *)

diff --git a/lib/virt_mem_utsname.ml b/lib/virt_mem_utsname.ml
index 33ee969..0ae8871 100644 (file)
--- a/lib/virt_mem_utsname.ml
+++ b/lib/virt_mem_utsname.ml
@@ -47,7 +47,7 @@ let parse_utsname bits =
   | { _ } ->
       None
 
   | { _ } ->
       None
 

-let find_utsname debug ({ domname = name; mem = mem } as image, ksymmap) =
+let find_utsname debug ({ domname = name; mem = mem } as image) ksymmap =

   let utsname =
     (* In Linux 2.6.25, the symbol is init_uts_ns.
      * http://lxr.linux.no/linux/init/version.c
   let utsname =
     (* In Linux 2.6.25, the symbol is init_uts_ns.
      * http://lxr.linux.no/linux/init/version.c


@@ -80,4 +80,4 @@ let find_utsname debug ({ domname = name; mem = mem } as image, ksymmap) =
              Not_found ->
                eprintf (f_"%s: could not find utsname in kernel image\n") name
   in
              Not_found ->
                eprintf (f_"%s: could not find utsname in kernel image\n") name
   in

-  (image, ksymmap, utsname)
+  image, utsname

diff --git a/lib/virt_mem_utsname.mli b/lib/virt_mem_utsname.mli
index 7b62d42..7c0742e 100644 (file)
--- a/lib/virt_mem_utsname.mli
+++ b/lib/virt_mem_utsname.mli
@@ -18,5 +18,6 @@
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  *)
 
    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  *)
 

-val find_utsname : bool -> Virt_mem_types.image1 -> Virt_mem_types.image2
+val find_utsname : bool -> Virt_mem_types.image -> Virt_mem_types.ksymmap
+  -> Virt_mem_types.image * Virt_mem_types.utsname option

 (** Find the system utsname structure. *)
 (** Find the system utsname structure. *)

diff --git a/ps/.depend b/ps/.depend
index 11d70ae..c170c41 100644 (file)
--- a/ps/.depend
+++ b/ps/.depend
@@ -1,6 +1,6 @@
 virt_ps.cmo: ../lib/virt_mem_utils.cmo ../lib/virt_mem_types.cmi \
 virt_ps.cmo: ../lib/virt_mem_utils.cmo ../lib/virt_mem_types.cmi \

-    ../lib/virt_mem_mmap.cmi ../lib/virt_mem_gettext.cmo ../lib/virt_mem.cmi \
+    ../lib/virt_mem_gettext.cmo ../lib/virt_mem.cmi \

     ../lib/kernel_task_struct.cmi 
 virt_ps.cmx: ../lib/virt_mem_utils.cmx ../lib/virt_mem_types.cmx \
     ../lib/kernel_task_struct.cmi 
 virt_ps.cmx: ../lib/virt_mem_utils.cmx ../lib/virt_mem_types.cmx \

-    ../lib/virt_mem_mmap.cmx ../lib/virt_mem_gettext.cmx ../lib/virt_mem.cmx \
+    ../lib/virt_mem_gettext.cmx ../lib/virt_mem.cmx \

     ../lib/kernel_task_struct.cmx 
     ../lib/kernel_task_struct.cmx 

diff --git a/ps/virt_ps.ml b/ps/virt_ps.ml
index a9bcf1f..5c53dbf 100644 (file)
--- a/ps/virt_ps.ml
+++ b/ps/virt_ps.ml
@@ -25,77 +25,48 @@ open Virt_mem_types
 
 open Kernel_task_struct
 
 
 open Kernel_task_struct
 

-let run debug (image, ksymmap, utsname) =
-  try
-    let { domname = domname } = image in
-
-    let kernel_version =
-      match utsname with
-      | None ->
-         eprintf (f_"%s: could not guess kernel version\n") domname;
-         raise Exit
-      | Some { kernel_release = v } -> v in
-
-    if not (task_struct_known kernel_version) then (
-      eprintf (f_"%s: %s: unknown kernel version
-Try a newer version of virt-mem, or if the guest is not from a
-supported Linux distribution, see this page about adding support:
-  http://et.redhat.com/~rjones/virt-mem/faq.html\n") domname kernel_version;
-      raise Exit
-    );
-
-    let task_struct_size = task_struct_size kernel_version in
-
-    let init_task, init_task_addr =
-      let init_task_addr =
-       try Ksymmap.find "init_task" ksymmap
-       with Not_found ->
-         eprintf (f_"%s: could not find init_task in kernel image\n") domname;
-         raise Exit in
-      let init_task =
-       get_task_struct kernel_version image.mem init_task_addr in
-      init_task, init_task_addr in
-
-    (* Starting at init_task, navigate through the linked list of
-     * tasks (through tasks.next).  Grab each task_struct as we go.
-     *)
-    let tasks, image =
-      let rec loop image acc task =
-       let next = task.task_struct_tasks'next in
-       if next <> init_task_addr then (
-         let mapped =
-           Virt_mem_mmap.is_mapped_range image.mem next task_struct_size in
-         let image =
-           if not mapped then load_memory image next task_struct_size
-           else image in
-         let task = get_task_struct kernel_version image.mem next in
-         let task = {
-           task with
-             task_struct_comm = truncate_c_string task.task_struct_comm
-         } in
-         let acc = task :: acc in
-         loop image acc task
-       ) else
-         acc, image
-      in
-      loop image [] init_task in
-
-    (* Sort tasks by PID. *)
-    let cmp { task_struct_pid = p1 } { task_struct_pid = p2 } = compare p1 p2 in
-    let tasks = List.sort cmp tasks in
-
-    printf "  PID STAT COMMAND\n";
-
-    List.iter (
-      fun task ->
-       printf "%5Ld      %s\n" task.task_struct_pid task.task_struct_comm
-    ) tasks
-
-  with Exit -> ()
+let run debug { domname = domname; mem = mem }
+    { utsname = utsname; tasks = tasks } =
+  let utsname = Option.get utsname in
+  let kernel_version = utsname.kernel_release in
+  let init_task_addr = Option.get tasks in
+
+  (* Starting at init_task, navigate through the linked list of
+   * tasks (through tasks.next).  The main program has already made
+   * sure these are mapped into memory.
+   *)
+  let tasks =
+    let rec loop acc task =
+      let next = task.task_struct_tasks'next in
+      if next <> init_task_addr then (
+       let task = get_task_struct kernel_version mem next in
+       let task = {
+         task with
+           task_struct_comm = truncate_c_string task.task_struct_comm
+       } in
+       let acc = task :: acc in
+       loop acc task
+      ) else
+       acc
+    in
+    loop [] (get_task_struct kernel_version mem init_task_addr) in
+
+  (* Sort tasks by PID. *)
+  let cmp { task_struct_pid = p1 } { task_struct_pid = p2 } = compare p1 p2 in
+  let tasks = List.sort cmp tasks in
+
+  printf "  PID STAT COMMAND\n";
+
+  List.iter (
+    fun task ->
+      printf "%5Ld      %s\n" task.task_struct_pid task.task_struct_comm
+  ) tasks

 
 let summary = s_"list processes in virtual machine"
 let description = s_"\
 virt-ps prints a process listing for virtual machines running under
 libvirt."
 
 
 let summary = s_"list processes in virtual machine"
 let description = s_"\
 virt-ps prints a process listing for virtual machines running under
 libvirt."
 

-let () = Virt_mem.register "ps" summary description ~run
+let () =
+  Virt_mem.register "ps" summary description
+    ~needs_utsname:true ~needs_tasks:true ~run

diff --git a/uname/virt_uname.ml b/uname/virt_uname.ml
index 3d902ce..d90974d 100644 (file)
--- a/uname/virt_uname.ml
+++ b/uname/virt_uname.ml
@@ -23,7 +23,7 @@ open Virt_mem_gettext.Gettext
 open Virt_mem_utils
 open Virt_mem_types
 
 open Virt_mem_utils
 open Virt_mem_types
 

-let run debug ({ domname = domname }, _, utsname) =
+let run debug { domname = domname } { utsname = utsname } =

   match utsname with
   | Some u ->
       printf "%s: %s %s %s %s %s %s\n"
   match utsname with
   | Some u ->
       printf "%s: %s %s %s %s %s %s\n"


@@ -39,4 +39,4 @@ virt-uname prints the uname information such as OS version,
 architecture and node name for virtual machines running under
 libvirt."
 
 architecture and node name for virtual machines running under
 libvirt."
 

-let () = Virt_mem.register "uname" summary description ~run
+let () = Virt_mem.register "uname" summary description ~needs_utsname:true ~run