Get rid of lookup_ksym function, replace with a map.
authorRichard W.M. Jones <rjones@redhat.com>
Wed, 23 Jul 2008 17:18:21 +0000 (18:18 +0100)
committerRichard W.M. Jones <rjones@redhat.com>
Wed, 23 Jul 2008 17:18:21 +0000 (18:18 +0100)
16 files changed:
MANIFEST
Makefile.in
dmesg/.depend
dmesg/virt_dmesg.ml
lib/.depend
lib/virt_mem.ml
lib/virt_mem_capture.ml
lib/virt_mem_kallsyms.ml
lib/virt_mem_ksyms.ml
lib/virt_mem_types.ml
lib/virt_mem_types.mli [new file with mode: 0644]
lib/virt_mem_utsname.ml
ps/.depend
ps/virt_ps.ml
uname/.depend
uname/virt_uname.ml

index 4066521..c9177b3 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -21,6 +21,7 @@ lib/virt_mem_mmap.ml
 lib/virt_mem_mmap.mli
 lib/virt_mem_mmap_c.c
 lib/virt_mem_types.ml
 lib/virt_mem_mmap.mli
 lib/virt_mem_mmap_c.c
 lib/virt_mem_types.ml
+lib/virt_mem_types.mli
 lib/virt_mem_utils.ml
 lib/virt_mem_utsname.ml
 lib/virt_mem_utsname.mli
 lib/virt_mem_utils.ml
 lib/virt_mem_utsname.ml
 lib/virt_mem_utsname.mli
index 02cb91c..4fcf694 100644 (file)
@@ -24,11 +24,11 @@ MKDIR_P             = @MKDIR_P@
 datarootdir    = @datarootdir@
 mandir         = @mandir@
 
 datarootdir    = @datarootdir@
 mandir         = @mandir@
 
-OCAMLDOCFLAGS  = -html -sort -package bitstring,extlib -I lib
+OCAMLDOCFLAGS  = -html -sort -package bitstring,extlib,libvirt -I lib
 OCAMLDOC       = @OCAMLDOC@
 OCAMLDOCFILES  = lib/virt_mem_utils.ml \
                  lib/virt_mem_mmap.mli \
 OCAMLDOC       = @OCAMLDOC@
 OCAMLDOCFILES  = lib/virt_mem_utils.ml \
                  lib/virt_mem_mmap.mli \
-                 lib/virt_mem_types.ml \
+                 lib/virt_mem_types.mli \
                  lib/virt_mem_ksyms.mli \
                  lib/virt_mem_kallsyms.mli \
                  lib/virt_mem_utsname.mli \
                  lib/virt_mem_ksyms.mli \
                  lib/virt_mem_kallsyms.mli \
                  lib/virt_mem_utsname.mli \
index 89da6ef..8cbdd64 100644 (file)
@@ -1,4 +1,4 @@
-virt_dmesg.cmo: ../lib/virt_mem_utils.cmo ../lib/virt_mem_types.cmo \
+virt_dmesg.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 
 virt_dmesg.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_mmap.cmi ../lib/virt_mem_gettext.cmo ../lib/virt_mem.cmi 
 virt_dmesg.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 
index 1886a92..73a671b 100644 (file)
@@ -24,23 +24,23 @@ open Virt_mem_utils
 open Virt_mem_types
 open Virt_mem_mmap
 
 open Virt_mem_types
 open Virt_mem_mmap
 
-let run debug (_, name, arch, mem, lookup_ksym, _) =
+let run debug ({ domname = domname; mem = mem }, ksymmap, _) =
   try
     (* I don't know why but this symbol doesn't exist in 2.6.9
      * even in kallsyms.  Hence this won't work with that kernel.
      * It's possible we can fall back to memory scanning. XXX
      *)
   try
     (* I don't know why but this symbol doesn't exist in 2.6.9
      * even in kallsyms.  Hence this won't work with that kernel.
      * It's possible we can fall back to memory scanning. XXX
      *)
-    let log_buf = lookup_ksym "log_buf" in
+    let log_buf = Ksymmap.find "log_buf" ksymmap in
     let log_buf = follow_pointer mem log_buf in
     let log_buf = follow_pointer mem log_buf in
-    let log_buf_len = lookup_ksym "log_buf_len" in
+    let log_buf_len = Ksymmap.find "log_buf_len" ksymmap in
     let log_buf_len = Int64.of_int32 (get_C_int mem log_buf_len) in
     let log_buf_len = Int64.of_int32 (get_C_int mem log_buf_len) in
-    (* let log_start = lookup_ksym "log_start" in
+    (* let log_start = Ksymmap.find "log_start" ksymmap in
        let log_start = get_C_long mem log_start in *)
        let log_start = get_C_long mem log_start in *)
