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 let start usage_msg =
  56   (* Debug messages. *)
  57   let debug = ref false in
  58
  59   (* Default wordsize. *)
  60   let def_wordsize = ref None in
  61   let set_wordsize = function
  62     | "32" -> def_wordsize := Some W32
  63     | "64" -> def_wordsize := Some W64
  64     | "auto" -> def_wordsize := None
  65     | str -> failwith (sprintf (f_"set_wordsize: %s: unknown wordsize") str)
  66   in
  67
  68   (* Default endianness. *)
  69   let def_endian = ref None in
  70   let set_endian = function
  71     | "auto" -> def_endian := None
  72     | "le" | "little" | "littleendian" | "intel" ->
  73         def_endian := Some Bitmatch.LittleEndian
  74     | "be" | "big" | "bigendian" | "motorola" ->
  75         def_endian := Some Bitmatch.BigEndian
  76     | str -> failwith (sprintf (f_"set_endian: %s: unknown endianness") str)
  77   in
  78
  79   (* Default architecture. *)
  80   let def_architecture = ref None in
  81   let set_architecture = function
  82     | "auto" -> def_architecture := None
  83     | arch ->
  84         let arch = architecture_of_string arch in
  85         def_architecture := Some arch;
  86         def_endian := Some (endian_of_architecture arch);
  87         def_wordsize := Some (wordsize_of_architecture arch)
  88   in
  89
  90   (* Default text address. *)
  91   let def_text_addr = ref 0L (* 0 = auto-detect *) in
  92   let set_text_addr = function
  93     | "auto" -> def_text_addr := 0L
  94     | "i386" -> def_text_addr := 0xc010_0000_L (* common for x86 *)
  95     | "x86-64"|"x86_64" -> def_text_addr := 0xffffffff_81000000_L (* x86-64? *)
  96     | str -> def_text_addr := Int64.of_string str
  97   in
  98
  99   (* List of kernel images. *)
 100   let images = ref [] in
 101   let uri = ref "" in
 102   let anon_args = ref [] in
 103
 104   let memory_image filename =
 105     images :=
 106       (!def_wordsize, !def_endian, !def_architecture, !def_text_addr, filename)
 107     :: !images
 108   in
 109
 110   let version () =
 111     printf "virt-mem %s\n" Virt_mem_version.version;
 112
 113     let major, minor, release =
 114       let v, _ = Libvirt.get_version () in
 115       v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
 116     printf "libvirt %d.%d.%d\n" major minor release;
 117     exit 0
 118   in
 119
 120   let argspec = Arg.align [
 121     "-A", Arg.String set_architecture,
 122       "arch " ^ s_"Set kernel architecture, endianness and word size";
 123     "-E", Arg.String set_endian,
 124       "endian " ^ s_"Set kernel endianness";
 125     "-T", Arg.String set_text_addr,
 126       "addr " ^ s_"Set kernel text address";
 127     "-W", Arg.String set_wordsize,
 128       "addr " ^ s_"Set kernel word size";
 129     "-c", Arg.Set_string uri,
 130       "uri " ^ s_ "Connect to URI";
 131     "--connect", Arg.Set_string uri,
 132       "uri " ^ s_ "Connect to URI";
 133     "--debug", Arg.Set debug,
 134       " " ^ s_"Debug mode (default: false)";
 135     "-t", Arg.String memory_image,
 136       "image " ^ s_"Use saved kernel memory image";
 137     "--version", Arg.Unit version,
 138       " " ^ s_"Display version and exit";
 139   ] in
 140
 141   let anon_arg str = anon_args := str :: !anon_args in
 142   let usage_msg = usage_msg ^ s_"\n\nOPTIONS" in
 143   Arg.parse argspec anon_arg usage_msg;
 144
 145   let images = !images in
 146   let debug = !debug in
 147   let uri = if !uri = "" then None else Some !uri in
 148   let anon_args = List.rev !anon_args in
 149
 150   (* Get the kernel images. *)
 151   let images =
 152     if images = [] then (
 153       let conn =
 154         let name = uri in
 155         try C.connect_readonly ?name ()
 156         with Libvirt.Virterror err ->
 157           prerr_endline (Libvirt.Virterror.to_string err);
 158           (* If non-root and no explicit connection URI, print a warning. *)
 159           if Unix.geteuid () <> 0 && name = None then (
 160             print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
 161           );
 162           exit 1 in
 163
 164       (* If we have a list of parameters, then it is the domain names / UUIDs /
 165        * IDs ONLY that we wish to display.  Otherwise, display all active.
 166        *)
 167       let doms =
 168         if anon_args = [] then (
 169           (* List of active domains. *)
 170           let nr_active_doms = C.num_of_domains conn in
 171           let active_doms =
 172             Array.to_list (C.list_domains conn nr_active_doms) in
 173           List.map (D.lookup_by_id conn) active_doms
 174         ) else (
 175           List.map (
 176             fun arg ->
 177               let dom =
 178                 try D.lookup_by_uuid_string conn arg
 179                 with _ ->
 180                   try D.lookup_by_name conn arg
 181                   with _ ->
 182                     try D.lookup_by_id conn (int_of_string arg)
 183                     with _ ->
 184                       failwith (sprintf (f_"%s: unknown domain (not a UUID, name or ID of any active domain)") arg) in
 185
 186               (* XXX Primitive test to see if the domain is active. *)
 187               let is_active = try D.get_id dom >= 0 with _ -> false in
 188               if not is_active then
 189                 failwith (sprintf (f_"%s: domain is not running") arg);
 190
 191               dom
 192           ) anon_args
 193         ) in
 194
 195       (* Get their XML. *)
 196       let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
 197
 198       (* Parse the XML. *)
 199       let xmls = List.map (fun (dom, xml) ->
 200                              dom, Xml.parse_string xml) xmls in
 201
 202       (* XXX Do something with the XML XXX
 203        * such as detecting arch, wordsize, endianness.
 204        * XXXXXXXXXXXXXX
 205        *
 206        *
 207        *
 208        *)
 209
 210
 211       List.map (
 212         fun (dom, _) ->
 213           let name = D.get_name dom in
 214
 215           let wordsize =
 216             match !def_wordsize with
 217             | None ->
 218                 failwith
 219                   (sprintf (f_"%s: use -W to define word size for this image")
 220                      name);
 221             | Some ws -> ws in
 222           let endian =
 223             match !def_endian with
 224             | None ->
 225                 failwith
 226                   (sprintf (f_"%s: use -E to define endianness for this image")
 227                      name);
 228             | Some e -> e in
 229
 230           let arch =
 231             match !def_architecture with
 232             | Some I386 -> I386 | Some X86_64 -> X86_64
 233             | _ ->
 234                 failwith
 235                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") name) in
 236
 237           if !def_text_addr = 0L then
 238             failwith
 239               (sprintf (f_"%s: use -T to define kernel load address for this image") name);
 240
 241           let start_t = gettimeofday () in
 242
 243           (* Read the kernel memory.
 244            * Maximum 64K can be read over remote connections.
 245            *)
 246           let str = String.create kernel_size in
 247           let rec loop i =
 248             let remaining = kernel_size - i in
 249             if remaining > 0 then (
 250               let size = min remaining max_memory_peek in
 251               D.memory_peek dom [D.Virtual]
 252                 (!def_text_addr +^ Int64.of_int i) size str i;
 253               loop (i + size)
 254             )
 255           in
 256           loop 0;
 257
 258           if debug then (
 259             let end_t = gettimeofday () in
 260             eprintf "timing: downloading kernel took %f seconds\n%!"
 261               (end_t -. start_t)
 262           );
 263
 264           (* Map the virtual memory. *)
 265           let mem = MMap.of_string str !def_text_addr in
 266
 267           (* Force the wordsize and endianness. *)
 268           let mem = MMap.set_wordsize mem wordsize in
 269           let mem = MMap.set_endian mem endian in
 270
 271           (name, arch, mem)
 272       ) xmls
 273     ) else (
 274       (* One or more -t options passed. *)
 275       if anon_args <> [] then
 276         failwith (s_"virt-mem: if -t given on command line, then no domain arguments should be listed");
 277
 278       List.map (
 279         fun (wordsize, endian, arch, text_addr, filename) ->
 280           (* Quite a lot of limitations on the kernel images we can
 281            * handle at the moment ...
 282            *)
 283           (* XXX We could auto-detect wordsize easily. *)
 284           let wordsize =
 285             match wordsize with
 286             | None ->
 287                 failwith
 288                   (sprintf (f_"%s: use -W to define word size for this image")
 289                      filename);
 290             | Some ws -> ws in
 291           let endian =
 292             match endian with
 293             | None ->
 294                 failwith
 295                   (sprintf (f_"%s: use -E to define endianness for this image")
 296                      filename);
 297             | Some e -> e in
 298
 299           let arch =
 300             match arch with
 301             | Some I386 -> I386 | Some X86_64 -> X86_64
 302             | _ ->
 303                 failwith
 304                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") filename) in
 305
 306           if text_addr = 0L then
 307             failwith
 308               (sprintf (f_"%s: use -T to define kernel load address for this image")
 309                  filename);
 310
 311           (* Map the virtual memory. *)
 312           let fd = openfile filename [O_RDONLY] 0 in
 313           let mem = MMap.of_file fd text_addr in
 314
 315           (* Force the wordsize and endianness. *)
 316           let mem = MMap.set_wordsize mem wordsize in
 317           let mem = MMap.set_endian mem endian in
 318
 319           (filename, arch, mem)
 320       ) images
 321     ) in
 322
 323   let images =
 324     List.map (
 325       fun (name, arch, mem) ->
 326         (* Look for some common entries in the exported symbol table and
 327          * from that find the symbol table itself.  These are just
 328          * supposed to be symbols which are very likely to be present
 329          * in any Linux kernel, although we only need one of them to be
 330          * present to find the symbol table.
 331          *
 332          * NB. Must not be __initdata, must be in EXPORT_SYMBOL.
 333          *)
 334         let common_ksyms = [
 335           "init_task";                  (* first task_struct *)
 336           "root_mountflags";            (* flags for mounting root fs *)
 337           "init_uts_ns";                (* uname strings *)
 338           "sys_open";                   (* open(2) entry point *)
 339           "sys_chdir";                  (* chdir(2) entry point *)
 340           "sys_chroot";                 (* chroot(2) entry point *)
 341           "sys_umask";                  (* umask(2) entry point *)
 342           "schedule";                   (* scheduler entry point *)
 343         ] in
 344         (* Searching for <NUL>string<NUL> *)
 345         let common_ksyms_nul = List.map (sprintf "\000%s\000") common_ksyms in
 346
 347         let start_t = gettimeofday () in
 348
 349         (* Search for these strings in the memory image. *)
 350         let ksym_strings = List.map (MMap.find_all mem) common_ksyms_nul in
 351         let ksym_strings = List.concat ksym_strings in
 352         (* Adjust found addresses to start of the string (skip <NUL>). *)
 353         let ksym_strings = List.map Int64.succ ksym_strings in
 354
 355         if debug then (
 356           let end_t = gettimeofday () in
 357           eprintf "timing: searching for common_ksyms took %f seconds\n%!"
 358             (end_t -. start_t)
 359         );
 360
 361         let start_t = gettimeofday () in
 362
 363         (* For any we found, try to look up the symbol table
 364          * base addr and size.
 365          *)
 366         let ksymtabs = List.map (
 367           fun addr ->
 368             (* Search for 'addr' appearing in the image. *)
 369             let addrs = MMap.find_pointer_all mem addr in
 370
 371             (* Now consider each of these addresses and search back
 372              * until we reach the beginning of the (possible) symbol
 373              * table.
 374              *
 375              * Kernel symbol table struct is:
 376              * struct kernel_symbol {
 377              *   unsigned long value;
 378              *   const char *name;    <-- initial pointer
 379              * } symbols[];
 380              *)
 381             let pred_long2 addr =
 382               MMap.pred_long mem (MMap.pred_long mem addr)
 383             in
 384             let base_addrs = List.map (
 385               fun addr ->
 386                 let rec loop addr =
 387                   (* '*addr' should point to a C identifier.  If it does,
 388                    * step backwards to the previous symbol table entry.
 389                    *)
 390                   let addrp = MMap.follow_pointer mem addr in
 391                   if MMap.is_C_identifier mem addrp then
 392                     loop (pred_long2 addr)
 393                   else
 394                     MMap.succ_long mem addr
 395                 in
 396                 loop addr
 397             ) addrs in
 398
 399             (* Also look for the end of the symbol table and
 400              * calculate its size.
 401              *)
 402             let base_addrs_sizes = List.map (
 403               fun base_addr ->
 404                 let rec loop addr =
 405                   let addr2 = MMap.succ_long mem addr in
 406                   let addr2p = MMap.follow_pointer mem addr2 in
 407                   if MMap.is_C_identifier mem addr2p then
 408                     loop (MMap.succ_long mem addr2)
 409                   else
 410                     addr
 411                 in
 412                 let end_addr = loop base_addr in
 413                 base_addr, end_addr -^ base_addr
 414             ) base_addrs in
 415
 416             base_addrs_sizes
 417         ) ksym_strings in
 418         let ksymtabs = List.concat ksymtabs in
 419
 420         (* Simply ignore any symbol table candidates which are too small. *)
 421         let ksymtabs = List.filter (fun (_, size) -> size > 64L) ksymtabs in
 422
 423         if debug then (
 424           eprintf "%s: candidate symbol tables at:\n" name;
 425           List.iter (
 426             fun (addr, size) ->
 427               eprintf "\t%Lx\t%Lx\t%!" addr size;
 428               eprintf "first symbol: %s\n%!"
 429                 (MMap.get_string mem
 430                    (MMap.follow_pointer mem
 431                       (MMap.succ_long mem addr)))
 432           ) ksymtabs
 433         );
 434
 435         (* Vote for the most popular symbol table candidate and from this
 436          * generate a function to look up ksyms.
 437          *)
 438         let lookup_ksym =
 439           let freqs = frequency ksymtabs in
 440           match freqs with
 441           | [] ->
 442               eprintf (f_"%s: cannot find start of kernel symbol table\n") name;
 443               (fun _ -> raise Not_found)
 444
 445           | (_, (ksymtab_addr, ksymtab_size)) :: _ ->
 446               if debug then
 447                 eprintf
 448                   "%s: Kernel symbol table found at %Lx, size %Lx bytes\n%!"
 449                   name ksymtab_addr ksymtab_size;
 450
 451               (* Load the whole symbol table as a bitstring. *)
 452               let ksymtab =
 453                 Bitmatch.bitstring_of_string
 454                   (MMap.get_bytes mem ksymtab_addr
 455                      (Int64.to_int ksymtab_size)) in
 456
 457               (* Function to look up an address in the symbol table. *)
 458               let lookup_ksym sym =
 459                 let bits = bits_of_wordsize (MMap.get_wordsize mem) in
 460                 let e = MMap.get_endian mem in
 461                 let rec loop bs =
 462                   bitmatch bs with
 463                   | { value : bits : endian(e);
 464                       name_ptr : bits : endian(e) }
 465                       when MMap.get_string mem name_ptr = sym ->
 466                       value
 467                   | { _ : bits : endian(e);
 468                       _ : bits : endian(e);
 469                       bs : -1 : bitstring } ->
 470                       loop bs
 471                   | { _ } -> raise Not_found
 472                 in
 473                 loop ksymtab
 474               in
 475
 476               lookup_ksym
 477         in
 478
 479         if debug then (
 480           let end_t = gettimeofday () in
 481           eprintf "timing: searching for ordinary ksyms took %f seconds\n%!"
 482             (end_t -. start_t)
 483         );
 484
 485         let start_t = gettimeofday () in
 486
 487         (* Now try to find the /proc/kallsyms table.  This is in an odd
 488          * compressed format (but not a very successful compression
 489          * format).  However if it exists we know that it will contain
 490          * addresses of the common ksyms above, and it has some
 491          * characteristics which make it easy to detect in the
 492          * memory.
 493          *
 494          * kallsyms contains a complete list of symbols so is much
 495          * more useful than the basic list of exports.
 496          *)
 497         let ksym_addrs = List.filter_map (
 498           fun ksym -> try Some (lookup_ksym ksym) with Not_found -> None
 499         ) common_ksyms in
 500
 501         (* Search for those kernel addresses in the image.  We're looking
 502          * for the table kallsyms_addresses followed by kallsyms_num_syms
 503          * (number of symbols in the table).
 504          *)
 505         let ksym_addrs = List.map (MMap.find_pointer_all mem) ksym_addrs in
 506         let ksym_addrs = List.concat ksym_addrs in
 507
 508         (* Test each one to see if it's a candidate list of kernel
 509          * addresses followed by length of list.
 510          *)
 511         let kallsymtabs = List.filter_map (
 512           fun addr ->
 513             (* Search upwards from address until we find the length field.
 514              * If found, jump backwards by length and check all addresses.
 515              *)
 516             if debug then
 517               eprintf "%s: testing candidate kallsyms at %Lx\n" name addr;
 518             let rec loop addr =
 519               let addrp = MMap.follow_pointer mem addr in
 520               if MMap.is_mapped mem addrp then
 521                 loop (MMap.succ_long mem addr) (* continue up the table *)
 522               else
 523                 if addrp >= min_kallsyms_tabsize &&
 524                   addrp <= max_kallsyms_tabsize then (
 525                   (* addrp might be the symbol count.  Count backwards and
 526                    * check the full table.
 527                    *)
 528                   let num_entries = Int64.to_int addrp in
 529                   let entry_size = bytes_of_wordsize (MMap.get_wordsize mem) in
 530                   let start_addr =
 531                     addr -^ Int64.of_int (entry_size * num_entries) in
 532                   let end_addr = addr in
 533                   let rec loop2 addr =
 534                     if addr < end_addr then (
 535                       let addrp = MMap.follow_pointer mem addr in
 536                       if MMap.is_mapped mem addrp then
 537                         loop2 (MMap.succ_long mem addr)
 538                       else
 539                         None (* can't verify the full address table *)
 540                     ) else
 541                       (* ok! *)
 542                       let names_addr = MMap.succ_long mem end_addr in
 543                       if debug then
 544                         eprintf "%s: candidate kallsyms found at %Lx (names_addr at %Lx, num_entries %d)\n"
 545                           name start_addr names_addr num_entries;
 546                       Some (start_addr, num_entries, names_addr)
 547                   in
 548                   loop2 start_addr
 549                 )
 550                 else
 551                   None (* forget it *)
 552             in
 553             match loop addr with
 554             | None -> None
 555             | Some (start_addr, num_entries, names_addr) ->
 556                 (* As an additional verification, check the list of
 557                  * kallsyms_names.
 558                  *)
 559                 try
 560                   (* If the first byte is '\000' and is followed by a
 561                    * C identifier, then this is old-school list of
 562                    * symbols with prefix compression as in 2.6.9.
 563                    * Otherwise Huffman-compressed kallsyms as in
 564                    * 2.6.25.
 565                    *)
 566                   if MMap.get_byte mem names_addr = 0 &&
 567                     MMap.is_C_identifier mem (names_addr+^1L) then (
 568                     let names = ref [] in
 569                     let prev = ref "" in
 570                     let rec loop names_addr start_addr num =
 571                       if num > 0 then (
 572                         let prefix = MMap.get_byte mem names_addr in
 573                         let prefix = String.sub !prev 0 prefix in
 574                         let name = MMap.get_string mem (names_addr+^1L) in
 575                         let len = String.length name in
 576                         let name = prefix ^ name in
 577                         prev := name;
 578                         let names_addr = names_addr +^ Int64.of_int len +^ 2L in
 579                         let sym_value = MMap.follow_pointer mem start_addr in
 580                         let start_addr = MMap.succ_long mem start_addr in
 581                         (*eprintf "%S -> %Lx\n" name sym_value;*)
 582                         names := (name, sym_value) :: !names;
 583                         loop names_addr start_addr (num-1)
 584                       )
 585                     in
 586                     loop names_addr start_addr num_entries;
 587                     let names = List.rev !names in
 588
 589                     Some (start_addr, num_entries, names_addr,
 590                           Uncompressed names)
 591                     )
 592                   else ( (* new-style "compressed" names. *)
 593                     let compressed_names = ref [] in
 594                     let rec loop names_addr start_addr num =
 595                       if num > 0 then (
 596                         let len = MMap.get_byte mem names_addr in
 597                         let name = MMap.get_bytes mem (names_addr+^1L) len in
 598                         let names_addr = names_addr +^ Int64.of_int len +^ 1L in
 599                         let sym_value = MMap.follow_pointer mem start_addr in
 600                         let start_addr = MMap.succ_long mem start_addr in
 601                         compressed_names :=
 602                           (name, sym_value) :: !compressed_names;
 603                         loop names_addr start_addr (num-1)
 604                       ) else
 605                         names_addr
 606                     in
 607                     let markers_addr = loop names_addr start_addr num_entries in
 608                     let markers_addr = MMap.align mem markers_addr in
 609                     let compressed_names = List.rev !compressed_names in
 610
 611                     Some (start_addr, num_entries, names_addr,
 612                           Compressed (compressed_names, markers_addr))
 613                   )
 614                 with
 615                   Invalid_argument _ -> None (* bad names list *)
 616         ) ksym_addrs in
 617
 618         if debug then (
 619           eprintf "%s: candidate kallsyms at:\n" name;
 620           List.iter (
 621             function
 622             | (start_addr, num_entries, names_addr, Uncompressed _) ->
 623                 eprintf "\t%Lx %d entries names_addr=%Lx old-style\n%!"
 624                   start_addr num_entries names_addr
 625             | (start_addr, num_entries, names_addr,
 626                Compressed (_, markers_addr)) ->
 627                 eprintf "\t%Lx %d entries names_addr=%Lx markers_addr=%Lx\n%!"
 628                   start_addr num_entries names_addr markers_addr
 629           ) kallsymtabs
 630         );
 631
 632         (* Vote for the most popular symbol table candidate and
 633          * enhance the function for looking up ksyms.
 634          *)
 635         let lookup_ksym =
 636           let freqs = frequency kallsymtabs in
 637           match freqs with
 638           | [] ->
 639               (* Can't find any kallsymtabs, just return the lookup_ksym
 640                * function generated previously from the exported symbols.
 641                *)
 642               lookup_ksym
 643
 644           | (_, (_, _, _, Uncompressed names)) :: _ ->
 645               let lookup_ksym name =
 646                 try (* first look it up in kallsyms table. *)
 647                   List.assoc name names
 648                 with Not_found -> (* try the old exports table instead *)
 649                   lookup_ksym name
 650               in
 651               lookup_ksym
 652
 653           | (_, (start_addr, num_entries, names_addr,
 654                  Compressed (compressed_names, markers_addr))) :: _ ->
 655               (* Skip the markers and look for the token table. *)
 656               let num_markers = Int64.of_int ((num_entries + 255) / 256) in
 657               let marker_size =
 658                 Int64.of_int (bytes_of_wordsize (MMap.get_wordsize mem)) in
 659               let tokens_addr = markers_addr +^ marker_size *^ num_markers in
 660
 661               (* Now read out the compression tokens, which are just
 662                * 256 ASCIIZ strings that map bytes in the compression
 663                * names to substrings.
 664                *)
 665               let tokens = Array.make 256 "" in
 666               let rec loop i addr =
 667                 if i < 256 then (
 668                   let str = MMap.get_string mem addr in
 669                   let len = String.length str in
 670                   let addr = addr +^ Int64.of_int (len+1) in
 671                   tokens.(i) <- str;
 672                   loop (i+1) addr
 673                 )
 674               in
 675               loop 0 tokens_addr;
 676
 677               (* Expand the compressed names using the tokens. *)
 678               let names = List.filter_map (
 679                 fun (name, sym_value) ->
 680                   let f c = tokens.(Char.code c) in
 681                   let name = String.replace_chars f name in
 682                   (* First character in uncompressed output is the symbol
 683                    * type, eg. 'T'/'t' for text etc.
 684                    *)
 685                   (* NOTE: Symbol names are NOT unique
 686                    * (eg. 'con_start' is both a function and data in
 687                    * some kernels).  XXX We need to handle this situation
 688                    * better.
 689                    *)
 690                   (*let typ = name.[0] in*)
 691                   let name = String.sub name 1 (String.length name - 1) in
 692                   (*eprintf "%S -> %Lx\n" name sym_value;*)
 693                   Some (name, sym_value)
 694               ) compressed_names in
 695
 696               let lookup_ksym name =
 697                 try (* first look it up in kallsyms table. *)
 698                   List.assoc name names
 699                 with Not_found -> (* try the old exports table instead *)
 700                   lookup_ksym name
 701               in
 702
 703               lookup_ksym in
 704
 705         if debug then (
 706           let end_t = gettimeofday () in
 707           eprintf "timing: searching for kallsyms took %f seconds\n%!"
 708             (end_t -. start_t)
 709         );
 710
 711         (* Just wrap the lookup_ksym call in something which prints
 712          * the query when debug is set.
 713          *)
 714         let lookup_ksym =
 715           if debug then
 716             let lookup_ksym sym =
 717               try
 718                 let value = lookup_ksym sym in
 719                 eprintf "lookup_ksym %S = %Lx\n%!" sym value;
 720                 value
 721               with Not_found ->
 722                 eprintf "lookup_ksym %S failed\n%!" sym;
 723                 raise Not_found
 724             in
 725             lookup_ksym
 726           else
 727             lookup_ksym
 728         in
 729
 730         ((name, arch, mem, lookup_ksym) : image)
 731     ) images in
 732
 733   debug, images