virt-ifconfig working again

diff --git a/extract/codegen/code_generation.ml b/extract/codegen/code_generation.ml
index d451349..b465e4b 100644 (file)
--- a/extract/codegen/code_generation.ml
+++ b/extract/codegen/code_generation.ml
@@ -531,12 +531,21 @@ let generate_followers names xs =
              match typ with
              | PP.FListHeadPointer _ ->
                  <:expr<
-                   (* For list head pointers, add the address of the base
+                   if debug then
+                     eprintf "%s_follower: %s: list_head pointing at a %s\n"
+                       $str:struct_name$ $str:name$ $str:dest_struct_name$;
+
+                   (* For list head pointers, add the address of the base
                     * of this virtual structure to the map, then adjust
                     * the pointer.
                     *)
                    let offset = data.$lid:struct_name^"_"^name^"_offset"$
                    and adj = data.$lid:struct_name^"_"^name^"_adjustment"$ in
+
+                   if debug then
+                     eprintf "%s_follower: %s: offset=%d adjustment=%d\n"
+                       $str:struct_name$ $str:name$ offset adj;
+
                    let offset = Int64.of_int offset
                    and adj = Int64.of_int adj in
 
@@ -555,17 +564,27 @@ let generate_followers names xs =
                     * adjustment applied.
                     *)
                    let dest_addr = Int64.sub dest_addr adj in
+
+                   if debug then
+                     eprintf "%s_follower: %s: dest_addr=%Lx\n"
+                       $str:struct_name$ $str:name$ dest_addr;
+
                    let map =
                      $lid:dest_struct_name^"_follower"$
-                       kernel_version load map dest_addr in
+                       debug kernel_version load map dest_addr in
                    map
                  >>
 
              | PP.FStructPointer _ ->
                  <:expr<
+                   if debug then
+                     eprintf "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx\n"
+                       $str:struct_name$ $str:name$
+                       $str:dest_struct_name$ dest_addr;
+
                    let map =
                      $lid:dest_struct_name^"_follower"$
-                       kernel_version load map dest_addr in
+                       debug kernel_version load map dest_addr in
                    map
                  >>
 
@@ -591,7 +610,9 @@ let generate_followers names xs =
       let struct_name_uc = String.capitalize struct_name in
 
       <:binding<
-       $lid:struct_name^"_follower"$ kernel_version load map addr =
+       $lid:struct_name^"_follower"$ debug kernel_version load map addr =
+         if debug then
+           eprintf "%s_follower: addr = %Lx\n" $str:struct_name$ addr;
           if addr <> 0L && not (AddrMap.mem addr map) then (
            let parser_ = $lid:"parser_of_"^struct_name$ kernel_version in
            let total_size = $lid:"size_of_"^struct_name$ kernel_version in
@@ -614,7 +635,7 @@ let generate_followers names xs =
     fun (struct_name, _) ->
       <:sig_item<
         val $lid:struct_name^"_follower"$ :
-         kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr ->
+         bool -> kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr ->
          addrmap
       >>
   ) xs in

diff --git a/ifconfig/.depend b/ifconfig/.depend
index 9a29dc0..6c45907 100644 (file)
--- a/ifconfig/.depend
+++ b/ifconfig/.depend
@@ -1,4 +1,4 @@
 virt_ifconfig.cmo: ../lib/virt_mem_utils.cmo ../lib/virt_mem_types.cmi \
-    ../lib/virt_mem_gettext.cmo 
+    ../lib/virt_mem_gettext.cmo ../lib/virt_mem.cmi ../lib/kernel.cmi 
 virt_ifconfig.cmx: ../lib/virt_mem_utils.cmx ../lib/virt_mem_types.cmx \
-    ../lib/virt_mem_gettext.cmx 
+    ../lib/virt_mem_gettext.cmx ../lib/virt_mem.cmx ../lib/kernel.cmx 