-    let log_end = lookup_ksym "log_end" in
+    let log_end = Ksymmap.find "log_end" ksymmap in
     let log_end = get_C_long mem log_end in
     let log_end = get_C_long mem log_end in
-    (* let con_start = lookup_ksym "con_start" in
+    (* let con_start = Ksymmap.find "con_start" ksymmap in
        let con_start = get_C_long mem con_start in *)
        let con_start = get_C_long mem con_start in *)
-    let logged_chars = lookup_ksym "logged_chars" in
+    let logged_chars = Ksymmap.find "logged_chars" ksymmap in
     let logged_chars = get_C_long mem logged_chars in
 
     (* This is basically the same algorithm from printk.c:do_syslog
     let logged_chars = get_C_long mem logged_chars in
 
     (* This is basically the same algorithm from printk.c:do_syslog
@@ -70,7 +70,7 @@ let run debug (_, name, arch, mem, lookup_ksym, _) =
   with
     Not_found ->
       eprintf (f_"%s: could not find kernel log buffer in kernel image\n")
   with
     Not_found ->
       eprintf (f_"%s: could not find kernel log buffer in kernel image\n")
-       name
+       domname
 
 let summary = s_"display kernel messages"
 let description = s_"\
 
 let summary = s_"display kernel messages"
 let description = s_"\
index bb77a91..9d1784c 100644 (file)
@@ -1,33 +1,34 @@
-virt_mem_kallsyms.cmi: virt_mem_types.cmo 
-virt_mem_ksyms.cmi: virt_mem_types.cmo 
-virt_mem.cmi: virt_mem_types.cmo 
+virt_mem_kallsyms.cmi: virt_mem_types.cmi 
+virt_mem_ksyms.cmi: virt_mem_types.cmi 
+virt_mem.cmi: virt_mem_types.cmi 
 virt_mem_mmap.cmi: virt_mem_utils.cmo 
 virt_mem_mmap.cmi: virt_mem_utils.cmo 
-virt_mem_utsname.cmi: virt_mem_types.cmo 
+virt_mem_types.cmi: virt_mem_utils.cmo virt_mem_mmap.cmi 
+virt_mem_utsname.cmi: virt_mem_types.cmi 
 test_mmap.cmo: virt_mem_mmap.cmi 
 test_mmap.cmx: virt_mem_mmap.cmx 
 test_mmap.cmo: virt_mem_mmap.cmi 
 test_mmap.cmx: virt_mem_mmap.cmx 
-virt_mem_capture.cmo: virt_mem_gettext.cmo virt_mem.cmi 
-virt_mem_capture.cmx: virt_mem_gettext.cmx virt_mem.cmx 
-virt_mem_kallsyms.cmo: virt_mem_utils.cmo virt_mem_types.cmo \
+virt_mem_capture.cmo: virt_mem_types.cmi virt_mem_gettext.cmo virt_mem.cmi 
+virt_mem_capture.cmx: virt_mem_types.cmx virt_mem_gettext.cmx virt_mem.cmx 
+virt_mem_kallsyms.cmo: virt_mem_utils.cmo virt_mem_types.cmi \
     virt_mem_mmap.cmi virt_mem_ksyms.cmi virt_mem_gettext.cmo \
     virt_mem_kallsyms.cmi 
 virt_mem_kallsyms.cmx: virt_mem_utils.cmx virt_mem_types.cmx \
     virt_mem_mmap.cmx virt_mem_ksyms.cmx virt_mem_gettext.cmx \
     virt_mem_kallsyms.cmi 
     virt_mem_mmap.cmi virt_mem_ksyms.cmi virt_mem_gettext.cmo \
     virt_mem_kallsyms.cmi 
 virt_mem_kallsyms.cmx: virt_mem_utils.cmx virt_mem_types.cmx \
     virt_mem_mmap.cmx virt_mem_ksyms.cmx virt_mem_gettext.cmx \
     virt_mem_kallsyms.cmi 
-virt_mem_ksyms.cmo: virt_mem_utils.cmo virt_mem_types.cmo virt_mem_mmap.cmi \
+virt_mem_ksyms.cmo: virt_mem_utils.cmo virt_mem_types.cmi virt_mem_mmap.cmi \
     virt_mem_gettext.cmo virt_mem_ksyms.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_gettext.cmo virt_mem_ksyms.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.cmo virt_mem_mmap.cmi virt_mem_ksyms.cmi \
+    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.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_mmap.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi 
 virt_mem_mmap.cmx: virt_mem_utils.cmx virt_mem_mmap.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_mmap.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi 
 virt_mem_mmap.cmx: virt_mem_utils.cmx virt_mem_mmap.cmi 
-virt_mem_types.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi 
-virt_mem_types.cmx: virt_mem_utils.cmx virt_mem_mmap.cmx 
-virt_mem_utsname.cmo: virt_mem_utils.cmo virt_mem_types.cmo virt_mem_mmap.cmi \
+virt_mem_types.cmo: virt_mem_utils.cmo virt_mem_mmap.cmi virt_mem_types.cmi 
+virt_mem_types.cmx: virt_mem_utils.cmx virt_mem_mmap.cmx virt_mem_types.cmi 
+virt_mem_utsname.cmo: virt_mem_utils.cmo virt_mem_types.cmi virt_mem_mmap.cmi \
     virt_mem_gettext.cmo virt_mem_utsname.cmi 
 virt_mem_utsname.cmx: virt_mem_utils.cmx virt_mem_types.cmx virt_mem_mmap.cmx \
     virt_mem_gettext.cmx virt_mem_utsname.cmi 
     virt_mem_gettext.cmo virt_mem_utsname.cmi 
 virt_mem_utsname.cmx: virt_mem_utils.cmx virt_mem_types.cmx virt_mem_mmap.cmx \
     virt_mem_gettext.cmx virt_mem_utsname.cmi 
index 03b0d1e..9280a69 100644 (file)
@@ -350,22 +350,21 @@ Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
 
       List.map (
        fun (dom, _) ->
 
       List.map (
        fun (dom, _) ->
-         let id = D.get_id dom in
-         let name = D.get_name dom in
+         let domname = D.get_name dom in
 
          let wordsize =
            match !def_wordsize with
            | None ->
                failwith
                  (sprintf (f_"%s: use -W to define word size for this image")
 
          let wordsize =
            match !def_wordsize with
            | None ->
                failwith
                  (sprintf (f_"%s: use -W to define word size for this image")
-                    name);
+                    domname);
            | Some ws -> ws in
          let endian =
            match !def_endian with
            | None ->
                failwith
                  (sprintf (f_"%s: use -E to define endianness for this image")
            | Some ws -> ws in
          let endian =
            match !def_endian with
            | None ->
                failwith
                  (sprintf (f_"%s: use -E to define endianness for this image")
-                    name);
+                    domname);
            | Some e -> e in
 
          let arch =
            | Some e -> e in
 
          let arch =
@@ -373,11 +372,11 @@ Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
            | Some I386 -> I386 | Some X86_64 -> X86_64
            | _ ->
                failwith
            | Some I386 -> I386 | Some X86_64 -> X86_64
            | _ ->
                failwith
-                 (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") name) in
+                 (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") domname) in
 
          if !def_text_addr = 0L then
            failwith
 
          if !def_text_addr = 0L then
            failwith
-             (sprintf (f_"%s: use -T to define kernel load address for this image") name);
+             (sprintf (f_"%s: use -T to define kernel load address for this image") domname);
 
          let start_t = gettimeofday () in
 
 
          let start_t = gettimeofday () in
 
@@ -409,7 +408,7 @@ Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
          let mem = Virt_mem_mmap.set_wordsize mem wordsize in
          let mem = Virt_mem_mmap.set_endian mem endian in
 
          let mem = Virt_mem_mmap.set_wordsize mem wordsize in
          let mem = Virt_mem_mmap.set_endian mem endian in
 
-         ((Some id, name, arch, mem) : image0)
+         { dom = Some dom; domname = domname; mem = mem; arch = arch }
       ) xmls
     ) else (
       (* One or more -t options passed. *)
       ) xmls
     ) else (
       (* One or more -t options passed. *)
@@ -457,7 +456,7 @@ Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
          let mem = Virt_mem_mmap.set_wordsize mem wordsize in
          let mem = Virt_mem_mmap.set_endian mem endian in
 
          let mem = Virt_mem_mmap.set_wordsize mem wordsize in
          let mem = Virt_mem_mmap.set_endian mem endian in
 
-         ((None, filename, arch, mem) : image0)
+         { dom = None; domname = filename; mem = mem; arch = arch }
       ) testimages
     ) in
 
       ) testimages
     ) in
 
