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
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
*)
- 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_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_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_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 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 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
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
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_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_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_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_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)
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, (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
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
<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. *)
- | 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 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";
* 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 ->
) 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 ->
- (* 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
+ (* 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). *)
- 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. *)
- (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)
*)
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) ->
- ?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.
- The anonymous parameters are:
+ The required parameters are:
- 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 [~argcheck:...] so that the tool can do any additional
+ parameter checks needed (eg. for [~extra_args]).
*)
val main : unit -> unit
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")
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 () =
Virt_mem.register
- ~external_cmd:false ~extra_args
- ~argcheck ~beforeksyms
+ ~needs_everything:true ~run
+ ~external_cmd:false ~extra_args ~argcheck
"capture" summary description
| 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 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
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))) :: _ ->
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
(end_t -. start_t)
);
- ((image, ksymmap) : image1)
+ (image, ksymmap)
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. *)
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
in
loop Ksymmap.empty ksymtab in
- ksymmap
+ Some ksymmap
in
if debug then (
(end_t -. start_t)
);
- ((image, ksymmap) : image1)
+ (image, ksymmap)
(** 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. *)
--- /dev/null
+(* 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
+ )
--- /dev/null
+(** 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. *)
module Ksymmap = Map.Make (String)
-type image0 = {
+type ksymmap = addr Ksymmap.t
+
+type image = {
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;
}
-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;
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.
*
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 =
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 ->
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} *)
+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;
}
(** 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 =
- | 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
-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.
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. *)
| { _ } ->
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
Not_found ->
eprintf (f_"%s: could not find utsname in kernel image\n") name
in
- (image, ksymmap, utsname)
+ image, utsname
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. *)
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/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
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 () = Virt_mem.register "ps" summary description ~run
+let () =
+ Virt_mem.register "ps" summary description
+ ~needs_utsname:true ~needs_tasks:true ~run
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"
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