diff --git a/ifconfig/virt_ifconfig.ml b/ifconfig/virt_ifconfig.ml
index b423fe3..1d73bc0 100644 (file)
--- a/ifconfig/virt_ifconfig.ml
+++ b/ifconfig/virt_ifconfig.ml
@@ -23,21 +23,107 @@ open Virt_mem_gettext.Gettext
 open Virt_mem_utils
 open Virt_mem_types
 
-(*
-open Kernel_task_struct
+open Kernel
 
-let run debug { domname = domname; mem = mem } { net_devices = net_devices } =
-  let net_devices = Option.get net_devices in
+let run debug { addrmap = addrmap } =
+  (* Get all net_devices.  When people really start to use network
+   * namespaces, we'll need to divide these by namespace (ie. using
+   * struct net). XXX
+   *)
+  let net_devices = AddrMap.fold (
+    fun _ v devs ->
+      match v with
+      | _, Some (_, _, Net_device dev) -> dev :: devs
+      | _ -> devs
+  ) addrmap [] in
 
-  (* Sort by device name. *)
-  let cmp { netdev_name = n1 } { netdev_name = n2 } = compare n1 n2 in
+  let net_devices = List.map (
+    fun ({ net_device_name = name } as dev) ->
+      { dev with net_device_name = truncate_c_string name }
+  ) net_devices in
+(*
+  If you want to sort by name ...
+  let cmp { net_device_name = n1 } { net_device_name = n2 } = compare n1 n2 in
   let net_devices = List.sort cmp net_devices in
+*)
+
+  (* Get the IPv4 and IPv6 addresses. *)
+  let net_devices = List.map (
+    fun ({ net_device_ip_ptr = ip4 (* pointer to in_device *);
+          net_device_ip6_ptr = ip6 (* pointer to inet6_dev *) } as dev) ->
+      let ip4 =
+       match AddrMap.find ip4 addrmap with
+       | _, Some (_, _, In_device d) ->
+           d.in_device_ifa_list (* pointer to in_ifaddr *)
+       | _ -> assert false in
+      let ip4addrs =
+       let rec loop addr =
+         if addr <> 0L then (
+           let ifaddr =
+             match AddrMap.find addr addrmap with
+             | _, Some (_, _, In_ifaddr d) -> d
+             | _ -> assert false in
+           (ifaddr.in_ifaddr_ifa_address,
+            ifaddr.in_ifaddr_ifa_broadcast,
+            ifaddr.in_ifaddr_ifa_local,
+            ifaddr.in_ifaddr_ifa_mask)
+           :: loop ifaddr.in_ifaddr_ifa_next
+         ) else []
+       in
+       loop ip4 in
+      let ip6 =
+       match AddrMap.find ip6 addrmap with
+       | _, Some (_, _, Inet6_dev d) ->
+           d.inet6_dev_addr_list (* pointer to inet6_ifaddr *)
+       | _ -> assert false in
+      let ip6addrs =
+       let rec loop addr =
+         if addr <> 0L then (
+           let ifaddr =
+             match AddrMap.find addr addrmap with
+             | _, Some (_, _, Inet6_ifaddr d) -> d
+             | _ -> assert false in
+           ifaddr.inet6_ifaddr_prefix_len
+           :: loop ifaddr.inet6_ifaddr_lst_next
+         ) else []
+       in
+       loop ip6 in
+
+      dev, ip4addrs, ip6addrs
+  ) net_devices in
+
+  (* Print out the interfaces and addresses. *)
+  printf
+    "NAME MTU   ADDR             BROADCAST        LOCAL            NETMASK\n";
 
   List.iter (
-    fun netdev ->
-      printf "%5s mtu %Ld\n"
-       netdev.netdev_name
-       netdev.netdev_mtu
+    fun (dev, ip4addrs, ip6addrs) ->
+      printf "%-5s%-6Ld" dev.net_device_name dev.net_device_mtu;
+
+      let rec loop = function
+       | [] -> ()
+       | [addr] -> print addr
+       | addr :: addrs -> print addr; printf "\n           "; loop addrs
+
+      and print (addr, broadcast, local, mask) =
+       printf "%-16s %-16s %-16s %-16s"
+         (string_of_ipv4 addr)
+         (string_of_ipv4 broadcast)
+         (string_of_ipv4 local)
+         (string_of_ipv4 mask)
+
+      and string_of_ipv4 addr =
+       (* Always stored big-endian, even in a little endian kernel: *)
+       let d = Int64.shift_right_logical (Int64.logand addr 0xff000000L) 24
+       and c = Int64.shift_right_logical (Int64.logand addr 0x00ff0000L) 16
+       and b = Int64.shift_right_logical (Int64.logand addr 0x0000ff00L) 8
+       and a =                            Int64.logand addr 0x000000ffL in
+       sprintf "%Ld.%Ld.%Ld.%Ld" a b c d
+      in
+      loop ip4addrs;
+      printf "\n";
+
+      (* XXX ip6addrs too *)
   ) net_devices
 
 let summary = s_"list network interfaces in virtual machine"