@@ -483,6 +482,7 @@ Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
        (* Look for kallsyms: *)
        let image = Virt_mem_kallsyms.find_kallsyms 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.
         *)
        (* Finally, just wrap the lookup_ksym call in something
         * which prints the query when debug is set.
         *)
@@ -501,6 +501,7 @@ Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
            (domid, name, arch, mem, lookup_ksym)
          else
            image in
            (domid, name, arch, mem, lookup_ksym)
          else
            image in
+*)
 
        image
     ) images in
 
        image
     ) images in
index 154f76d..0c1ff57 100644 (file)
@@ -22,6 +22,9 @@
 open Printf
 open ExtString
 
 open Printf
 open ExtString
 
+module D = Libvirt.Domain
+
+open Virt_mem_types
 open Virt_mem_gettext.Gettext
 
 (* This will contain what is passed by the user as '-o' option. *)
 open Virt_mem_gettext.Gettext
 
 (* This will contain what is passed by the user as '-o' option. *)
@@ -51,11 +54,11 @@ let rec beforeksyms debug = function
        * is the domain ID (if known) or a mangled domain name.
        *)
       List.iter (
        * is the domain ID (if known) or a mangled domain name.
        *)
       List.iter (
-       fun ((domid, domname, _, _) as image) ->
+       fun ({ dom = dom; domname = domname } as image) ->
          let filename =
            !output_filename ^ "." ^
          let filename =
            !output_filename ^ "." ^
-           match domid with
-           | Some id -> string_of_int id
+           match dom with
+           | Some dom -> string_of_int (D.get_id dom)
            | None ->
                let f = function
                  | ('a'..'z'|'A'..'Z'|'0'..'9'|'_' as c) -> String.make 1 c
            | None ->
                let f = function
                  | ('a'..'z'|'A'..'Z'|'0'..'9'|'_' as c) -> String.make 1 c
@@ -65,7 +68,7 @@ let rec beforeksyms debug = function
          save_image image filename
       ) images
 
          save_image image filename
       ) images
 
