open Kernel_task_struct
-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 run debug { domname = domname; mem = mem } { net_devices = net_devices } =
+ let net_devices = Option.get net_devices in
- ()
+ (* Sort by device name. *)
+ let cmp { netdev_name = n1 } { netdev_name = n2 } = compare n1 n2 in
+ let net_devices = List.sort cmp net_devices in
+
+ List.iter (
+ fun netdev ->
+ printf "%s\n" netdev.netdev_name
+ ) net_devices
let summary = s_"list network interfaces in virtual machine"
let description = s_"\
"
let () =
- Virt_mem.register "ifconfig" summary description
- ~needs_utsname:true ~needs_net_devices:true ~run
+ Virt_mem.register "ifconfig" summary description ~needs_net_devices:true ~run
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
- let needs_ksyms, needs_utsname, needs_net_devices =
- if needs_everything then true, true, true
- else needs_ksyms, needs_utsname, needs_net_devices in
+ let needs_ksyms, needs_utsname =
+ if needs_net_devices then true, true
+ else needs_ksyms, needs_utsname in
+ let needs_ksyms, needs_utsname, needs_tasks, needs_net_devices =
+ if needs_everything then true, true, true, true
+ else needs_ksyms, needs_utsname, needs_tasks, needs_net_devices in
(* Do the kernel symbol analysis. *)
let images =
List.map (
fun (image, ({ ksyms = ksyms; utsname = utsname } as kdata)) ->
match ksyms, utsname with
- | Some ksyms, Some { kernel_release = kversion } ->
+ | Some ksyms, Some { uts_kernel_release = kversion } ->
let image, tasks =
Virt_mem_tasks.find_tasks debug image ksyms kversion in
let kdata = { kdata with tasks = tasks } in
List.map (
fun (image, ({ ksyms = ksyms; utsname = utsname } as kdata)) ->
match ksyms, utsname with
- | Some ksyms, Some { kernel_release = kversion } ->
+ | Some ksyms, Some { uts_kernel_release = kversion } ->
let image, net_devices =
Virt_mem_net_devices.find_net_devices debug
image ksyms kversion in
open Virt_mem_types
open Kernel_net_device
+open Kernel_net
-type linkage = Next | DevList of int
+let max_net_devices = 10000
let rec find_net_devices debug image ksymmap kernel_version =
if not (net_device_known kernel_version) then (
) else (
let size = net_device_size kernel_version in
- (* In kernels < around 2.6.22, this is a simple linked list:
+ (* In kernels < ~ 2.6.22, this is a simple linked list:
* dev_base -> next -> next
* In kernels >= 2.6.23, this is a list_head:
* dev_base_head -> list_head dev_list -> ...
*)
- let linkage =
+ let map =
let { field_available = available } =
field_signature_of_net_device_next kernel_version in
if available then
- Some Next
+ Some map_next
else (
let { field_available = available; field_offset = offset } =
field_signature_of_net_device_dev_list'next kernel_version in
if available then
- Some (DevList offset)
+ Some (map_dev_list offset)
else (
eprintf (f_"%s: kernel net_device table is not linked through either next pointer or dev_list list_head. Cannot read net devices.\n") image.domname;
None
)
) in
- match linkage with
- | None -> image, None
- | Some Next ->
- printf "linkage = Next\n%!";
+ match map with
+ | None -> image, None
- (* Linkage through old-style chain of next pointers. *)
- let dev_base =
+ | Some map ->
+ (* What is the starting point for iteration? In older kernels
+ * it was the symbol 'dev_base'. Then briefly (2.6.22-2.6.24)
+ * it became 'sruct list_head dev_base_head'. Then when net
+ * namespaces were introduced (>= 2.6.25) it became 'struct
+ * list_head init_net.dev_base_head'.
+ *)
+ let addr =
try Some (Ksymmap.find "dev_base" ksymmap)
with Not_found ->
- eprintf (f_"%s: could not find dev_base symbol in kernel image\n") image.domname;
- None in
- (match dev_base with
- | None -> image, None
- | Some dev_base ->
- do_next image kernel_version dev_base size
- );
-
- | Some (DevList offset) ->
- printf "linkage = DevList %d\n%!" offset;
-
- (* Linkage through new-style list_head dev_list. *)
- let dev_base_head =
- try Some (Ksymmap.find "dev_base_head" ksymmap)
- with Not_found ->
- eprintf (f_"%s: could not find dev_base_head symbol in kernel image\n") image.domname;
- None in
- (match dev_base_head with
- | None -> image, None
- | Some dev_base_head ->
- let dev_base_head =
- Virt_mem_mmap.follow_pointer image.mem dev_base_head in
-
- do_dev_list image kernel_version dev_base_head offset size
- );
+ try
+ let addr = Ksymmap.find "dev_base_head" ksymmap in
+ let addr = Virt_mem_mmap.follow_pointer image.mem addr in
+ Some addr
+ with Not_found ->
+ try
+ let addr = Ksymmap.find "init_net" ksymmap in
+ if not (net_known kernel_version) then (
+ eprintf (f_"%s: struct net not available in this kernel version.\n") image.domname;
+ raise Not_found
+ );
+ let init_net = get_net kernel_version image.mem addr in
+ let addr = init_net.net_dev_base_head'next in
+ Some addr
+ with Not_found ->
+ eprintf (f_"%s: cannot find dev_base, dev_base_head or init_net symbols in kernel image.\n") image.domname;
+ None in
+
+ match addr with
+ | None -> image, None
+
+ | Some addr ->
+ (* Map over the structure using previously defined map function. *)
+ let image, netdevs =
+ map image kernel_version addr size (
+ fun netdev ->
+ { netdev_name = truncate_c_string netdev.net_device_name;
+ netdev_dev_addr = netdev.net_device_dev_addr }
+ ) in
+
+ image, Some netdevs
)
-(* Iterate dev_base_head -> list_head dev_list -> ... *)
-and do_dev_list image kernel_version dev_base_head offset size =
+(* Map dev_base_head -> list_head dev_list -> ... *)
+and map_dev_list offset image kernel_version first_addr size f =
+ eprintf "map_dev_list: first_addr is %Lx\n" first_addr;
+
(* The list_head points into the middle of the structure.
* Adjust this address to point to the start of the
* structure.
*)
- let addr = Int64.sub dev_base_head (Int64.of_int offset) in
-
- printf "do_dev_list, size = %d\n" size;
+ let addr = Int64.sub first_addr (Int64.of_int offset) in
+ eprintf "map_dev_list: after subtracting, addr is %Lx\n" addr;
- let image =
- let rec loop image addr =
+ let rec loop i image acc addr =
+ if i <= max_net_devices then (
+ eprintf "map_dev_list: called at %Lx\n" addr;
let mapped = Virt_mem_mmap.is_mapped_range image.mem addr size in
let image =
if not mapped then
else
image in
let dev = get_net_device kernel_version image.mem addr in
- printf "net_device_name = %S\n" dev.net_device_name;
+ eprintf "map_dev_list: %Lx %S\n" addr dev.net_device_name;
+ let acc = f dev :: acc in
let addr = Option.get dev.net_device_dev_list'next in
- if addr <> dev_base_head then
- loop image addr
+ if addr <> first_addr then
+ loop (i+1) image acc addr
else
- image
- in
- loop image addr in
- image, Some dev_base_head
+ image, acc
+ ) else
+ failwith (sprintf (f_"%s: too many network devices") image.domname);
+ in
+ loop 0 image [] addr
(* Iterate dev_base -> next -> next ... *)
-and do_next image kernel_version addr size =
- printf "do_next, size = %d\n" size;
-
- let image =
- let rec loop image addr =
+and map_next image kernel_version addr size f =
+ let rec loop i image acc addr =
+ if i <= max_net_devices then (
if addr <> 0L then (
let mapped = Virt_mem_mmap.is_mapped_range image.mem addr size in
let image =
else
image in
let dev = get_net_device kernel_version image.mem addr in
- printf "net_device_name = %S\n" dev.net_device_name;
+ eprintf "map_next: %S\n" dev.net_device_name;
+ let acc = f dev :: acc in
let addr =
match dev.net_device_next with
| None -> assert false | Some addr -> addr in
- loop image addr
+ loop (i+1) image acc addr
) else
- image
- in
- loop image addr in
- image, Some addr
+ image, acc
+ ) else
+ failwith (sprintf (f_"%s: too many network devices") image.domname);
+ in
+ loop 0 image [] addr
Virt_mem_types.image ->
Virt_mem_types.ksymmap ->
string ->
- Virt_mem_types.image * Virt_mem_mmap.addr option
+ Virt_mem_types.image * Virt_mem_types.net_device list option
(** Find and load the net device list. *)
open Kernel_task_struct
+let max_tasks = 10000
+
let find_tasks debug image ksymmap kernel_version =
if not (task_struct_known kernel_version) then (
eprintf (f_"%s: %s: unknown kernel version
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.
+ * tasks (through tasks.next). Map them into memory and load
+ * them into a list.
*)
- 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
+ let image, tasks =
+ let rec loop i image acc task =
+ if i <= max_tasks then (
+ 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 (i+1) image (task :: acc) task
+ ) else
+ image, acc
) else
- image
+ failwith (sprintf (f_"%s: too many tasks") image.domname)
in
- loop image init_task in
+ loop 0 image [] init_task in
+
+ (* Convert to the internal format. *)
+ let tasks = List.rev_map (
+ fun task ->
+ { task_state = task.task_struct_state;
+ task_prio = task.task_struct_prio;
+ task_normal_prio = task.task_struct_normal_prio;
+ task_static_prio = task.task_struct_static_prio;
+ task_comm = truncate_c_string task.task_struct_comm;
+ task_pid = task.task_struct_pid }
+ ) tasks in
- image, Some init_task_addr
+ image, Some tasks
)
Virt_mem_types.image ->
Virt_mem_types.ksymmap ->
string ->
- Virt_mem_types.image * Virt_mem_mmap.addr option
+ Virt_mem_types.image * Virt_mem_types.task list option
(** Find and load the process table. *)
}
type utsname = {
- kernel_name : string;
- nodename : string;
- kernel_release : string;
- kernel_version : string;
- machine : string;
- domainname : string;
+ uts_kernel_name : string;
+ uts_nodename : string;
+ uts_kernel_release : string;
+ uts_kernel_version : string;
+ uts_machine : string;
+ uts_domainname : string;
+}
+
+type task = {
+ task_state : int64;
+ task_prio : int64;
+ task_normal_prio : int64;
+ task_static_prio : int64;
+ task_comm : string;
+ task_pid : int64;
+}
+
+type net_device = {
+ netdev_name : string;
+ netdev_dev_addr : string;
}
type kdata = {
ksyms : ksymmap option;
utsname : utsname option;
- tasks : Virt_mem_mmap.addr option;
- net_devices : Virt_mem_mmap.addr option;
+ tasks : task list option;
+ net_devices : net_device list option;
}
exception ParseError of string * string * string
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 memory images and associated metadata} *)
type image = {
dom : Libvirt.ro Libvirt.Domain.t option; (** Domain, if known. *)
}
(** A basic kernel image. *)
+(** {2 Kernel structures internal format}
+
+ So that we don't need to reiterate over certain important
+ kernel structures in each tool, we convert them into a more
+ convenient internal format.
+
+ See {!Virt_mem_tasks}, {!Virt_mem_net_devices}.
+*)
+
type utsname = {
- kernel_name : string;
- nodename : string;
- kernel_release : string;
- kernel_version : string;
- machine : string;
- domainname : string;
+ uts_kernel_name : string;
+ uts_nodename : string;
+ uts_kernel_release : string;
+ uts_kernel_version : string;
+ uts_machine : string;
+ uts_domainname : string;
}
(** Kernel version, from utsname structure in the kernel. *)
+type task = {
+ task_state : int64;
+ task_prio : int64;
+ task_normal_prio : int64;
+ task_static_prio : int64;
+ task_comm : string; (** Short command name. *)
+ task_pid : int64; (** Process ID. *)
+}
+ (** Internal version of the kernel [task_struct]. *)
+
+type net_device = {
+ netdev_name : string; (** Device name. *)
+ netdev_dev_addr : string; (** Interface network address. *)
+}
+ (** Internal version of the kernel [net_device] (network device struct). *)
+
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). *)
- net_devices : Virt_mem_mmap.addr option; (** Linked list of net devices
- starting at the address of
- dev_base_head. *)
+ ksyms : ksymmap option; (** Kernel symbol lookup function. *)
+ utsname : utsname option; (** Kernel version. *)
+ tasks : task list option; (** List of tasks (processes). *)
+ net_devices : net_device list option; (** List of net devices. *)
}
(** Optional data derived from the raw kernel image by the main
program and passed to the tools' [~run] functions.
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.
+ course by what we are able to find out about the memory image
+ (see {!Virt_mem.register}).
Note there is significant cost to filling in some of these
fields.
*)
-(** {2 Kernel structure parsers} *)
+(** {2 Helper declarations for kernel structure parsers}
+
+ The kernel structure parsers (in {!Kernel_task_struct} et al (see
+ [lib/kernel_*])) share a few common types declared here.
+
+ Note that the parsers themselves are generated automatically.
+*)
exception ParseError of string * string * string
(** Parsing exception raised by [Kernel_*] parser functions.
}
(** Returned by [Kernel_*.field_signature_of_*] functions. *)
-(** {2 Load kernel memory} *)
+(** {2 Functions to load kernel memory} *)
type load_memory_error =
| AddressOutOfRange (** Address not in [kernel_min..kernel_max] *)
machine : 65*8 : string;
domainname : 65*8 : string } ->
Some {
- kernel_name = "Linux";
- nodename = truncate_c_string nodename;
- kernel_release = truncate_c_string release;
- kernel_version = truncate_c_string version;
- machine = truncate_c_string machine;
- domainname = truncate_c_string domainname
+ uts_kernel_name = "Linux";
+ uts_nodename = truncate_c_string nodename;
+ uts_kernel_release = truncate_c_string release;
+ uts_kernel_version = truncate_c_string version;
+ uts_machine = truncate_c_string machine;
+ uts_domainname = truncate_c_string domainname
}
| { _ } ->
None
open Kernel_task_struct
-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
+let run debug { domname = domname; mem = mem } { tasks = tasks } =
+ let tasks = Option.get tasks in
(* Sort tasks by PID. *)
- let cmp { task_struct_pid = p1 } { task_struct_pid = p2 } = compare p1 p2 in
+ let cmp { task_pid = p1 } { task_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
+ printf "%5Ld %s\n" task.task_pid task.task_comm
) tasks
let summary = s_"list processes in virtual machine"
libvirt."
let () =
- Virt_mem.register "ps" summary description
- ~needs_utsname:true ~needs_tasks:true ~run
+ Virt_mem.register "ps" summary description ~needs_tasks:true ~run
| Some u ->
printf "%s: %s %s %s %s %s %s\n"
domname
- u.kernel_name u.nodename u.kernel_release
- u.kernel_version u.machine u.domainname
+ u.uts_kernel_name u.uts_nodename u.uts_kernel_release
+ u.uts_kernel_version u.uts_machine u.uts_domainname
| None ->
eprintf (f_"%s: no system_utsname in kernel image\n") domname