@@ -47,4 +133,3 @@ virt-ifconfig prints a network interfaces for virtual machines.
 
 let () =
   Virt_mem.register "ifconfig" summary description ~needs_net_devices:true ~run
-*)

diff --git a/lib/kernel.ml b/lib/kernel.ml
index 9b7d3bc..2ad7a68 100644 (file)
--- a/lib/kernel.ml
+++ b/lib/kernel.ml
@@ -1238,184 +1238,369 @@ let parser_of_inet6_ifaddr =
       try StringMap.find kernel_version map
       with
       | Not_found -> unknown_kernel_version kernel_version "inet6_ifaddr";;
-let rec task_struct_follower kernel_version load map addr =
-  if (addr <> 0L) && (not (AddrMap.mem addr map))
-  then
-    (let parser_ = parser_of_task_struct kernel_version in
-     let total_size = size_of_task_struct kernel_version in
-     let bits = load "task_struct" addr total_size in
-     let data = parser_ kernel_version bits in
-     let map =
-       AddrMap.add addr
-         ("task_struct", (Some (total_size, bits, Task_struct data))) map in
-     let map =
-       match data.task_struct_run_list'next with
-       | None -> map
-       | Some dest_addr ->
-           let offset = data.task_struct_run_list'next_offset
-           and adj = data.task_struct_run_list'next_adjustment in
-           let offset = Int64.of_int offset and adj = Int64.of_int adj in
-           let map =
-             if offset <> adj
+let rec task_struct_follower debug kernel_version load map addr =
+  (if debug
+   then eprintf "%s_follower: addr = %Lx
+" "task_struct" addr
+   else ();
+   if (addr <> 0L) && (not (AddrMap.mem addr map))
+   then
+     (let parser_ = parser_of_task_struct kernel_version in
+      let total_size = size_of_task_struct kernel_version in
+      let bits = load "task_struct" addr total_size in
+      let data = parser_ kernel_version bits in
+      let map =
+        AddrMap.add addr
+          ("task_struct", (Some (total_size, bits, Task_struct data))) map in
+      let map =
+        match data.task_struct_run_list'next with
+        | None -> map
+        | Some dest_addr ->
+            (if debug
              then
-               (let addr = Int64.sub (Int64.add addr offset) adj
-                in AddrMap.add addr ("task_struct", None) map)
-             else map in
-           let dest_addr = Int64.sub dest_addr adj in
-           let map = task_struct_follower kernel_version load map dest_addr
-           in map in
-     let dest_addr = data.task_struct_tasks'next in
-     let map =
-       let offset = data.task_struct_tasks'next_offset
-       and adj = data.task_struct_tasks'next_adjustment in
-       let offset = Int64.of_int offset and adj = Int64.of_int adj in
-       let map =
-         if offset <> adj
+               eprintf "%s_follower: %s: list_head pointing at a %s
+"
+                 "task_struct" "run_list'next" "task_struct"
+             else ();
+             let offset = data.task_struct_run_list'next_offset
+             and adj = data.task_struct_run_list'next_adjustment
+             in
+               (if debug
+                then
+                  eprintf "%s_follower: %s: offset=%d adjustment=%d
+"
+                    "task_struct" "run_list'next" offset adj
+                else ();
+                let offset = Int64.of_int offset
+                and adj = Int64.of_int adj in
+                let map =
+                  if offset <> adj
+                  then
+                    (let addr = Int64.sub (Int64.add addr offset) adj
+                     in AddrMap.add addr ("task_struct", None) map)
+                  else map in
+                let dest_addr = Int64.sub dest_addr adj
+                in
+                  (if debug
+                   then
+                     eprintf "%s_follower: %s: dest_addr=%Lx
+" "task_struct"
+                       "run_list'next" dest_addr
+                   else ();
+                   let map =
+                     task_struct_follower debug kernel_version load map
+                       dest_addr
+                   in map))) in
+      let dest_addr = data.task_struct_tasks'next in
+      let map =
+        (if debug
+         then
+           eprintf "%s_follower: %s: list_head pointing at a %s
+"
+             "task_struct" "tasks'next" "task_struct"
+         else ();
+         let offset = data.task_struct_tasks'next_offset
+         and adj = data.task_struct_tasks'next_adjustment
+         in
+           (if debug
+            then
+              eprintf "%s_follower: %s: offset=%d adjustment=%d
+"
+                "task_struct" "tasks'next" offset adj
+            else ();
+            let offset = Int64.of_int offset and adj = Int64.of_int adj in
+            let map =
+              if offset <> adj
+              then
+                (let addr = Int64.sub (Int64.add addr offset) adj
+                 in AddrMap.add addr ("task_struct", None) map)
+              else map in
+            let dest_addr = Int64.sub dest_addr adj
+            in
+              (if debug
+               then
+                 eprintf "%s_follower: %s: dest_addr=%Lx
+" "task_struct"
+                   "tasks'next" dest_addr
+               else ();
+               let map =
+                 task_struct_follower debug kernel_version load map dest_addr
+               in map)))
+      in map)
+   else map)
+and net_device_follower debug kernel_version load map addr =
+  (if debug then eprintf "%s_follower: addr = %Lx
+" "net_device" addr else ();
+   if (addr <> 0L) && (not (AddrMap.mem addr map))
+   then
+     (let parser_ = parser_of_net_device kernel_version in
+      let total_size = size_of_net_device kernel_version in
+      let bits = load "net_device" addr total_size in
+      let data = parser_ kernel_version bits in
+      let map =
+        AddrMap.add addr
+          ("net_device", (Some (total_size, bits, Net_device data))) map in
+      let map =
+        match data.net_device_dev_list'next with
+        | None -> map
+        | Some dest_addr ->
+            (if debug
+             then
+               eprintf "%s_follower: %s: list_head pointing at a %s
+"
+                 "net_device" "dev_list'next" "net_device"
+             else ();
+             let offset = data.net_device_dev_list'next_offset
+             and adj = data.net_device_dev_list'next_adjustment
+             in
+               (if debug
+                then
+                  eprintf "%s_follower: %s: offset=%d adjustment=%d
+"
+                    "net_device" "dev_list'next" offset adj
+                else ();
+                let offset = Int64.of_int offset
+                and adj = Int64.of_int adj in
+                let map =
+                  if offset <> adj
+                  then
+                    (let addr = Int64.sub (Int64.add addr offset) adj
+                     in AddrMap.add addr ("net_device", None) map)
+                  else map in
+                let dest_addr = Int64.sub dest_addr adj
+                in
+                  (if debug
+                   then
+                     eprintf "%s_follower: %s: dest_addr=%Lx
+" "net_device"
+                       "dev_list'next" dest_addr
+                   else ();
+                   let map =
+                     net_device_follower debug kernel_version load map
+                       dest_addr
+                   in map))) in
+      let dest_addr = data.net_device_ip6_ptr in
+      let map =
+        (if debug
+         then
+           eprintf
+             "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx
+"
+             "net_device" "ip6_ptr" "inet6_dev" dest_addr
+         else ();
+         let map = inet6_dev_follower debug kernel_version load map dest_addr
+         in map) in
+      let dest_addr = data.net_device_ip_ptr in
+      let map =
+        (if debug
          then
-           (let addr = Int64.sub (Int64.add addr offset) adj
-            in AddrMap.add addr ("task_struct", None) map)
-         else map in
-       let dest_addr = Int64.sub dest_addr adj in
-       let map = task_struct_follower kernel_version load map dest_addr
-       in map
-     in map)
-  else map
-and net_device_follower kernel_version load map addr =
-  if (addr <> 0L) && (not (AddrMap.mem addr map))
-  then
-    (let parser_ = parser_of_net_device kernel_version in
-     let total_size = size_of_net_device kernel_version in
-     let bits = load "net_device" addr total_size in
-     let data = parser_ kernel_version bits in
-     let map =
-       AddrMap.add addr
-         ("net_device", (Some (total_size, bits, Net_device data))) map in
-     let map =
-       match data.net_device_dev_list'next with
-       | None -> map
-       | Some dest_addr ->
-           let offset = data.net_device_dev_list'next_offset
-           and adj = data.net_device_dev_list'next_adjustment in
-           let offset = Int64.of_int offset and adj = Int64.of_int adj in
-           let map =
-             if offset <> adj
+           eprintf
+             "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx
+"
+             "net_device" "ip_ptr" "in_device" dest_addr
+         else ();
+         let map = in_device_follower debug kernel_version load map dest_addr
+         in map) in
+      let map =
+        match data.net_device_next with
+        | None -> map
+        | Some dest_addr ->
+            (if debug
              then
-               (let addr = Int64.sub (Int64.add addr offset) adj
-                in AddrMap.add addr ("net_device", None) map)
-             else map in
-           let dest_addr = Int64.sub dest_addr adj in
-           let map = net_device_follower kernel_version load map dest_addr
-           in map in
-     let dest_addr = data.net_device_ip6_ptr in
-     let map =
-       let map = inet6_dev_follower kernel_version load map dest_addr in map in
-     let dest_addr = data.net_device_ip_ptr in
-     let map =
-       let map = in_device_follower kernel_version load map dest_addr in map in
-     let map =
-       match data.net_device_next with
-       | None -> map
-       | Some dest_addr ->
-           let map = net_device_follower kernel_version load map dest_addr
-           in map
-     in map)
-  else map
-and net_follower kernel_version load map addr =
-  if (addr <> 0L) && (not (AddrMap.mem addr map))
-  then
-    (let parser_ = parser_of_net kernel_version in
-     let total_size = size_of_net kernel_version in
-     let bits = load "net" addr total_size in
-     let data = parser_ kernel_version bits in
-     let map =
-       AddrMap.add addr ("net", (Some (total_size, bits, Net data))) map in
-     let dest_addr = data.net_dev_base_head'next in
-     let map =
-       let offset = data.net_dev_base_head'next_offset
-       and adj = data.net_dev_base_head'next_adjustment in
-       let offset = Int64.of_int offset and adj = Int64.of_int adj in
-       let map =
-         if offset <> adj
+               eprintf
+                 "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx
+"
+                 "net_device" "next" "net_device" dest_addr
+             else ();
+             let map =
+               net_device_follower debug kernel_version load map dest_addr
+             in map)
+      in map)
+   else map)
+and net_follower debug kernel_version load map addr =
+  (if debug then eprintf "%s_follower: addr = %Lx
+" "net" addr else ();
+   if (addr <> 0L) && (not (AddrMap.mem addr map))
+   then
+     (let parser_ = parser_of_net kernel_version in
+      let total_size = size_of_net kernel_version in
+      let bits = load "net" addr total_size in
+      let data = parser_ kernel_version bits in
+      let map =
+        AddrMap.add addr ("net", (Some (total_size, bits, Net data))) map in
+      let dest_addr = data.net_dev_base_head'next in
+      let map =
+        (if debug
+         then
+           eprintf "%s_follower: %s: list_head pointing at a %s
+" "net"
+             "dev_base_head'next" "net_device"
+         else ();
+         let offset = data.net_dev_base_head'next_offset
+         and adj = data.net_dev_base_head'next_adjustment
+         in
+           (if debug
+            then
+              eprintf "%s_follower: %s: offset=%d adjustment=%d
+" "net"
+                "dev_base_head'next" offset adj
+            else ();
+            let offset = Int64.of_int offset and adj = Int64.of_int adj in
+            let map =
+              if offset <> adj
+              then
+                (let addr = Int64.sub (Int64.add addr offset) adj
+                 in AddrMap.add addr ("net_device", None) map)
+              else map in
+            let dest_addr = Int64.sub dest_addr adj
+            in
+              (if debug
+               then
+                 eprintf "%s_follower: %s: dest_addr=%Lx
+" "net"
+                   "dev_base_head'next" dest_addr
+               else ();
+               let map =
+                 net_device_follower debug kernel_version load map dest_addr
+               in map))) in
+      let dest_addr = data.net_dev_base_head'prev in
+      let map =
+        (if debug
+         then
+           eprintf "%s_follower: %s: list_head pointing at a %s
+" "net"
+             "dev_base_head'prev" "net_device"
+         else ();
+         let offset = data.net_dev_base_head'prev_offset
+         and adj = data.net_dev_base_head'prev_adjustment
+         in
+           (if debug
+            then
+              eprintf "%s_follower: %s: offset=%d adjustment=%d
+" "net"
+                "dev_base_head'prev" offset adj
+            else ();
+            let offset = Int64.of_int offset and adj = Int64.of_int adj in
+            let map =
+              if offset <> adj
+              then
+                (let addr = Int64.sub (Int64.add addr offset) adj
+                 in AddrMap.add addr ("net_device", None) map)
+              else map in
+            let dest_addr = Int64.sub dest_addr adj
+            in
+              (if debug
+               then
+                 eprintf "%s_follower: %s: dest_addr=%Lx
+" "net"
+                   "dev_base_head'prev" dest_addr
+               else ();
+               let map =
+                 net_device_follower debug kernel_version load map dest_addr
+               in map)))
+      in map)
+   else map)
+and in_device_follower debug kernel_version load map addr =
+  (if debug then eprintf "%s_follower: addr = %Lx
+" "in_device" addr else ();
+   if (addr <> 0L) && (not (AddrMap.mem addr map))
+   then
+     (let parser_ = parser_of_in_device kernel_version in
+      let total_size = size_of_in_device kernel_version in
+      let bits = load "in_device" addr total_size in
+      let data = parser_ kernel_version bits in
+      let map =
+        AddrMap.add addr
+          ("in_device", (Some (total_size, bits, In_device data))) map in
+      let dest_addr = data.in_device_ifa_list in
+      let map =
+        (if debug
+         then
+           eprintf
+             "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx
+"
+             "in_device" "ifa_list" "in_ifaddr" dest_addr
+         else ();
+         let map = in_ifaddr_follower debug kernel_version load map dest_addr
+         in map)
+      in map)
+   else map)
+and inet6_dev_follower debug kernel_version load map addr =
+  (if debug then eprintf "%s_follower: addr = %Lx
+" "inet6_dev" addr else ();
+   if (addr <> 0L) && (not (AddrMap.mem addr map))
+   then
+     (let parser_ = parser_of_inet6_dev kernel_version in
+      let total_size = size_of_inet6_dev kernel_version in
+      let bits = load "inet6_dev" addr total_size in
+      let data = parser_ kernel_version bits in
+      let map =
+        AddrMap.add addr
+          ("inet6_dev", (Some (total_size, bits, Inet6_dev data))) map in
+      let dest_addr = data.inet6_dev_addr_list in
+      let map =
+        (if debug
          then
-           (let addr = Int64.sub (Int64.add addr offset) adj
-            in AddrMap.add addr ("net_device", None) map)
-         else map in
-       let dest_addr = Int64.sub dest_addr adj in
-       let map = net_device_follower kernel_version load map dest_addr in map in
-     let dest_addr = data.net_dev_base_head'prev in
-     let map =
-       let offset = data.net_dev_base_head'prev_offset
-       and adj = data.net_dev_base_head'prev_adjustment in
-       let offset = Int64.of_int offset and adj = Int64.of_int adj in
-       let map =
-         if offset <> adj
+           eprintf
+             "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx
+"
+             "inet6_dev" "addr_list" "inet6_ifaddr" dest_addr
+         else ();
+         let map =
+           inet6_ifaddr_follower debug kernel_version load map dest_addr
+         in map)
+      in map)
+   else map)
+and in_ifaddr_follower debug kernel_version load map addr =
+  (if debug then eprintf "%s_follower: addr = %Lx
+" "in_ifaddr" addr else ();
+   if (addr <> 0L) && (not (AddrMap.mem addr map))
+   then
+     (let parser_ = parser_of_in_ifaddr kernel_version in
+      let total_size = size_of_in_ifaddr kernel_version in
+      let bits = load "in_ifaddr" addr total_size in
+      let data = parser_ kernel_version bits in
+      let map =
+        AddrMap.add addr
+          ("in_ifaddr", (Some (total_size, bits, In_ifaddr data))) map in
+      let dest_addr = data.in_ifaddr_ifa_next in
+      let map =
+        (if debug
          then
-           (let addr = Int64.sub (Int64.add addr offset) adj
-            in AddrMap.add addr ("net_device", None) map)
-         else map in
-       let dest_addr = Int64.sub dest_addr adj in
-       let map = net_device_follower kernel_version load map dest_addr in map
-     in map)
-  else map
-and in_device_follower kernel_version load map addr =
-  if (addr <> 0L) && (not (AddrMap.mem addr map))
-  then
-    (let parser_ = parser_of_in_device kernel_version in
-     let total_size = size_of_in_device kernel_version in
-     let bits = load "in_device" addr total_size in
-     let data = parser_ kernel_version bits in
-     let map =
-       AddrMap.add addr
-         ("in_device", (Some (total_size, bits, In_device data))) map in
-     let dest_addr = data.in_device_ifa_list in
-     let map =
-       let map = in_ifaddr_follower kernel_version load map dest_addr in map
-     in map)
-  else map
-and inet6_dev_follower kernel_version load map addr =
-  if (addr <> 0L) && (not (AddrMap.mem addr map))
-  then
-    (let parser_ = parser_of_inet6_dev kernel_version in
-     let total_size = size_of_inet6_dev kernel_version in
-     let bits = load "inet6_dev" addr total_size in
-     let data = parser_ kernel_version bits in
-     let map =
-       AddrMap.add addr
-         ("inet6_dev", (Some (total_size, bits, Inet6_dev data))) map in
-     let dest_addr = data.inet6_dev_addr_list in
-     let map =
-       let map = inet6_ifaddr_follower kernel_version load map dest_addr
-       in map
-     in map)
-  else map
-and in_ifaddr_follower kernel_version load map addr =
-  if (addr <> 0L) && (not (AddrMap.mem addr map))
-  then
-    (let parser_ = parser_of_in_ifaddr kernel_version in
-     let total_size = size_of_in_ifaddr kernel_version in
-     let bits = load "in_ifaddr" addr total_size in
-     let data = parser_ kernel_version bits in
-     let map =
-       AddrMap.add addr
-         ("in_ifaddr", (Some (total_size, bits, In_ifaddr data))) map in
-     let dest_addr = data.in_ifaddr_ifa_next in
-     let map =
-       let map = in_ifaddr_follower kernel_version load map dest_addr in map
-     in map)
-  else map
-and inet6_ifaddr_follower kernel_version load map addr =
-  if (addr <> 0L) && (not (AddrMap.mem addr map))
-  then
-    (let parser_ = parser_of_inet6_ifaddr kernel_version in
-     let total_size = size_of_inet6_ifaddr kernel_version in
-     let bits = load "inet6_ifaddr" addr total_size in
-     let data = parser_ kernel_version bits in
-     let map =
-       AddrMap.add addr
-         ("inet6_ifaddr", (Some (total_size, bits, Inet6_ifaddr data))) map in
-     let dest_addr = data.inet6_ifaddr_lst_next in
-     let map =
-       let map = inet6_ifaddr_follower kernel_version load map dest_addr
-       in map
-     in map)
-  else map;;
+           eprintf
+             "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx
+"
+             "in_ifaddr" "ifa_next" "in_ifaddr" dest_addr
+         else ();
+         let map = in_ifaddr_follower debug kernel_version load map dest_addr
+         in map)
+      in map)
+   else map)
+and inet6_ifaddr_follower debug kernel_version load map addr =
+  (if debug
+   then eprintf "%s_follower: addr = %Lx
+" "inet6_ifaddr" addr
+   else ();
+   if (addr <> 0L) && (not (AddrMap.mem addr map))
+   then
+     (let parser_ = parser_of_inet6_ifaddr kernel_version in
+      let total_size = size_of_inet6_ifaddr kernel_version in
+      let bits = load "inet6_ifaddr" addr total_size in
+      let data = parser_ kernel_version bits in
+      let map =
+        AddrMap.add addr
+          ("inet6_ifaddr", (Some (total_size, bits, Inet6_ifaddr data))) map in
+      let dest_addr = data.inet6_ifaddr_lst_next in
+      let map =
+        (if debug
+         then
+           eprintf
+             "%s_follower: %s: is a struct pointer pointing to a %s; dest_addr=%Lx
+"
+             "inet6_ifaddr" "lst_next" "inet6_ifaddr" dest_addr
+         else ();
+         let map =
+           inet6_ifaddr_follower debug kernel_version load map dest_addr
+         in map)
+      in map)
+   else map);;