-and save_image (_, domname, arch, mem) filename =
+and save_image { domname = domname } filename =
   assert false;
 
   let chan = open_out filename in
   assert false;
 
   let chan = open_out filename in
index 87035e8..2394248 100644 (file)
@@ -36,7 +36,7 @@ type kallsyms_compr =
   | Compressed of (string * Virt_mem_mmap.addr) list * Virt_mem_mmap.addr
   | Uncompressed of (string * Virt_mem_mmap.addr) list
 
   | Compressed of (string * Virt_mem_mmap.addr) list * Virt_mem_mmap.addr
   | Uncompressed of (string * Virt_mem_mmap.addr) list
 
-let find_kallsyms debug (domid, name, arch, mem, lookup_ksym) =
+let find_kallsyms debug (({ domname = domname; mem = mem } as image), ksymmap) =
   let start_t = gettimeofday () in
 
   (* Now try to find the /proc/kallsyms table.  This is in an odd
   let start_t = gettimeofday () in
 
   (* Now try to find the /proc/kallsyms table.  This is in an odd
@@ -50,7 +50,7 @@ let find_kallsyms debug (domid, name, arch, mem, lookup_ksym) =
    * more useful than the basic list of exports.
    *)
   let ksym_addrs = List.filter_map (
    * more useful than the basic list of exports.
    *)
   let ksym_addrs = List.filter_map (
-    fun ksym -> try Some (lookup_ksym ksym) with Not_found -> None
+    fun ksym -> try Some (Ksymmap.find ksym ksymmap) with Not_found -> None
   ) Virt_mem_ksyms.common_ksyms in
 
   (* Search for those kernel addresses in the image.  We're looking
   ) Virt_mem_ksyms.common_ksyms in
 
   (* Search for those kernel addresses in the image.  We're looking
@@ -70,7 +70,7 @@ let find_kallsyms debug (domid, name, arch, mem, lookup_ksym) =
        * If found, jump backwards by length and check all addresses.
        *)
       if debug then
        * If found, jump backwards by length and check all addresses.
        *)
       if debug then
-       eprintf "%s: testing candidate kallsyms at %Lx\n" name addr;
+       eprintf "%s: testing candidate kallsyms at %Lx\n" domname addr;
       let rec loop addr =
        let addrp = Virt_mem_mmap.follow_pointer mem addr in
        if Virt_mem_mmap.is_mapped mem addrp then
       let rec loop addr =
        let addrp = Virt_mem_mmap.follow_pointer mem addr in
        if Virt_mem_mmap.is_mapped mem addrp then
@@ -100,7 +100,7 @@ let find_kallsyms debug (domid, name, arch, mem, lookup_ksym) =
                  let names_addr = Virt_mem_mmap.succ_long mem end_addr in
                  if debug then
                    eprintf "%s: candidate kallsyms found at %Lx (names_addr at %Lx, num_entries %d)\n"
                  let names_addr = Virt_mem_mmap.succ_long mem end_addr in
                  if debug then
                    eprintf "%s: candidate kallsyms found at %Lx (names_addr at %Lx, num_entries %d)\n"
