lib/virt_mem.ml

   1 (* Memory info for virtual domains.
   2    (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   5    This program is free software; you can redistribute it and/or modify
   6    it under the terms of the GNU General Public License as published by
   7    the Free Software Foundation; either version 2 of the License, or
   8    (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  *)
  19
  20 open Unix
  21 open Printf
  22 open ExtList
  23 open ExtString
  24
  25 module C = Libvirt.Connect
  26 module D = Libvirt.Domain
  27
  28 open Virt_mem_gettext.Gettext
  29 open Virt_mem_utils
  30 module MMap = Virt_mem_mmap
  31
  32 let min_kallsyms_tabsize = 1_000L
  33 let max_kallsyms_tabsize = 250_000L
  34
  35 (* Make the kernel size around 16 MB, but just a bit smaller than
  36  * maximum string length so we can still run this on a 32 bit platform.
  37  *)
  38 let kernel_size =
  39   if Sys.word_size = 32 then Sys.max_string_length
  40   else 0x100_0000
  41 let max_memory_peek = 65536 (* XXX Use D.max_peek function *)
  42
  43 type ksym = string
  44
  45 type image =
  46     string
  47     * Virt_mem_utils.architecture
  48     * ([`Wordsize], [`Endian]) Virt_mem_mmap.t
  49     * (ksym -> MMap.addr)
  50
  51 type kallsyms_compr =
  52   | Compressed of (string * MMap.addr) list * MMap.addr
  53   | Uncompressed of (string * MMap.addr) list
  54
  55 (* When tools register themselves, they are added to this list.
  56  * Later, we will alphabetize the list.
  57  *)
  58 let tools = ref [
  59   "capture", (
  60     "capture",
  61     s_"capture memory image for post-mortem analysis",
  62     s_"Capture a memory image to a file for later post-mortem
  63 analysis.  Use the '-o memoryimage' option to specify the
  64 output file.
  65
  66 Other tools can load the memory image using the '-t' option.",
  67     false,
  68     (fun _ _ -> ())
  69   );
  70 ]
  71
  72 (* Registration function used by the tools. *)
  73 let register name summary description is_cmd run_fn =
  74   tools := (name, (name, summary, description, is_cmd, run_fn)) :: !tools
  75
  76 (* Main program, called from mem/virt_mem_main.ml when all the
  77  * tools have had a chance to register themselves.
  78  *)
  79 let main () =
  80   (* Get the registered tools, alphabetically. *)
  81   let tools = !tools in
  82   let tools = List.sort ~cmp:(fun (a,_) (b,_) -> compare a b) tools in
  83
  84   (* Which tool did the user want to run?  Look at the executable
  85    * name (eg. 'virt-dmesg' => tool == dmesg).  If we don't recognise
  86    * the executable name then we must look for the first parameter
  87    * which doesn't begin with a '-' character.
  88    *
  89    * Note that we must do all of this before using the OCaml Arg
  90    * module to properly parse the command line (below), so that
  91    * we can have a usage message ready.
  92    *)
  93   let tool =
  94     let prog = Sys.executable_name in   (* eg. "/usr/bin/virt-dmesg.opt" *)
  95     let prog = Filename.basename prog in(* eg. "virt-dmesg.opt" *)
  96     let prog =                          (* eg. "virt-dmesg" *)
  97       try Filename.chop_extension prog with Invalid_argument _ -> prog in
  98     let prog =                          (* eg. "dmesg" *)
  99       if String.starts_with prog "virt-" then
 100         String.sub prog 5 (String.length prog - 5)
 101       else prog in
 102     try Some (List.assoc prog tools)
 103     with Not_found ->
 104       let arg1 =                        (* First non-option argument. *)
 105         match Array.to_list Sys.argv with
 106         | [] -> None
 107         | _::args ->
 108             let rec loop = function
 109               | [] -> None
 110               | a::args when String.length a > 0 && a.[0] = '-' -> loop args
 111               | a::_ -> Some a
 112             in
 113             loop args in
 114       match arg1 with
 115       | None -> None
 116       | Some prog ->                    (* Recognisable first argument? *)
 117           let prog =
 118             try Filename.chop_extension prog with Invalid_argument _ -> prog in
 119           let prog =
 120             if String.starts_with prog "virt-" then
 121               String.sub prog 5 (String.length prog - 5)
 122             else prog in
 123           (try Some (List.assoc prog tools) with Not_found -> None) in
 124
 125   (* Make a usage message. *)
 126   let usage_msg =
 127     match tool with
 128     | None ->                           (* Generic usage message. *)
 129         let tools = List.map (
 130           fun (name, (_, summary, _, is_cmd, _)) ->
 131             if is_cmd then "virt-"^name, summary
 132             else           "virt-mem "^name, summary
 133         ) tools in
 134         (* Maximum width of field in the left hand column. *)
 135         let max_width =
 136           List.fold_left max 0 (List.map String.length (List.map fst tools)) in
 137         let tools = List.map (fun (l,r) -> pad max_width l, r) tools in
 138         let tools = List.map (fun (l,r) -> "  " ^ l ^ " - " ^ r) tools in
 139         let tools = String.concat "\n" tools in
 140
 141         sprintf (f_"\
 142
 143 virt-mem: Tools for providing information about virtual machines
 144
 145 Currently available tools include:
 146 %s
 147
 148 General usage is:
 149   <tool> [-options] [domains...]
 150
 151 To display extra help for a single tool, do:
 152   virt-mem help <tool>
 153
 154 Options:") tools
 155
 156                                         (* Tool-specific usage message. *)
 157     | Some (name, summary, description, is_cmd, _) ->
 158         let cmd = if is_cmd then "virt-" ^ name else "virt-mem " ^ name in
 159
 160         sprintf (f_"\
 161
 162 %s: %s
 163
 164 Description:
 165 %s
 166
 167 Options:") cmd summary description in
 168
 169   (* Now begin proper parsing of the command line arguments. *)
 170
 171   (* Debug messages. *)
 172   let debug = ref false in
 173
 174   (* Default wordsize. *)
 175   let def_wordsize = ref None in
 176   let set_wordsize = function
 177     | "32" -> def_wordsize := Some W32
 178     | "64" -> def_wordsize := Some W64
 179     | "auto" -> def_wordsize := None
 180     | str -> failwith (sprintf (f_"set_wordsize: %s: unknown wordsize") str)
 181   in
 182
 183   (* Default endianness. *)
 184   let def_endian = ref None in
 185   let set_endian = function
 186     | "auto" -> def_endian := None
 187     | "le" | "little" | "littleendian" | "intel" ->
 188         def_endian := Some Bitmatch.LittleEndian
 189     | "be" | "big" | "bigendian" | "motorola" ->
 190         def_endian := Some Bitmatch.BigEndian
 191     | str -> failwith (sprintf (f_"set_endian: %s: unknown endianness") str)
 192   in
 193
 194   (* Default architecture. *)
 195   let def_architecture = ref None in
 196   let set_architecture = function
 197     | "auto" -> def_architecture := None
 198     | arch ->
 199         let arch = architecture_of_string arch in
 200         def_architecture := Some arch;
 201         def_endian := Some (endian_of_architecture arch);
 202         def_wordsize := Some (wordsize_of_architecture arch)
 203   in
 204
 205   (* Default text address. *)
 206   let def_text_addr = ref 0L (* 0 = auto-detect *) in
 207   let set_text_addr = function
 208     | "auto" -> def_text_addr := 0L
 209     | "i386" -> def_text_addr := 0xc010_0000_L (* common for x86 *)
 210     | "x86-64"|"x86_64" -> def_text_addr := 0xffffffff_81000000_L (* x86-64? *)
 211     | str -> def_text_addr := Int64.of_string str
 212   in
 213
 214   (* List of kernel images. *)
 215   let images = ref [] in
 216   let uri = ref "" in
 217   let anon_args = ref [] in
 218
 219   let memory_image filename =
 220     images :=
 221       (!def_wordsize, !def_endian, !def_architecture, !def_text_addr, filename)
 222     :: !images
 223   in
 224
 225   let version () =
 226     printf "virt-mem %s\n" Virt_mem_version.version;
 227
 228     let major, minor, release =
 229       let v, _ = Libvirt.get_version () in
 230       v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
 231     printf "libvirt %d.%d.%d\n" major minor release;
 232     exit 0
 233   in
 234
 235   let argspec = Arg.align [
 236     "-A", Arg.String set_architecture,
 237       "arch " ^ s_"Set kernel architecture, endianness and word size";
 238     "-E", Arg.String set_endian,
 239       "endian " ^ s_"Set kernel endianness";
 240     "-T", Arg.String set_text_addr,
 241       "addr " ^ s_"Set kernel text address";
 242     "-W", Arg.String set_wordsize,
 243       "addr " ^ s_"Set kernel word size";
 244     "-c", Arg.Set_string uri,
 245       "uri " ^ s_ "Connect to URI";
 246     "--connect", Arg.Set_string uri,
 247       "uri " ^ s_ "Connect to URI";
 248     "--debug", Arg.Set debug,
 249       " " ^ s_"Debug mode (default: false)";
 250     "-t", Arg.String memory_image,
 251       "image " ^ s_"Use saved kernel memory image";
 252     "--version", Arg.Unit version,
 253       " " ^ s_"Display version and exit";
 254   ] in
 255
 256   let anon_arg str = anon_args := str :: !anon_args in
 257   Arg.parse argspec anon_arg usage_msg;
 258
 259   let images = !images in
 260   let debug = !debug in
 261   let uri = if !uri = "" then None else Some !uri in
 262   let anon_args = List.rev !anon_args in
 263
 264   (* At this point, either --help was specified on the command line
 265    * (and so the program has exited) or we must have determined tool,
 266    * or the user didn't give us a valid tool (eg. "virt-mem foobar").
 267    * Detect that final case now and give an error.
 268    *)
 269   let name, _, _, _, run_fn =
 270     match tool with
 271     | Some t -> t
 272     | None ->
 273         prerr_endline (s_"\
 274 virt-mem: I could not work out which tool you are trying to run.
 275 Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
 276         exit 1
 277   in
 278   if debug then eprintf "tool = %s\n%!" name;
 279
 280   (* Get the kernel images. *)
 281   let images =
 282     if images = [] then (
 283       let conn =
 284         let name = uri in
 285         try C.connect_readonly ?name ()
 286         with Libvirt.Virterror err ->
 287           prerr_endline (Libvirt.Virterror.to_string err);
 288           (* If non-root and no explicit connection URI, print a warning. *)
 289           if Unix.geteuid () <> 0 && name = None then (
 290             print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
 291           );
 292           exit 1 in
 293
 294       (* If we have a list of parameters, then it is the domain names / UUIDs /
 295        * IDs ONLY that we wish to display.  Otherwise, display all active.
 296        *)
 297       let doms =
 298         if anon_args = [] then (
 299           (* List of active domains. *)
 300           let nr_active_doms = C.num_of_domains conn in
 301           let active_doms =
 302             Array.to_list (C.list_domains conn nr_active_doms) in
 303           List.map (D.lookup_by_id conn) active_doms
 304         ) else (
 305           List.map (
 306             fun arg ->
 307               let dom =
 308                 try D.lookup_by_uuid_string conn arg
 309                 with _ ->
 310                   try D.lookup_by_name conn arg
 311                   with _ ->
 312                     try D.lookup_by_id conn (int_of_string arg)
 313                     with _ ->
 314                       failwith (sprintf (f_"%s: unknown domain (not a UUID, name or ID of any active domain)") arg) in
 315
 316               (* XXX Primitive test to see if the domain is active. *)
 317               let is_active = try D.get_id dom >= 0 with _ -> false in
 318               if not is_active then
 319                 failwith (sprintf (f_"%s: domain is not running") arg);
 320
 321               dom
 322           ) anon_args
 323         ) in
 324
 325       (* Get their XML. *)
 326       let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
 327
 328       (* Parse the XML. *)
 329       let xmls = List.map (fun (dom, xml) ->
 330                              dom, Xml.parse_string xml) xmls in
 331
 332       (* XXX Do something with the XML XXX
 333        * such as detecting arch, wordsize, endianness.
 334        * XXXXXXXXXXXXXX
 335        *
 336        *
 337        *
 338        *)
 339
 340
 341       List.map (
 342         fun (dom, _) ->
 343           let name = D.get_name dom in
 344
 345           let wordsize =
 346             match !def_wordsize with
 347             | None ->
 348                 failwith
 349                   (sprintf (f_"%s: use -W to define word size for this image")
 350                      name);
 351             | Some ws -> ws in
 352           let endian =
 353             match !def_endian with
 354             | None ->
 355                 failwith
 356                   (sprintf (f_"%s: use -E to define endianness for this image")
 357                      name);
 358             | Some e -> e in
 359
 360           let arch =
 361             match !def_architecture with
 362             | Some I386 -> I386 | Some X86_64 -> X86_64
 363             | _ ->
 364                 failwith
 365                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") name) in
 366
 367           if !def_text_addr = 0L then
 368             failwith
 369               (sprintf (f_"%s: use -T to define kernel load address for this image") name);
 370
 371           let start_t = gettimeofday () in
 372
 373           (* Read the kernel memory.
 374            * Maximum 64K can be read over remote connections.
 375            *)
 376           let str = String.create kernel_size in
 377           let rec loop i =
 378             let remaining = kernel_size - i in
 379             if remaining > 0 then (
 380               let size = min remaining max_memory_peek in
 381               D.memory_peek dom [D.Virtual]
 382                 (!def_text_addr +^ Int64.of_int i) size str i;
 383               loop (i + size)
 384             )
 385           in
 386           loop 0;
 387
 388           if debug then (
 389             let end_t = gettimeofday () in
 390             eprintf "timing: downloading kernel took %f seconds\n%!"
 391               (end_t -. start_t)
 392           );
 393
 394           (* Map the virtual memory. *)
 395           let mem = MMap.of_string str !def_text_addr in
 396
 397           (* Force the wordsize and endianness. *)
 398           let mem = MMap.set_wordsize mem wordsize in
 399           let mem = MMap.set_endian mem endian in
 400
 401           (name, arch, mem)
 402       ) xmls
 403     ) else (
 404       (* One or more -t options passed. *)
 405       if anon_args <> [] then
 406         failwith (s_"virt-mem: if -t given on command line, then no domain arguments should be listed");
 407
 408       List.map (
 409         fun (wordsize, endian, arch, text_addr, filename) ->
 410           (* Quite a lot of limitations on the kernel images we can
 411            * handle at the moment ...
 412            *)
 413           (* XXX We could auto-detect wordsize easily. *)
 414           let wordsize =
 415             match wordsize with
 416             | None ->
 417                 failwith
 418                   (sprintf (f_"%s: use -W to define word size for this image")
 419                      filename);
 420             | Some ws -> ws in
 421           let endian =
 422             match endian with
 423             | None ->
 424                 failwith
 425                   (sprintf (f_"%s: use -E to define endianness for this image")
 426                      filename);
 427             | Some e -> e in
 428
 429           let arch =
 430             match arch with
 431             | Some I386 -> I386 | Some X86_64 -> X86_64
 432             | _ ->
 433                 failwith
 434                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") filename) in
 435
 436           if text_addr = 0L then
 437             failwith
 438               (sprintf (f_"%s: use -T to define kernel load address for this image")
 439                  filename);
 440
 441           (* Map the virtual memory. *)
 442           let fd = openfile filename [O_RDONLY] 0 in
 443           let mem = MMap.of_file fd text_addr in
 444
 445           (* Force the wordsize and endianness. *)
 446           let mem = MMap.set_wordsize mem wordsize in
 447           let mem = MMap.set_endian mem endian in
 448
 449           (filename, arch, mem)
 450       ) images
 451     ) in
 452
 453   let images =
 454     List.map (
 455       fun (name, arch, mem) ->
 456         (* Look for some common entries in the exported symbol table and
 457          * from that find the symbol table itself.  These are just
 458          * supposed to be symbols which are very likely to be present
 459          * in any Linux kernel, although we only need one of them to be
 460          * present to find the symbol table.
 461          *
 462          * NB. Must not be __initdata, must be in EXPORT_SYMBOL.
 463          *)
 464         let common_ksyms = [
 465           "init_task";                  (* first task_struct *)
 466           "root_mountflags";            (* flags for mounting root fs *)
 467           "init_uts_ns";                (* uname strings *)
 468           "sys_open";                   (* open(2) entry point *)
 469           "sys_chdir";                  (* chdir(2) entry point *)
 470           "sys_chroot";                 (* chroot(2) entry point *)
 471           "sys_umask";                  (* umask(2) entry point *)
 472           "schedule";                   (* scheduler entry point *)
 473         ] in
 474         (* Searching for <NUL>string<NUL> *)
 475         let common_ksyms_nul = List.map (sprintf "\000%s\000") common_ksyms in
 476
 477         let start_t = gettimeofday () in
 478
 479         (* Search for these strings in the memory image. *)
 480         let ksym_strings = List.map (MMap.find_all mem) common_ksyms_nul in
 481         let ksym_strings = List.concat ksym_strings in
 482         (* Adjust found addresses to start of the string (skip <NUL>). *)
 483         let ksym_strings = List.map Int64.succ ksym_strings in
 484
 485         if debug then (
 486           let end_t = gettimeofday () in
 487           eprintf "timing: searching for common_ksyms took %f seconds\n%!"
 488             (end_t -. start_t)
 489         );
 490
 491         let start_t = gettimeofday () in
 492
 493         (* For any we found, try to look up the symbol table
 494          * base addr and size.
 495          *)
 496         let ksymtabs = List.map (
 497           fun addr ->
 498             (* Search for 'addr' appearing in the image. *)
 499             let addrs = MMap.find_pointer_all mem addr in
 500
 501             (* Now consider each of these addresses and search back
 502              * until we reach the beginning of the (possible) symbol
 503              * table.
 504              *
 505              * Kernel symbol table struct is:
 506              * struct kernel_symbol {
 507              *   unsigned long value;
 508              *   const char *name;    <-- initial pointer
 509              * } symbols[];
 510              *)
 511             let pred_long2 addr =
 512               MMap.pred_long mem (MMap.pred_long mem addr)
 513             in
 514             let base_addrs = List.map (
 515               fun addr ->
 516                 let rec loop addr =
 517                   (* '*addr' should point to a C identifier.  If it does,
 518                    * step backwards to the previous symbol table entry.
 519                    *)
 520                   let addrp = MMap.follow_pointer mem addr in
 521                   if MMap.is_C_identifier mem addrp then
 522                     loop (pred_long2 addr)
 523                   else
 524                     MMap.succ_long mem addr
 525                 in
 526                 loop addr
 527             ) addrs in
 528
 529             (* Also look for the end of the symbol table and
 530              * calculate its size.
 531              *)
 532             let base_addrs_sizes = List.map (
 533               fun base_addr ->
 534                 let rec loop addr =
 535                   let addr2 = MMap.succ_long mem addr in
 536                   let addr2p = MMap.follow_pointer mem addr2 in
 537                   if MMap.is_C_identifier mem addr2p then
 538                     loop (MMap.succ_long mem addr2)
 539                   else
 540                     addr
 541                 in
 542                 let end_addr = loop base_addr in
 543                 base_addr, end_addr -^ base_addr
 544             ) base_addrs in
 545
 546             base_addrs_sizes
 547         ) ksym_strings in
 548         let ksymtabs = List.concat ksymtabs in
 549
 550         (* Simply ignore any symbol table candidates which are too small. *)
 551         let ksymtabs = List.filter (fun (_, size) -> size > 64L) ksymtabs in
 552
 553         if debug then (
 554           eprintf "%s: candidate symbol tables at:\n" name;
 555           List.iter (
 556             fun (addr, size) ->
 557               eprintf "\t%Lx\t%Lx\t%!" addr size;
 558               eprintf "first symbol: %s\n%!"
 559                 (MMap.get_string mem
 560                    (MMap.follow_pointer mem
 561                       (MMap.succ_long mem addr)))
 562           ) ksymtabs
 563         );
 564
 565         (* Vote for the most popular symbol table candidate and from this
 566          * generate a function to look up ksyms.
 567          *)
 568         let lookup_ksym =
 569           let freqs = frequency ksymtabs in
 570           match freqs with
 571           | [] ->
 572               eprintf (f_"%s: cannot find start of kernel symbol table\n") name;
 573               (fun _ -> raise Not_found)
 574
 575           | (_, (ksymtab_addr, ksymtab_size)) :: _ ->
 576               if debug then
 577                 eprintf
 578                   "%s: Kernel symbol table found at %Lx, size %Lx bytes\n%!"
 579                   name ksymtab_addr ksymtab_size;
 580
 581               (* Load the whole symbol table as a bitstring. *)
 582               let ksymtab =
 583                 Bitmatch.bitstring_of_string
 584                   (MMap.get_bytes mem ksymtab_addr
 585                      (Int64.to_int ksymtab_size)) in
 586
 587               (* Function to look up an address in the symbol table. *)
 588               let lookup_ksym sym =
 589                 let bits = bits_of_wordsize (MMap.get_wordsize mem) in
 590                 let e = MMap.get_endian mem in
 591                 let rec loop bs =
 592                   bitmatch bs with
 593                   | { value : bits : endian(e);
 594                       name_ptr : bits : endian(e) }
 595                       when MMap.get_string mem name_ptr = sym ->
 596                       value
 597                   | { _ : bits : endian(e);
 598                       _ : bits : endian(e);
 599                       bs : -1 : bitstring } ->
 600                       loop bs
 601                   | { _ } -> raise Not_found
 602                 in
 603                 loop ksymtab
 604               in
 605
 606               lookup_ksym
 607         in
 608
 609         if debug then (
 610           let end_t = gettimeofday () in
 611           eprintf "timing: searching for ordinary ksyms took %f seconds\n%!"
 612             (end_t -. start_t)
 613         );
 614
 615         let start_t = gettimeofday () in
 616
 617         (* Now try to find the /proc/kallsyms table.  This is in an odd
 618          * compressed format (but not a very successful compression
 619          * format).  However if it exists we know that it will contain
 620          * addresses of the common ksyms above, and it has some
 621          * characteristics which make it easy to detect in the
 622          * memory.
 623          *
 624          * kallsyms contains a complete list of symbols so is much
 625          * more useful than the basic list of exports.
 626          *)
 627         let ksym_addrs = List.filter_map (
 628           fun ksym -> try Some (lookup_ksym ksym) with Not_found -> None
 629         ) common_ksyms in
 630
 631         (* Search for those kernel addresses in the image.  We're looking
 632          * for the table kallsyms_addresses followed by kallsyms_num_syms
 633          * (number of symbols in the table).
 634          *)
 635         let ksym_addrs = List.map (MMap.find_pointer_all mem) ksym_addrs in
 636         let ksym_addrs = List.concat ksym_addrs in
 637
 638         (* Test each one to see if it's a candidate list of kernel
 639          * addresses followed by length of list.
 640          *)
 641         let kallsymtabs = List.filter_map (
 642           fun addr ->
 643             (* Search upwards from address until we find the length field.
 644              * If found, jump backwards by length and check all addresses.
 645              *)
 646             if debug then
 647               eprintf "%s: testing candidate kallsyms at %Lx\n" name addr;
 648             let rec loop addr =
 649               let addrp = MMap.follow_pointer mem addr in
 650               if MMap.is_mapped mem addrp then
 651                 loop (MMap.succ_long mem addr) (* continue up the table *)
 652               else
 653                 if addrp >= min_kallsyms_tabsize &&
 654                   addrp <= max_kallsyms_tabsize then (
 655                   (* addrp might be the symbol count.  Count backwards and
 656                    * check the full table.
 657                    *)
 658                   let num_entries = Int64.to_int addrp in
 659                   let entry_size = bytes_of_wordsize (MMap.get_wordsize mem) in
 660                   let start_addr =
 661                     addr -^ Int64.of_int (entry_size * num_entries) in
 662                   let end_addr = addr in
 663                   let rec loop2 addr =
 664                     if addr < end_addr then (
 665                       let addrp = MMap.follow_pointer mem addr in
 666                       if MMap.is_mapped mem addrp then
 667                         loop2 (MMap.succ_long mem addr)
 668                       else
 669                         None (* can't verify the full address table *)
 670                     ) else
 671                       (* ok! *)
 672                       let names_addr = MMap.succ_long mem end_addr in
 673                       if debug then
 674                         eprintf "%s: candidate kallsyms found at %Lx (names_addr at %Lx, num_entries %d)\n"
 675                           name start_addr names_addr num_entries;
 676                       Some (start_addr, num_entries, names_addr)
 677                   in
 678                   loop2 start_addr
 679                 )
 680                 else
 681                   None (* forget it *)
 682             in
 683             match loop addr with
 684             | None -> None
 685             | Some (start_addr, num_entries, names_addr) ->
 686                 (* As an additional verification, check the list of
 687                  * kallsyms_names.
 688                  *)
 689                 try
 690                   (* If the first byte is '\000' and is followed by a
 691                    * C identifier, then this is old-school list of
 692                    * symbols with prefix compression as in 2.6.9.
 693                    * Otherwise Huffman-compressed kallsyms as in
 694                    * 2.6.25.
 695                    *)
 696                   if MMap.get_byte mem names_addr = 0 &&
 697                     MMap.is_C_identifier mem (names_addr+^1L) then (
 698                     let names = ref [] in
 699                     let prev = ref "" in
 700                     let rec loop names_addr start_addr num =
 701                       if num > 0 then (
 702                         let prefix = MMap.get_byte mem names_addr in
 703                         let prefix = String.sub !prev 0 prefix in
 704                         let name = MMap.get_string mem (names_addr+^1L) in
 705                         let len = String.length name in
 706                         let name = prefix ^ name in
 707                         prev := name;
 708                         let names_addr = names_addr +^ Int64.of_int len +^ 2L in
 709                         let sym_value = MMap.follow_pointer mem start_addr in
 710                         let start_addr = MMap.succ_long mem start_addr in
 711                         (*eprintf "%S -> %Lx\n" name sym_value;*)
 712                         names := (name, sym_value) :: !names;
 713                         loop names_addr start_addr (num-1)
 714                       )
 715                     in
 716                     loop names_addr start_addr num_entries;
 717                     let names = List.rev !names in
 718
 719                     Some (start_addr, num_entries, names_addr,
 720                           Uncompressed names)
 721                     )
 722                   else ( (* new-style "compressed" names. *)
 723                     let compressed_names = ref [] in
 724                     let rec loop names_addr start_addr num =
 725                       if num > 0 then (
 726                         let len = MMap.get_byte mem names_addr in
 727                         let name = MMap.get_bytes mem (names_addr+^1L) len in
 728                         let names_addr = names_addr +^ Int64.of_int len +^ 1L in
 729                         let sym_value = MMap.follow_pointer mem start_addr in
 730                         let start_addr = MMap.succ_long mem start_addr in
 731                         compressed_names :=
 732                           (name, sym_value) :: !compressed_names;
 733                         loop names_addr start_addr (num-1)
 734                       ) else
 735                         names_addr
 736                     in
 737                     let markers_addr = loop names_addr start_addr num_entries in
 738                     let markers_addr = MMap.align mem markers_addr in
 739                     let compressed_names = List.rev !compressed_names in
 740
 741                     Some (start_addr, num_entries, names_addr,
 742                           Compressed (compressed_names, markers_addr))
 743                   )
 744                 with
 745                   Invalid_argument _ -> None (* bad names list *)
 746         ) ksym_addrs in
 747
 748         if debug then (
 749           eprintf "%s: candidate kallsyms at:\n" name;
 750           List.iter (
 751             function
 752             | (start_addr, num_entries, names_addr, Uncompressed _) ->
 753                 eprintf "\t%Lx %d entries names_addr=%Lx old-style\n%!"
 754                   start_addr num_entries names_addr
 755             | (start_addr, num_entries, names_addr,
 756                Compressed (_, markers_addr)) ->
 757                 eprintf "\t%Lx %d entries names_addr=%Lx markers_addr=%Lx\n%!"
 758                   start_addr num_entries names_addr markers_addr
 759           ) kallsymtabs
 760         );
 761
 762         (* Vote for the most popular symbol table candidate and
 763          * enhance the function for looking up ksyms.
 764          *)
 765         let lookup_ksym =
 766           let freqs = frequency kallsymtabs in
 767           match freqs with
 768           | [] ->
 769               (* Can't find any kallsymtabs, just return the lookup_ksym
 770                * function generated previously from the exported symbols.
 771                *)
 772               lookup_ksym
 773
 774           | (_, (_, _, _, Uncompressed names)) :: _ ->
 775               let lookup_ksym name =
 776                 try (* first look it up in kallsyms table. *)
 777                   List.assoc name names
 778                 with Not_found -> (* try the old exports table instead *)
 779                   lookup_ksym name
 780               in
 781               lookup_ksym
 782
 783           | (_, (start_addr, num_entries, names_addr,
 784                  Compressed (compressed_names, markers_addr))) :: _ ->
 785               (* Skip the markers and look for the token table. *)
 786               let num_markers = Int64.of_int ((num_entries + 255) / 256) in
 787               let marker_size =
 788                 Int64.of_int (bytes_of_wordsize (MMap.get_wordsize mem)) in
 789               let tokens_addr = markers_addr +^ marker_size *^ num_markers in
 790
 791               (* Now read out the compression tokens, which are just
 792                * 256 ASCIIZ strings that map bytes in the compression
 793                * names to substrings.
 794                *)
 795               let tokens = Array.make 256 "" in
 796               let rec loop i addr =
 797                 if i < 256 then (
 798                   let str = MMap.get_string mem addr in
 799                   let len = String.length str in
 800                   let addr = addr +^ Int64.of_int (len+1) in
 801                   tokens.(i) <- str;
 802                   loop (i+1) addr
 803                 )
 804               in
 805               loop 0 tokens_addr;
 806
 807               (* Expand the compressed names using the tokens. *)
 808               let names = List.filter_map (
 809                 fun (name, sym_value) ->
 810                   let f c = tokens.(Char.code c) in
 811                   let name = String.replace_chars f name in
 812                   (* First character in uncompressed output is the symbol
 813                    * type, eg. 'T'/'t' for text etc.
 814                    *)
 815                   (* NOTE: Symbol names are NOT unique
 816                    * (eg. 'con_start' is both a function and data in
 817                    * some kernels).  XXX We need to handle this situation
 818                    * better.
 819                    *)
 820                   (*let typ = name.[0] in*)
 821                   let name = String.sub name 1 (String.length name - 1) in
 822                   (*eprintf "%S -> %Lx\n" name sym_value;*)
 823                   Some (name, sym_value)
 824               ) compressed_names in
 825
 826               let lookup_ksym name =
 827                 try (* first look it up in kallsyms table. *)
 828                   List.assoc name names
 829                 with Not_found -> (* try the old exports table instead *)
 830                   lookup_ksym name
 831               in
 832
 833               lookup_ksym in
 834
 835         if debug then (
 836           let end_t = gettimeofday () in
 837           eprintf "timing: searching for kallsyms took %f seconds\n%!"
 838             (end_t -. start_t)
 839         );
 840
 841         (* Just wrap the lookup_ksym call in something which prints
 842          * the query when debug is set.
 843          *)
 844         let lookup_ksym =
 845           if debug then
 846             let lookup_ksym sym =
 847               try
 848                 let value = lookup_ksym sym in
 849                 eprintf "lookup_ksym %S = %Lx\n%!" sym value;
 850                 value
 851               with Not_found ->
 852                 eprintf "lookup_ksym %S failed\n%!" sym;
 853                 raise Not_found
 854             in
 855             lookup_ksym
 856           else
 857             lookup_ksym
 858         in
 859
 860         ((name, arch, mem, lookup_ksym) : image)
 861     ) images in
 862
 863   (* Run the actual tool. *)
 864   run_fn debug images