diff --git a/lib/kernel.mli b/lib/kernel.mli
index e4f4148..6cc21a1 100644 (file)
--- a/lib/kernel.mli
+++ b/lib/kernel.mli
@@ -75,16 +75,23 @@ type addrmap =
 
 
 val task_struct_follower :
-  kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
+  bool ->
+    kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
 val net_device_follower :
-  kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
+  bool ->
+    kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
 val net_follower :
-  kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
+  bool ->
+    kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
 val in_device_follower :
-  kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
+  bool ->
+    kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
 val inet6_dev_follower :
-  kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
+  bool ->
+    kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
 val in_ifaddr_follower :
-  kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
+  bool ->
+    kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
 val inet6_ifaddr_follower :
-  kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;
+  bool ->
+    kernel_version -> load_fn -> addrmap -> Virt_mem_mmap.addr -> addrmap;;

diff --git a/lib/virt_mem.ml b/lib/virt_mem.ml
index a65d95e..fd99b86 100644 (file)
--- a/lib/virt_mem.ml
+++ b/lib/virt_mem.ml
@@ -567,7 +567,7 @@ Possibly the '-T' command line parameter was used inconsistently.");
                let addrmap =
                  try
                    let init_task = Ksymmap.find "init_task" ksyms in
-                   Some (Kernel.task_struct_follower kernel_version
+                   Some (Kernel.task_struct_follower debug kernel_version
                            load addrmap init_task)
                  with
                    Not_found ->
@@ -603,7 +603,7 @@ Possibly the '-T' command line parameter was used inconsistently.");
                let addrmap =
                  try
                    let dev_base = Ksymmap.find "dev_base" ksyms in
-                   Some (Kernel.net_device_follower kernel_version
+                   Some (Kernel.net_device_follower debug kernel_version
                            load addrmap dev_base)
                  with Not_found ->
                    try
@@ -613,7 +613,7 @@ Possibly the '-T' command line parameter was used inconsistently.");
                    with Not_found ->
                      try
                        let init_net = Ksymmap.find "init_net" ksyms in
-                       Some (Kernel.net_follower kernel_version
+                       Some (Kernel.net_follower debug kernel_version
                                load addrmap init_net)
                      with Not_found ->
                        eprintf (f_"%s: cannot find dev_base, dev_base_head or init_net symbols in kernel image.\n") !kimage.domname;