-                     name start_addr names_addr num_entries;
+                     domname start_addr names_addr num_entries;
                  Some (start_addr, num_entries, names_addr)
              in
              loop2 start_addr
                  Some (start_addr, num_entries, names_addr)
              in
              loop2 start_addr
@@ -180,7 +180,7 @@ let find_kallsyms debug (domid, name, arch, mem, lookup_ksym) =
   ) ksym_addrs in
 
   if debug then (
   ) ksym_addrs in
 
   if debug then (
-    eprintf "%s: candidate kallsyms at:\n" name;
+    eprintf "%s: candidate kallsyms at:\n" domname;
     List.iter (
       function
       | (start_addr, num_entries, names_addr, Uncompressed _) ->
     List.iter (
       function
       | (start_addr, num_entries, names_addr, Uncompressed _) ->
@@ -196,23 +196,22 @@ let find_kallsyms debug (domid, name, arch, mem, lookup_ksym) =
   (* Vote for the most popular symbol table candidate and
    * enhance the function for looking up ksyms.
    *)
   (* Vote for the most popular symbol table candidate and
    * enhance the function for looking up ksyms.
    *)
-  let lookup_ksym =
+  let ksymmap =
     let freqs = frequency kallsymtabs in
     match freqs with
     | [] ->
     let freqs = frequency kallsymtabs in
     match freqs with
     | [] ->
-       (* Can't find any kallsymtabs, just return the lookup_ksym
-        * function generated previously from the exported symbols.
+       (* Can't find any kallsymtabs, just return the ksymmap
+        * map generated previously from the exported symbols.
         *)
         *)
-       lookup_ksym
+       ksymmap
 
     | (_, (_, _, _, Uncompressed names)) :: _ ->
 
     | (_, (_, _, _, Uncompressed names)) :: _ ->
-       let lookup_ksym name =
-         try (* first look it up in kallsyms table. *)
-           List.assoc name names
-         with Not_found -> (* try the old exports table instead *)
-           lookup_ksym name
+       let rec loop ksymmap = function
+         | (name, value) :: names ->
+             loop (Ksymmap.add name value ksymmap) names
+         | [] -> ksymmap
        in
        in
-       lookup_ksym
+       loop ksymmap names
 
     | (_, (start_addr, num_entries, names_addr,
           Compressed (compressed_names, markers_addr))) :: _ ->
 
     | (_, (start_addr, num_entries, names_addr,
           Compressed (compressed_names, markers_addr))) :: _ ->
@@ -258,14 +257,12 @@ let find_kallsyms debug (domid, name, arch, mem, lookup_ksym) =
            Some (name, sym_value)
        ) compressed_names in
 
            Some (name, sym_value)
        ) compressed_names in
 
-       let lookup_ksym name =
-         try (* first look it up in kallsyms table. *)
-           List.assoc name names
-         with Not_found -> (* try the old exports table instead *)
-           lookup_ksym name
+       let rec loop ksymmap = function
+         | (name, value) :: names ->
+             loop (Ksymmap.add name value ksymmap) names
+         | [] -> ksymmap
        in
        in
-
-       lookup_ksym in
+       loop ksymmap names in
 
   if debug then (
     let end_t = gettimeofday () in
 
   if debug then (
     let end_t = gettimeofday () in
@@ -273,4 +270,4 @@ let find_kallsyms debug (domid, name, arch, mem, lookup_ksym) =
       (end_t -. start_t)
   );
 
       (end_t -. start_t)
   );
 
-  ((domid, name, arch, mem, lookup_ksym) : image1)
+  ((image, ksymmap) : image1)
index d70ace1..32031fb 100644 (file)
@@ -45,7 +45,7 @@ let common_ksyms = [
   "schedule";                          (* scheduler entry point *)
 ]
 
   "schedule";                          (* scheduler entry point *)
 ]
 
-let find_kernel_symbols debug (domid, name, arch, mem) =
+let find_kernel_symbols debug ({ mem = mem; domname = domname } as image) =
   (* Searching for <NUL>string<NUL> *)
   let common_ksyms_nul = List.map (sprintf "\000%s\000") common_ksyms in
 
   (* Searching for <NUL>string<NUL> *)
   let common_ksyms_nul = List.map (sprintf "\000%s\000") common_ksyms in
 
