Change to using internal format for kernel structures.
authorRichard W.M. Jones <rjones@redhat.com>
Tue, 12 Aug 2008 10:43:10 +0000 (11:43 +0100)
committerRichard W.M. Jones <rjones@redhat.com>
Tue, 12 Aug 2008 10:43:10 +0000 (11:43 +0100)
ifconfig/virt_ifconfig.ml
lib/virt_mem.ml
lib/virt_mem_net_devices.ml
lib/virt_mem_net_devices.mli
lib/virt_mem_tasks.ml
lib/virt_mem_tasks.mli
lib/virt_mem_types.ml
lib/virt_mem_types.mli
lib/virt_mem_utsname.ml
ps/virt_ps.ml
uname/virt_uname.ml

index e829944..4c4d3ec 100644 (file)
@@ -25,12 +25,17 @@ open Virt_mem_types
 
 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_"\
@@ -38,5 +43,4 @@ virt-ifconfig prints a network interfaces for virtual machines.
 "
 
 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
index 7bd30dc..32da18e 100644 (file)
@@ -514,12 +514,12 @@ Possibly the '-T' command line parameter was used inconsistently.");
   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 =
@@ -568,7 +568,7 @@ Possibly the '-T' command line parameter was used inconsistently.");
       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
@@ -583,7 +583,7 @@ Possibly the '-T' command line parameter was used inconsistently.");
       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
index d792d0d..a7078af 100644 (file)
@@ -24,8 +24,9 @@ open Virt_mem_utils
 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 (
@@ -38,75 +39,87 @@ supported Linux distribution, see this page about adding support:
   ) 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
@@ -114,22 +127,22 @@ and do_dev_list image kernel_version dev_base_head offset size =
        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 =
@@ -138,13 +151,15 @@ and do_next image kernel_version addr size =
          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
index cdd23a0..193e427 100644 (file)
@@ -22,5 +22,5 @@ val find_net_devices : bool ->
   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. *)
index c16e660..c2ae54e 100644 (file)
@@ -25,6 +25,8 @@ open Virt_mem_types
 
 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
@@ -49,26 +51,40 @@ supported Linux distribution, see this page about adding support:
          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
   )
index f6d6f94..13764bf 100644 (file)
@@ -22,5 +22,5 @@ val find_tasks : bool ->
   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. *)
index f8d3f0f..556a3c7 100644 (file)
@@ -41,19 +41,33 @@ type image = {
 }
 
 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
index 2d6e9ee..9792f03 100644 (file)
@@ -46,7 +46,7 @@ end
 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. *)
@@ -59,38 +59,66 @@ type image = {
 }
   (** 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.
@@ -104,7 +132,7 @@ type fieldsig = {
 }
   (** 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] *)
index 6a725f5..e766da4 100644 (file)
@@ -37,12 +37,12 @@ let parse_utsname bits =
       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
index 5c53dbf..fe538a9 100644 (file)
@@ -25,41 +25,18 @@ open Virt_mem_types
 
 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"
@@ -68,5 +45,4 @@ virt-ps prints a process listing for virtual machines running under
 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
index d90974d..4b38d4c 100644 (file)
@@ -28,8 +28,8 @@ let run debug { domname = domname } { utsname = utsname } =
   | 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