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 = 0x1000
  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")
 240                  name);
 241
 242           (* Read the kernel memory.
 243            * Maximum 64K can be read over remote connections.
 244            *)
 245           let str = String.create kernel_size in
 246           let rec loop i =
 247             let remaining = kernel_size - i in
 248             if remaining > 0 then (
 249               let size = min remaining max_memory_peek in
 250               D.memory_peek dom [D.Virtual]
 251                 (!def_text_addr +^ Int64.of_int i) size str i;
 252               loop (i + size)
 253             )
 254           in
 255           loop 0;
 256
 257           (* Map the virtual memory. *)
 258           let mem = MMap.of_string str !def_text_addr in
 259
 260           (* Force the wordsize and endianness. *)
 261           let mem = MMap.set_wordsize mem wordsize in
 262           let mem = MMap.set_endian mem endian in
 263
 264           (name, arch, mem)
 265       ) xmls
 266     ) else (
 267       (* One or more -t options passed. *)
 268       if anon_args <> [] then
 269         failwith (s_"virt-mem: if -t given on command line, then no domain arguments should be listed");
 270
 271       List.map (
 272         fun (wordsize, endian, arch, text_addr, filename) ->
 273           (* Quite a lot of limitations on the kernel images we can
 274            * handle at the moment ...
 275            *)
 276           (* XXX We could auto-detect wordsize easily. *)
 277           let wordsize =
 278             match wordsize with
 279             | None ->
 280                 failwith
 281                   (sprintf (f_"%s: use -W to define word size for this image")
 282                      filename);
 283             | Some ws -> ws in
 284           let endian =
 285             match endian with
 286             | None ->
 287                 failwith
 288                   (sprintf (f_"%s: use -E to define endianness for this image")
 289                      filename);
 290             | Some e -> e in
 291
 292           let arch =
 293             match arch with
 294             | Some I386 -> I386 | Some X86_64 -> X86_64
 295             | _ ->
 296                 failwith
 297                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") filename) in
 298
 299           if text_addr = 0L then
 300             failwith
 301               (sprintf (f_"%s: use -T to define kernel load address for this image")
 302                  filename);
 303
 304           (* Map the virtual memory. *)
 305           let fd = openfile filename [O_RDONLY] 0 in
 306           let mem = MMap.of_file fd text_addr in
 307
 308           (* Force the wordsize and endianness. *)
 309           let mem = MMap.set_wordsize mem wordsize in
 310           let mem = MMap.set_endian mem endian in
 311
 312           (filename, arch, mem)
 313       ) images
 314     ) in
 315
 316   let images =
 317     List.map (
 318       fun (name, arch, mem) ->
 319         (* Look for some common entries in the exported symbol table and
 320          * from that find the symbol table itself.  These are just
 321          * supposed to be symbols which are very likely to be present
 322          * in any Linux kernel, although we only need one of them to be
 323          * present to find the symbol table.
 324          *
 325          * NB. Must not be __initdata, must be in EXPORT_SYMBOL.
 326          *)
 327         let common_ksyms = [
 328           "init_task";                  (* first task_struct *)
 329           "root_mountflags";            (* flags for mounting root fs *)
 330           "init_uts_ns";                (* uname strings *)
 331           "sys_open";                   (* open(2) entry point *)
 332           "sys_chdir";                  (* chdir(2) entry point *)
 333           "sys_chroot";                 (* chroot(2) entry point *)
 334           "sys_umask";                  (* umask(2) entry point *)
 335           "schedule";                   (* scheduler entry point *)
 336         ] in
 337         (* Searching for <NUL>string<NUL> *)
 338         let common_ksyms_nul = List.map (sprintf "\000%s\000") common_ksyms in
 339
 340         (* Search for these strings in the memory image. *)
 341         let ksym_strings = List.map (MMap.find_all mem) common_ksyms_nul in
 342         let ksym_strings = List.concat ksym_strings in
 343         (* Adjust found addresses to start of the string (skip <NUL>). *)
 344         let ksym_strings = List.map Int64.succ ksym_strings in
 345
 346         (* For any we found, try to look up the symbol table
 347          * base addr and size.
 348          *)
 349         let ksymtabs = List.map (
 350           fun addr ->
 351             (* Search for 'addr' appearing in the image. *)
 352             let addrs = MMap.find_pointer_all mem addr in
 353
 354             (* Now consider each of these addresses and search back
 355              * until we reach the beginning of the (possible) symbol
 356              * table.
 357              *
 358              * Kernel symbol table struct is:
 359              * struct kernel_symbol {
 360              *   unsigned long value;
 361              *   const char *name;    <-- initial pointer
 362              * } symbols[];
 363              *)
 364             let pred_long2 addr =
 365               MMap.pred_long mem (MMap.pred_long mem addr)
 366             in
 367             let base_addrs = List.map (
 368               fun addr ->
 369                 let rec loop addr =
 370                   (* '*addr' should point to a C identifier.  If it does,
 371                    * step backwards to the previous symbol table entry.
 372                    *)
 373                   let addrp = MMap.follow_pointer mem addr in
 374                   if MMap.is_C_identifier mem addrp then
 375                     loop (pred_long2 addr)
 376                   else
 377                     MMap.succ_long mem addr
 378                 in
 379                 loop addr
 380             ) addrs in
 381
 382             (* Also look for the end of the symbol table and
 383              * calculate its size.
 384              *)
 385             let base_addrs_sizes = List.map (
 386               fun base_addr ->
 387                 let rec loop addr =
 388                   let addr2 = MMap.succ_long mem addr in
 389                   let addr2p = MMap.follow_pointer mem addr2 in
 390                   if MMap.is_C_identifier mem addr2p then
 391                     loop (MMap.succ_long mem addr2)
 392                   else
 393                     addr
 394                 in
 395                 let end_addr = loop base_addr in
 396                 base_addr, end_addr -^ base_addr
 397             ) base_addrs in
 398
 399             base_addrs_sizes
 400         ) ksym_strings in
 401         let ksymtabs = List.concat ksymtabs in
 402
 403         (* Simply ignore any symbol table candidates which are too small. *)
 404         let ksymtabs = List.filter (fun (_, size) -> size > 64L) ksymtabs in
 405
 406         if debug then (
 407           printf "%s: candidate symbol tables at:\n" name;
 408           List.iter (
 409             fun (addr, size) ->
 410               printf "\t%Lx\t%Lx\t%!" addr size;
 411               printf "first symbol: %s\n%!"
 412                 (MMap.get_string mem
 413                    (MMap.follow_pointer mem
 414                       (MMap.succ_long mem addr)))
 415           ) ksymtabs
 416         );
 417
 418         (* Vote for the most popular symbol table candidate and from this
 419          * generate a function to look up ksyms.
 420          *)
 421         let lookup_ksym =
 422           let freqs = frequency ksymtabs in
 423           match freqs with
 424           | [] ->
 425               eprintf (f_"%s: cannot find start of kernel symbol table\n") name;
 426               (fun _ -> raise Not_found)
 427
 428           | (_, (ksymtab_addr, ksymtab_size)) :: _ ->
 429               if debug then
 430                 printf
 431                   "%s: Kernel symbol table found at %Lx, size %Lx bytes\n%!"
 432                   name ksymtab_addr ksymtab_size;
 433
 434               (* Load the whole symbol table as a bitstring. *)
 435               let ksymtab =
 436                 Bitmatch.bitstring_of_string
 437                   (MMap.get_bytes mem ksymtab_addr
 438                      (Int64.to_int ksymtab_size)) in
 439
 440               (* Function to look up an address in the symbol table. *)
 441               let lookup_ksym sym =
 442                 let bits = bits_of_wordsize (MMap.get_wordsize mem) in
 443                 let e = MMap.get_endian mem in
 444                 let rec loop bs =
 445                   bitmatch bs with
 446                   | { value : bits : endian(e);
 447                       name_ptr : bits : endian(e) }
 448                       when MMap.get_string mem name_ptr = sym ->
 449                       value
 450                   | { _ : bits : endian(e);
 451                       _ : bits : endian(e);
 452                       bs : -1 : bitstring } ->
 453                       loop bs
 454                   | { _ } -> raise Not_found
 455                 in
 456                 loop ksymtab
 457               in
 458
 459               lookup_ksym
 460         in
 461
 462         (* Now try to find the /proc/kallsyms table.  This is in an odd
 463          * compressed format (but not a very successful compression
 464          * format).  However if it exists we know that it will contain
 465          * addresses of the common ksyms above, and it has some
 466          * characteristics which make it easy to detect in the
 467          * memory.
 468          *
 469          * kallsyms contains a complete list of symbols so is much
 470          * more useful than the basic list of exports.
 471          *)
 472         let ksym_addrs = List.filter_map (
 473           fun ksym -> try Some (lookup_ksym ksym) with Not_found -> None
 474         ) common_ksyms in
 475
 476         (* Search for those kernel addresses in the image.  We're looking
 477          * for the table kallsyms_addresses followed by kallsyms_num_syms
 478          * (number of symbols in the table).
 479          *)
 480         let ksym_addrs = List.map (MMap.find_pointer_all mem) ksym_addrs in
 481         let ksym_addrs = List.concat ksym_addrs in
 482
 483         (* Test each one to see if it's a candidate list of kernel
 484          * addresses followed by length of list.
 485          *)
 486         let kallsymtabs = List.filter_map (
 487           fun addr ->
 488             (* Search upwards from address until we find the length field.
 489              * If found, jump backwards by length and check all addresses.
 490              *)
 491             if debug then
 492               printf "%s: testing candidate kallsyms at %Lx\n" name addr;
 493             let rec loop addr =
 494               let addrp = MMap.follow_pointer mem addr in
 495               if MMap.is_mapped mem addrp then
 496                 loop (MMap.succ_long mem addr) (* continue up the table *)
 497               else
 498                 if addrp >= min_kallsyms_tabsize &&
 499                   addrp <= max_kallsyms_tabsize then (
 500                   (* addrp might be the symbol count.  Count backwards and
 501                    * check the full table.
 502                    *)
 503                   let num_entries = Int64.to_int addrp in
 504                   let entry_size = bytes_of_wordsize (MMap.get_wordsize mem) in
 505                   let start_addr =
 506                     addr -^ Int64.of_int (entry_size * num_entries) in
 507                   let end_addr = addr in
 508                   let rec loop2 addr =
 509                     if addr < end_addr then (
 510                       let addrp = MMap.follow_pointer mem addr in
 511                       if MMap.is_mapped mem addrp then
 512                         loop2 (MMap.succ_long mem addr)
 513                       else
 514                         None (* can't verify the full address table *)
 515                     ) else
 516                       (* ok! *)
 517                       let names_addr = MMap.succ_long mem end_addr in
 518                       if debug then
 519                         printf "%s: candidate kallsyms found at %Lx (names_addr at %Lx, num_entries %d)\n"
 520                           name start_addr names_addr num_entries;
 521                       Some (start_addr, num_entries, names_addr)
 522                   in
 523                   loop2 start_addr
 524                 )
 525                 else
 526                   None (* forget it *)
 527             in
 528             match loop addr with
 529             | None -> None
 530             | Some (start_addr, num_entries, names_addr) ->
 531                 (* As an additional verification, check the list of
 532                  * kallsyms_names.
 533                  *)
 534                 try
 535                   (* If the first byte is '\000' and is followed by a
 536                    * C identifier, then this is old-school list of
 537                    * symbols with prefix compression as in 2.6.9.
 538                    * Otherwise Huffman-compressed kallsyms as in
 539                    * 2.6.25.
 540                    *)
 541                   if MMap.get_byte mem names_addr = 0 &&
 542                     MMap.is_C_identifier mem (names_addr+^1L) then (
 543                     let names = ref [] in
 544                     let prev = ref "" in
 545                     let rec loop names_addr start_addr num =
 546                       if num > 0 then (
 547                         let prefix = MMap.get_byte mem names_addr in
 548                         let prefix = String.sub !prev 0 prefix in
 549                         let name = MMap.get_string mem (names_addr+^1L) in
 550                         let len = String.length name in
 551                         let name = prefix ^ name in
 552                         prev := name;
 553                         let names_addr = names_addr +^ Int64.of_int len +^ 2L in
 554                         let sym_value = MMap.follow_pointer mem start_addr in
 555                         let start_addr = MMap.succ_long mem start_addr in
 556                         (*printf "%S -> %Lx\n" name sym_value;*)
 557                         names := (name, sym_value) :: !names;
 558                         loop names_addr start_addr (num-1)
 559                       )
 560                     in
 561                     loop names_addr start_addr num_entries;
 562                     let names = List.rev !names in
 563
 564                     Some (start_addr, num_entries, names_addr,
 565                           Uncompressed names)
 566                     )
 567                   else ( (* new-style "compressed" names. *)
 568                     let compressed_names = ref [] in
 569                     let rec loop names_addr start_addr num =
 570                       if num > 0 then (
 571                         let len = MMap.get_byte mem names_addr in
 572                         let name = MMap.get_bytes mem (names_addr+^1L) len in
 573                         let names_addr = names_addr +^ Int64.of_int len +^ 1L in
 574                         let sym_value = MMap.follow_pointer mem start_addr in
 575                         let start_addr = MMap.succ_long mem start_addr in
 576                         compressed_names :=
 577                           (name, sym_value) :: !compressed_names;
 578                         loop names_addr start_addr (num-1)
 579                       ) else
 580                         names_addr
 581                     in
 582                     let markers_addr = loop names_addr start_addr num_entries in
 583                     let markers_addr = MMap.align mem markers_addr in
 584                     let compressed_names = List.rev !compressed_names in
 585
 586                     Some (start_addr, num_entries, names_addr,
 587                           Compressed (compressed_names, markers_addr))
 588                   )
 589                 with
 590                   Invalid_argument _ -> None (* bad names list *)
 591         ) ksym_addrs in
 592
 593         if debug then (
 594           printf "%s: candidate kallsyms at:\n" name;
 595           List.iter (
 596             function
 597             | (start_addr, num_entries, names_addr, Uncompressed _) ->
 598                 printf "\t%Lx %d entries names_addr=%Lx old-style\n%!"
 599                   start_addr num_entries names_addr
 600             | (start_addr, num_entries, names_addr,
 601                Compressed (_, markers_addr)) ->
 602                 printf "\t%Lx %d entries names_addr=%Lx markers_addr=%Lx\n%!"
 603                   start_addr num_entries names_addr markers_addr
 604           ) kallsymtabs
 605         );
 606
 607         (* Vote for the most popular symbol table candidate and
 608          * enhance the function for looking up ksyms.
 609          *)
 610         let lookup_ksym =
 611           let freqs = frequency kallsymtabs in
 612           match freqs with
 613           | [] ->
 614               (* Can't find any kallsymtabs, just return the lookup_ksym
 615                * function generated previously from the exported symbols.
 616                *)
 617               lookup_ksym
 618
 619           | (_, (_, _, _, Uncompressed names)) :: _ ->
 620               let lookup_ksym name =
 621                 try (* first look it up in kallsyms table. *)
 622                   List.assoc name names
 623                 with Not_found -> (* try the old exports table instead *)
 624                   lookup_ksym name
 625               in
 626               lookup_ksym
 627
 628           | (_, (start_addr, num_entries, names_addr,
 629                  Compressed (compressed_names, markers_addr))) :: _ ->
 630               (* Skip the markers and look for the token table. *)
 631               let num_markers = Int64.of_int ((num_entries + 255) / 256) in
 632               let marker_size =
 633                 Int64.of_int (bytes_of_wordsize (MMap.get_wordsize mem)) in
 634               let tokens_addr = markers_addr +^ marker_size *^ num_markers in
 635
 636               (* Now read out the compression tokens, which are just
 637                * 256 ASCIIZ strings that map bytes in the compression
 638                * names to substrings.
 639                *)
 640               let tokens = Array.make 256 "" in
 641               let rec loop i addr =
 642                 if i < 256 then (
 643                   let str = MMap.get_string mem addr in
 644                   let len = String.length str in
 645                   let addr = addr +^ Int64.of_int (len+1) in
 646                   tokens.(i) <- str;
 647                   loop (i+1) addr
 648                 )
 649               in
 650               loop 0 tokens_addr;
 651
 652               (* Expand the compressed names using the tokens. *)
 653               let names = List.filter_map (
 654                 fun (name, sym_value) ->
 655                   let f c = tokens.(Char.code c) in
 656                   let name = String.replace_chars f name in
 657                   (* First character in uncompressed output is the symbol
 658                    * type, eg. 'T'/'t' for text etc.
 659                    *)
 660                   (* NOTE: Symbol names are NOT unique
 661                    * (eg. 'con_start' is both a function and data in
 662                    * some kernels).  XXX We need to handle this situation
 663                    * better.
 664                    *)
 665                   (*let typ = name.[0] in*)
 666                   let name = String.sub name 1 (String.length name - 1) in
 667                   (*printf "%S -> %Lx\n" name sym_value;*)
 668                   Some (name, sym_value)
 669               ) compressed_names in
 670
 671               let lookup_ksym name =
 672                 try (* first look it up in kallsyms table. *)
 673                   List.assoc name names
 674                 with Not_found -> (* try the old exports table instead *)
 675                   lookup_ksym name
 676               in
 677
 678               lookup_ksym in
 679
 680         (* Just wrap the lookup_ksym call in something which prints
 681          * the query when debug is set.
 682          *)
 683         let lookup_ksym =
 684           if debug then
 685             let lookup_ksym sym =
 686               try
 687                 let value = lookup_ksym sym in
 688                 printf "lookup_ksym %S = %Lx\n%!" sym value;
 689                 value
 690               with Not_found ->
 691                 printf "lookup_ksym %S failed\n%!" sym;
 692                 raise Not_found
 693             in
 694             lookup_ksym
 695           else
 696             lookup_ksym
 697         in
 698
 699         ((name, arch, mem, lookup_ksym) : image)
 700     ) images in
 701
 702   debug, images