@@ -127,7 +127,7 @@ let find_kernel_symbols debug (domid, name, arch, mem) =
   let ksymtabs = List.filter (fun (_, size) -> size > 64L) ksymtabs in
 
   if debug then (
   let ksymtabs = List.filter (fun (_, size) -> size > 64L) ksymtabs in
 
   if debug then (
-    eprintf "%s: candidate symbol tables at:\n" name;
+    eprintf "%s: candidate symbol tables at:\n" domname;
     List.iter (
       fun (addr, size) ->
        eprintf "\t%Lx\t%Lx\t%!" addr size;
     List.iter (
       fun (addr, size) ->
        eprintf "\t%Lx\t%Lx\t%!" addr size;
@@ -141,18 +141,18 @@ let find_kernel_symbols debug (domid, name, arch, mem) =
   (* Vote for the most popular symbol table candidate and from this
    * generate a function to look up ksyms.
    *)
   (* Vote for the most popular symbol table candidate and from this
    * generate a function to look up ksyms.
    *)
-  let lookup_ksym =
+  let ksymmap =
     let freqs = frequency ksymtabs in
     match freqs with
     | [] ->
     let freqs = frequency ksymtabs in
     match freqs with
     | [] ->
-       eprintf (f_"%s: cannot find start of kernel symbol table\n") name;
-       (fun _ -> raise Not_found)
+       eprintf (f_"%s: cannot find start of kernel symbol table\n") domname;
+       Ksymmap.empty
 
     | (_, (ksymtab_addr, ksymtab_size)) :: _ ->
        if debug then
          eprintf
            "%s: Kernel symbol table found at %Lx, size %Lx bytes\n%!"
 
     | (_, (ksymtab_addr, ksymtab_size)) :: _ ->
        if debug then
          eprintf
            "%s: Kernel symbol table found at %Lx, size %Lx bytes\n%!"
-           name ksymtab_addr ksymtab_size;
+           domname ksymtab_addr ksymtab_size;
 
        (* Load the whole symbol table as a bitstring. *)
        let ksymtab =
 
        (* Load the whole symbol table as a bitstring. *)
        let ksymtab =
@@ -160,26 +160,24 @@ let find_kernel_symbols debug (domid, name, arch, mem) =
            (Virt_mem_mmap.get_bytes mem ksymtab_addr
               (Int64.to_int ksymtab_size)) in
 
            (Virt_mem_mmap.get_bytes mem ksymtab_addr
               (Int64.to_int ksymtab_size)) in
 
-       (* Function to look up an address in the symbol table. *)
-       let lookup_ksym sym =
+       (* Construct kernel symbol map. *)
+       let ksymmap =
          let bits = bits_of_wordsize (Virt_mem_mmap.get_wordsize mem) in
          let e = Virt_mem_mmap.get_endian mem in
          let bits = bits_of_wordsize (Virt_mem_mmap.get_wordsize mem) in
          let e = Virt_mem_mmap.get_endian mem in
-         let rec loop bs =
+         let rec loop ksymmap bs =
            bitmatch bs with
            | { value : bits : endian(e);
            bitmatch bs with
            | { value : bits : endian(e);
-               name_ptr : bits : endian(e) }
-               when Virt_mem_mmap.get_string mem name_ptr = sym ->
-               value
-           | { _ : bits : endian(e);
-               _ : bits : endian(e);
+               name_ptr : bits : endian(e);
                bs : -1 : bitstring } ->
                bs : -1 : bitstring } ->
-               loop bs
-           | { _ } -> raise Not_found
+               let name = Virt_mem_mmap.get_string mem name_ptr in
+               let ksymmap = Ksymmap.add name value ksymmap in
+               loop ksymmap bs
+           | { _ } ->
+               ksymmap
          in
          in
-         loop ksymtab
-       in
+         loop Ksymmap.empty ksymtab in
 
 
-       lookup_ksym
+       ksymmap
   in
 
   if debug then (
   in
 
   if debug then (
@@ -188,4 +186,4 @@ let find_kernel_symbols debug (domid, name, arch, mem) =
       (end_t -. start_t)
   );
 
       (end_t -. start_t)
   );
 
-  ((domid, name, arch, mem, lookup_ksym) : image1)
+  ((image, ksymmap) : image1)
index 34f3fe7..071f6de 100644 (file)
    Common types.
  *)
 
    Common types.
  *)
 
-(** A kernel image. *)
-type image0 =
-    int option                         (* Domain ID, if known. *)
-    * string                           (* Domain name. *)
-    * Virt_mem_utils.architecture      (* Architecture, eg. i386. *)
-    * ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t (* Memory map. *)
-
-(** A kernel symbol. *)
+module D = Libvirt.Domain
+
+open Virt_mem_mmap
+
 type ksym = string
 
 type ksym = string
 
-(** A kernel image, after finding kernel symbols. *)
+module Ksymmap = Map.Make (String)
+
+type image0 = {
+  dom : Libvirt.ro D.t option;
+  domname : string;
+  arch : Virt_mem_utils.architecture;
+  mem : ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t;
+}
+
 type image1 =
 type image1 =
-    int option                         (* Domain ID, if known. *)
-    * string                           (* Domain name. *)
-    * Virt_mem_utils.architecture      (* Architecture, eg. i386. *)
-    * ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t (* Memory map. *)
-    * (ksym -> Virt_mem_mmap.addr)     (* Kernel symbol lookup function. *)
+    image0
+    * addr Ksymmap.t
 
 
-(** A kernel image, after finding kernel version (like 'uname'). *)
 type image2 =
 type image2 =
-    int option                         (* Domain ID, if known. *)
-    * string                           (* Domain name. *)
-    * Virt_mem_utils.architecture      (* Architecture, eg. i386. *)
-    * ([`Wordsize], [`Endian], [`HasMapping]) Virt_mem_mmap.t (* Memory map. *)
-    * (ksym -> Virt_mem_mmap.addr)     (* Kernel symbol lookup function. *)
-    * utsname option                   (* Kernel version, etc., if known. *)
+    image0
+    * addr Ksymmap.t
+    * utsname option
 
 and utsname = {
   kernel_name : string;
 
 and utsname = {
   kernel_name : string;
diff --git a/lib/virt_mem_types.mli b/lib/virt_mem_types.mli
new file mode 100644 (file)
index 0000000..24ce3e7
--- /dev/null
@@ -0,0 +1,72 @@
+(** Common types. *)
+(* 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.
+
+   Common types.
+ *)
+
+type ksym = string
+  (** A kernel symbol. *)
+
+module Ksymmap : sig
+  type key = String.t
+  type 'a t = 'a Map.Make(String).t
+  val empty : 'a t
+  val is_empty : 'a t -> bool
+  val add : key -> 'a -> 'a t -> 'a t
+  val find : key -> 'a t -> 'a
+  val remove : key -> 'a t -> 'a t
+  val mem : key -> 'a t -> bool
+  val iter : (key -> 'a -> unit) -> 'a t -> unit
+  val map : ('a -> 'b) -> 'a t -> 'b t
+  val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
+  val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+  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. *)
+
+type utsname = {
+  kernel_name : string;
+  nodename : string;
+  kernel_release : string;
+  kernel_version : string;
+  machine : string;
+  domainname : 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. *)
+}
+  (** A basic kernel image. *)
+
+type image1 =
+    image0
+    * Virt_mem_mmap.addr Ksymmap.t     (* Kernel symbol map. *)
+  (** A kernel image, after finding kernel symbols. *)
+
+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'). *)
index 61a2b37..084ba92 100644 (file)
@@ -57,13 +57,13 @@ let parse_utsname bits =
   | { _ } ->
       None
 
   | { _ } ->
       None
 
-let find_utsname debug (domid, name, arch, mem, lookup_ksym) =
+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
      *)
     try
   let utsname =
     (* In Linux 2.6.25, the symbol is init_uts_ns.
      * http://lxr.linux.no/linux/init/version.c
      *)
     try
-      let addr = lookup_ksym "init_uts_ns" in
+      let addr = Ksymmap.find "init_uts_ns" ksymmap in
 
       let bs = Bitstring.bitstring_of_string (get_bytes mem addr (65*6+4)) in
       (bitmatch bs with
 
       let bs = Bitstring.bitstring_of_string (get_bytes mem addr (65*6+4)) in
       (bitmatch bs with
@@ -81,7 +81,7 @@ let find_utsname debug (domid, name, arch, mem, lookup_ksym) =
         * http://lxr.linux.no/linux-bk+v2.6.9/include/linux/utsname.h#L24
         *)
        try
         * http://lxr.linux.no/linux-bk+v2.6.9/include/linux/utsname.h#L24
         *)
        try
-         let addr = lookup_ksym "system_utsname" in
+         let addr = Ksymmap.find "system_utsname" ksymmap in
 
          let bits =
            Bitstring.bitstring_of_string (get_bytes mem addr (65*6)) in
 
          let bits =
            Bitstring.bitstring_of_string (get_bytes mem addr (65*6)) in
@@ -90,4 +90,4 @@ let find_utsname debug (domid, name, arch, mem, lookup_ksym) =
              Not_found ->
                eprintf (f_"%s: could not find utsname in kernel image\n") name
   in
              Not_found ->
                eprintf (f_"%s: could not find utsname in kernel image\n") name
   in
-  (domid, name, arch, mem, lookup_ksym, utsname)
+  (image, ksymmap, utsname)
index 3113447..c806943 100644 (file)
@@ -1,4 +1,4 @@
-virt_ps.cmo: ../lib/virt_mem_utils.cmo ../lib/virt_mem_mmap.cmi \
-    ../lib/virt_mem_gettext.cmo ../lib/virt_mem.cmi 
-virt_ps.cmx: ../lib/virt_mem_utils.cmx ../lib/virt_mem_mmap.cmx \
-    ../lib/virt_mem_gettext.cmx ../lib/virt_mem.cmx 
+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 
+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 
index df876ba..8b6f685 100644 (file)
@@ -21,6 +21,7 @@ open Printf
 
 open Virt_mem_gettext.Gettext
 open Virt_mem_utils
 
 open Virt_mem_gettext.Gettext
 open Virt_mem_utils
+open Virt_mem_types
 open Virt_mem_mmap
 
 (* The implementation of 'ps' has gone through a number of complete
 open Virt_mem_mmap
 
 (* The implementation of 'ps' has gone through a number of complete
@@ -191,16 +192,16 @@ let get_task_struct debug mem ((ws,e) as wse) ((n1,n2) as shape)
   get_task_struct ~i:0 addr accum
 
 (* This is the directed search function. *)
   get_task_struct ~i:0 addr accum
 
 (* This is the directed search function. *)
-let search debug mem lookup_ksym =
+let search debug mem ksymmap =
   let ws = get_wordsize mem in
   let ws = match ws with W32 -> 32 | W64 -> 64 in
   let e = get_endian mem in
   let wse = ws, e in
 
   let init_task =
   let ws = get_wordsize mem in
   let ws = match ws with W32 -> 32 | W64 -> 64 in
   let e = get_endian mem in
   let wse = ws, e in
 
   let init_task =
-    try lookup_ksym "init_task"
+    try Ksymmap.find "init_task" ksymmap
     with Not_found ->
     with Not_found ->
-      eprintf "virt-ps: lookup_ksym of init_task failed\n";
+      eprintf "virt-ps: cannot find kernel symbol 'init_task'\n";
       exit 1 in
 
   let accum = Accum.empty in
       exit 1 in
 
   let accum = Accum.empty in
@@ -222,8 +223,8 @@ let search debug mem lookup_ksym =
   let ts = loop 0 0 in
   ()
 
   let ts = loop 0 0 in
   ()
 
-let run debug (_, _, _, mem, lookup_ksym, _) =
-  search debug mem lookup_ksym
+let run debug ({ mem = mem }, ksymmap, _) =
+  search debug mem ksymmap
 
 let summary = s_"list processes in virtual machine"
 let description = s_"\
 
 let summary = s_"list processes in virtual machine"
 let description = s_"\
index dbdac15..34eaf05 100644 (file)
@@ -1,4 +1,4 @@
-virt_uname.cmo: ../lib/virt_mem_utils.cmo ../lib/virt_mem_types.cmo \
+virt_uname.cmo: ../lib/virt_mem_utils.cmo ../lib/virt_mem_types.cmi \
     ../lib/virt_mem_gettext.cmo ../lib/virt_mem.cmi 
 virt_uname.cmx: ../lib/virt_mem_utils.cmx ../lib/virt_mem_types.cmx \
     ../lib/virt_mem_gettext.cmx ../lib/virt_mem.cmx 
     ../lib/virt_mem_gettext.cmo ../lib/virt_mem.cmi 
 virt_uname.cmx: ../lib/virt_mem_utils.cmx ../lib/virt_mem_types.cmx \
     ../lib/virt_mem_gettext.cmx ../lib/virt_mem.cmx 
index 981f0ee..3d902ce 100644 (file)
@@ -23,15 +23,15 @@ open Virt_mem_gettext.Gettext
 open Virt_mem_utils
 open Virt_mem_types
 
 open Virt_mem_utils
 open Virt_mem_types
 
-let run debug (_, name, _, _, _, utsname) =
+let run debug ({ domname = domname }, _, utsname) =
   match utsname with
   | Some u ->
       printf "%s: %s %s %s %s %s %s\n"
   match utsname with
   | Some u ->
       printf "%s: %s %s %s %s %s %s\n"
-       name
+       domname
        u.kernel_name u.nodename u.kernel_release
        u.kernel_version u.machine u.domainname
   | None ->
        u.kernel_name u.nodename u.kernel_release
        u.kernel_version u.machine u.domainname
   | None ->
-      eprintf (f_"%s: no system_utsname in kernel image\n") name
+      eprintf (f_"%s: no system_utsname in kernel image\n") domname
 
 let summary = s_"uname command for virtual machines"
 let description = s_"\
 
 let summary = s_"uname command for virtual machines"
 let description = s_"\