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 open Virt_mem_types
  31
  32 (* Make the kernel size around 16 MB, but just a bit smaller than
  33  * maximum string length so we can still run this on a 32 bit platform.
  34  *)
  35 let kernel_size =
  36   if Sys.word_size = 32 then Sys.max_string_length
  37   else 0x100_0000
  38 let max_memory_peek = 65536 (* XXX Use D.max_peek function *)
  39
  40 (* When tools register themselves, they are added to this list.
  41  * Later, we will alphabetize the list.
  42  *)
  43 let tools = ref []
  44
  45 (* Registration function used by the tools. *)
  46 let register ?(external_cmd = true) ?(extra_args = [])
  47     ?argcheck ?beforeksyms ?beforeutsname ?run
  48     name summary description =
  49   tools :=
  50     (name, (name, summary, description, external_cmd, extra_args,
  51             argcheck, beforeksyms, beforeutsname, run))
  52   :: !tools
  53
  54 (* Main program, called from mem/virt_mem_main.ml when all the
  55  * tools have had a chance to register themselves.
  56  *)
  57 let main () =
  58   (* Get the registered tools, alphabetically. *)
  59   let tools = !tools in
  60   let tools = List.sort ~cmp:(fun (a,_) (b,_) -> compare a b) tools in
  61
  62   (* Which tool did the user want to run?  Look at the executable
  63    * name (eg. 'virt-dmesg' => tool == dmesg).  If we don't recognise
  64    * the executable name then we must look for the first parameter
  65    * which doesn't begin with a '-' character.
  66    *
  67    * Note that we must do all of this before using the OCaml Arg
  68    * module to properly parse the command line (below), so that
  69    * we can have a usage message ready.
  70    *)
  71   let tool, ignore_first_anon_arg =
  72     let prog = Sys.executable_name in   (* eg. "/usr/bin/virt-dmesg.opt" *)
  73     let prog = Filename.basename prog in(* eg. "virt-dmesg.opt" *)
  74     let prog =                          (* eg. "virt-dmesg" *)
  75       try Filename.chop_extension prog with Invalid_argument _ -> prog in
  76     let prog =                          (* eg. "dmesg" *)
  77       if String.starts_with prog "virt-" then
  78         String.sub prog 5 (String.length prog - 5)
  79       else prog in
  80     try Some (List.assoc prog tools), false
  81     with Not_found ->
  82       let arg1 =                        (* First non-option argument. *)
  83         match Array.to_list Sys.argv with
  84         | [] -> None
  85         | _::args ->
  86             let rec loop = function
  87               | [] -> None
  88               | a::args when String.length a > 0 && a.[0] = '-' -> loop args
  89               | a::_ -> Some a
  90             in
  91             loop args in
  92       match arg1 with
  93       | None -> None, false
  94       | Some prog ->                    (* Recognisable first argument? *)
  95           let prog =
  96             try Filename.chop_extension prog with Invalid_argument _ -> prog in
  97           let prog =
  98             if String.starts_with prog "virt-" then
  99               String.sub prog 5 (String.length prog - 5)
 100             else prog in
 101           (try Some (List.assoc prog tools), true
 102            with Not_found -> None, false) in
 103
 104   (* Make a usage message. *)
 105   let usage_msg =
 106     match tool with
 107     | None ->                           (* Generic usage message. *)
 108         let tools = List.map (
 109           fun (name, (_, summary, _, external_cmd, _, _, _, _, _)) ->
 110             if external_cmd then "virt-"^name, summary
 111             else                 "virt-mem "^name, summary
 112         ) tools in
 113         (* Maximum width of field in the left hand column. *)
 114         let max_width =
 115           List.fold_left max 0 (List.map String.length (List.map fst tools)) in
 116         let tools = List.map (fun (l,r) -> pad max_width l, r) tools in
 117         let tools = List.map (fun (l,r) -> "  " ^ l ^ " - " ^ r) tools in
 118         let tools = String.concat "\n" tools in
 119
 120         sprintf (f_"\
 121
 122 virt-mem: Tools for providing information about virtual machines
 123
 124 Currently available tools include:
 125 %s
 126
 127 General usage is:
 128   <tool> [-options] [domains...]
 129
 130 To display extra help for a single tool, do:
 131   virt-mem help <tool>
 132
 133 Options:") tools
 134
 135                                         (* Tool-specific usage message. *)
 136     | Some (name, summary, description, external_cmd, _, _, _, _, _) ->
 137         let cmd =
 138           if external_cmd then "virt-" ^ name else "virt-mem " ^ name in
 139
 140         sprintf (f_"\
 141
 142 %s: %s
 143
 144 Description:
 145 %s
 146
 147 Options:") cmd summary description in
 148
 149   (* Now begin proper parsing of the command line arguments. *)
 150   let debug = ref false in
 151   let testimages = ref [] in
 152   let uri = ref "" in
 153   let anon_args = ref [] in
 154
 155   (* Default wordsize. *)
 156   let def_wordsize = ref None in
 157   let set_wordsize = function
 158     | "32" -> def_wordsize := Some W32
 159     | "64" -> def_wordsize := Some W64
 160     | "auto" -> def_wordsize := None
 161     | str -> failwith (sprintf (f_"set_wordsize: %s: unknown wordsize") str)
 162   in
 163
 164   (* Default endianness. *)
 165   let def_endian = ref None in
 166   let set_endian = function
 167     | "auto" -> def_endian := None
 168     | "le" | "little" | "littleendian" | "intel" ->
 169         def_endian := Some Bitstring.LittleEndian
 170     | "be" | "big" | "bigendian" | "motorola" ->
 171         def_endian := Some Bitstring.BigEndian
 172     | str -> failwith (sprintf (f_"set_endian: %s: unknown endianness") str)
 173   in
 174
 175   (* Default architecture. *)
 176   let def_architecture = ref None in
 177   let set_architecture = function
 178     | "auto" -> def_architecture := None
 179     | arch ->
 180         let arch = architecture_of_string arch in
 181         def_architecture := Some arch;
 182         def_endian := Some (endian_of_architecture arch);
 183         def_wordsize := Some (wordsize_of_architecture arch)
 184   in
 185
 186   (* Default text address. *)
 187   let def_text_addr = ref 0L (* 0 = auto-detect *) in
 188   let set_text_addr = function
 189     | "auto" -> def_text_addr := 0L
 190     | "i386" -> def_text_addr := 0xc010_0000_L (* common for x86 *)
 191     | "x86-64"|"x86_64" -> def_text_addr := 0xffffffff_81000000_L (* x86-64? *)
 192     | str -> def_text_addr := Int64.of_string str
 193   in
 194
 195   (* Handle -t option. *)
 196   let memory_image filename =
 197     testimages :=
 198       (!def_wordsize, !def_endian, !def_architecture, !def_text_addr, filename)
 199     :: !testimages
 200   in
 201
 202   (* Handle --version option. *)
 203   let version () =
 204     printf "virt-mem %s\n" Virt_mem_version.version;
 205
 206     let major, minor, release =
 207       let v, _ = Libvirt.get_version () in
 208       v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
 209     printf "libvirt %d.%d.%d\n" major minor release;
 210     exit 0
 211   in
 212
 213   (* Function to collect up any anonymous args (domain names/IDs). *)
 214   let anon_arg str = anon_args := str :: !anon_args in
 215
 216   (* Construct the argspec.
 217    * May include extra arguments specified by the tool.
 218    *)
 219   let argspec =
 220     let extra_args = match tool with
 221       | None -> []
 222       | Some (_, _, _, _, extra_args, _, _, _, _) -> extra_args in
 223     let argspec = [
 224       "-A", Arg.String set_architecture,
 225         "arch " ^ s_"Set kernel architecture, endianness and word size";
 226       "-E", Arg.String set_endian,
 227         "endian " ^ s_"Set kernel endianness";
 228       "-T", Arg.String set_text_addr,
 229         "addr " ^ s_"Set kernel text address";
 230       "-W", Arg.String set_wordsize,
 231         "addr " ^ s_"Set kernel word size";
 232       "-c", Arg.Set_string uri,
 233         "uri " ^ s_ "Connect to URI";
 234       "--connect", Arg.Set_string uri,
 235         "uri " ^ s_ "Connect to URI";
 236       "--debug", Arg.Set debug,
 237         " " ^ s_"Debug mode (default: false)";
 238       "-t", Arg.String memory_image,
 239         "image " ^ s_"Use saved kernel memory image";
 240       "--version", Arg.Unit version,
 241         " " ^ s_"Display version and exit";
 242     ] @ extra_args in
 243
 244     (* Sort options alphabetically on first alpha character. *)
 245     let cmp (a,_,_) (b,_,_) =
 246       let chars = "-" in
 247       let a = String.strip ~chars a and b = String.strip ~chars b in
 248       compare a b
 249     in
 250     let argspec = List.sort ~cmp argspec in
 251     (* Make the options line up nicely. *)
 252     Arg.align argspec in
 253
 254   (* Parse the command line.  This will exit if --version or --help found. *)
 255   Arg.parse argspec anon_arg usage_msg;
 256
 257   let testimages = !testimages in
 258   let debug = !debug in
 259   let uri = if !uri = "" then None else Some !uri in
 260
 261   (* Discard the first anonymous argument if, above, we previously
 262    * found it contained the tool name.
 263    *)
 264   let anon_args = List.rev !anon_args in
 265   let anon_args =
 266     if ignore_first_anon_arg then List.tl anon_args else anon_args in
 267
 268   (* At this point, either --help was specified on the command line
 269    * (and so the program has exited) or we must have determined tool,
 270    * or the user didn't give us a valid tool (eg. "virt-mem foobar").
 271    * Detect that final case now and give an error.
 272    *)
 273   let name, _, _, _, _, argcheck, beforeksyms,  beforeutsname, run =
 274     match tool with
 275     | Some t -> t
 276     | None ->
 277         prerr_endline (s_"\
 278 virt-mem: I could not work out which tool you are trying to run.
 279 Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
 280         exit 1
 281   in
 282   if debug then eprintf "tool = %s\n%!" name;
 283
 284   (* Optional argument checking in the tool. *)
 285   (match argcheck with
 286    | None -> ()
 287    | Some argcheck -> argcheck debug
 288   );
 289
 290   (* Get the kernel images. *)
 291   let images =
 292     if testimages = [] then (
 293       let conn =
 294         let name = uri in
 295         try C.connect_readonly ?name ()
 296         with Libvirt.Virterror err ->
 297           prerr_endline (Libvirt.Virterror.to_string err);
 298           (* If non-root and no explicit connection URI, print a warning. *)
 299           if Unix.geteuid () <> 0 && name = None then (
 300             print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
 301           );
 302           exit 1 in
 303
 304       (* If we have a list of parameters, then it is the domain names / UUIDs /
 305        * IDs ONLY that we wish to display.  Otherwise, display all active.
 306        *)
 307       let doms =
 308         if anon_args = [] then (
 309           (* List of active domains. *)
 310           let nr_active_doms = C.num_of_domains conn in
 311           let active_doms =
 312             Array.to_list (C.list_domains conn nr_active_doms) in
 313           List.map (D.lookup_by_id conn) active_doms
 314         ) else (
 315           List.map (
 316             fun arg ->
 317               let dom =
 318                 try D.lookup_by_uuid_string conn arg
 319                 with _ ->
 320                   try D.lookup_by_name conn arg
 321                   with _ ->
 322                     try D.lookup_by_id conn (int_of_string arg)
 323                     with _ ->
 324                       failwith (sprintf (f_"%s: unknown domain (not a UUID, name or ID of any active domain)") arg) in
 325
 326               (* XXX Primitive test to see if the domain is active. *)
 327               let is_active = try D.get_id dom >= 0 with _ -> false in
 328               if not is_active then
 329                 failwith (sprintf (f_"%s: domain is not running") arg);
 330
 331               dom
 332           ) anon_args
 333         ) in
 334
 335       (* Get their XML. *)
 336       let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
 337
 338       (* Parse the XML. *)
 339       let xmls = List.map (fun (dom, xml) ->
 340                              dom, Xml.parse_string xml) xmls in
 341
 342       (* XXX Do something with the XML XXX
 343        * such as detecting arch, wordsize, endianness.
 344        * XXXXXXXXXXXXXX
 345        *
 346        *
 347        *
 348        *)
 349
 350
 351       List.map (
 352         fun (dom, _) ->
 353           let id = D.get_id dom in
 354           let name = D.get_name dom in
 355
 356           let wordsize =
 357             match !def_wordsize with
 358             | None ->
 359                 failwith
 360                   (sprintf (f_"%s: use -W to define word size for this image")
 361                      name);
 362             | Some ws -> ws in
 363           let endian =
 364             match !def_endian with
 365             | None ->
 366                 failwith
 367                   (sprintf (f_"%s: use -E to define endianness for this image")
 368                      name);
 369             | Some e -> e in
 370
 371           let arch =
 372             match !def_architecture with
 373             | Some I386 -> I386 | Some X86_64 -> X86_64
 374             | _ ->
 375                 failwith
 376                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") name) in
 377
 378           if !def_text_addr = 0L then
 379             failwith
 380               (sprintf (f_"%s: use -T to define kernel load address for this image") name);
 381
 382           let start_t = gettimeofday () in
 383
 384           (* Read the kernel memory.
 385            * Maximum 64K can be read over remote connections.
 386            *)
 387           let str = String.create kernel_size in
 388           let rec loop i =
 389             let remaining = kernel_size - i in
 390             if remaining > 0 then (
 391               let size = min remaining max_memory_peek in
 392               D.memory_peek dom [D.Virtual]
 393                 (!def_text_addr +^ Int64.of_int i) size str i;
 394               loop (i + size)
 395             )
 396           in
 397           loop 0;
 398
 399           if debug then (
 400             let end_t = gettimeofday () in
 401             eprintf "timing: downloading kernel took %f seconds\n%!"
 402               (end_t -. start_t)
 403           );
 404
 405           (* Map the virtual memory. *)
 406           let mem = Virt_mem_mmap.of_string str !def_text_addr in
 407
 408           (* Force the wordsize and endianness. *)
 409           let mem = Virt_mem_mmap.set_wordsize mem wordsize in
 410           let mem = Virt_mem_mmap.set_endian mem endian in
 411
 412           ((Some id, name, arch, mem) : image0)
 413       ) xmls
 414     ) else (
 415       (* One or more -t options passed. *)
 416       if anon_args <> [] then
 417         failwith (s_"virt-mem: if -t given on command line, then no domain arguments should be listed");
 418
 419       List.map (
 420         fun (wordsize, endian, arch, text_addr, filename) ->
 421           (* Quite a lot of limitations on the kernel images we can
 422            * handle at the moment ...
 423            *)
 424           (* XXX We could auto-detect wordsize easily. *)
 425           let wordsize =
 426             match wordsize with
 427             | None ->
 428                 failwith
 429                   (sprintf (f_"%s: use -W to define word size for this image")
 430                      filename);
 431             | Some ws -> ws in
 432           let endian =
 433             match endian with
 434             | None ->
 435                 failwith
 436                   (sprintf (f_"%s: use -E to define endianness for this image")
 437                      filename);
 438             | Some e -> e in
 439
 440           let arch =
 441             match arch with
 442             | Some I386 -> I386 | Some X86_64 -> X86_64
 443             | _ ->
 444                 failwith
 445                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") filename) in
 446
 447           if text_addr = 0L then
 448             failwith
 449               (sprintf (f_"%s: use -T to define kernel load address for this image")
 450                  filename);
 451
 452           (* Map the virtual memory. *)
 453           let fd = openfile filename [O_RDONLY] 0 in
 454           let mem = Virt_mem_mmap.of_file fd text_addr in
 455
 456           (* Force the wordsize and endianness. *)
 457           let mem = Virt_mem_mmap.set_wordsize mem wordsize in
 458           let mem = Virt_mem_mmap.set_endian mem endian in
 459
 460           ((None, filename, arch, mem) : image0)
 461       ) testimages
 462     ) in
 463
 464   (* Optional callback into the tool before we start looking for
 465    * kernel symbols.
 466    *)
 467   (match beforeksyms with
 468    | None -> ()
 469    | Some beforeksyms -> beforeksyms debug images
 470   );
 471
 472   (* If there are no more callback functions, then there is no point
 473    * continuing with the rest of the program (kernel symbol analysis) ...
 474    *)
 475   if beforeutsname = None && run = None then exit 0;
 476
 477   (* Do the kernel symbol analysis. *)
 478   let images =
 479     List.map (
 480       fun image ->
 481         (* Look for ordinary kernel symbols: *)
 482         let image = Virt_mem_ksyms.find_kernel_symbols debug image in
 483         (* Look for kallsyms: *)
 484         let image = Virt_mem_kallsyms.find_kallsyms debug image in
 485
 486         (* Finally, just wrap the lookup_ksym call in something
 487          * which prints the query when debug is set.
 488          *)
 489         let image =
 490           if debug then
 491             let (domid, name, arch, mem, lookup_ksym) = image in
 492             let lookup_ksym sym =
 493               try
 494                 let value = lookup_ksym sym in
 495                 eprintf "lookup_ksym %S = %Lx\n%!" sym value;
 496                 value
 497               with Not_found ->
 498                 eprintf "lookup_ksym %S failed\n%!" sym;
 499                 raise Not_found
 500             in
 501             (domid, name, arch, mem, lookup_ksym)
 502           else
 503             image in
 504
 505         image
 506     ) images in
 507
 508   (* Before utsname analysis. *)
 509   (match beforeutsname with
 510    | None -> ()
 511    | Some beforeutsname -> List.iter (beforeutsname debug) images
 512   );
 513
 514   (* If there are no more callback functions, then there is no point
 515    * continuing with the rest of the program (kernel version analysis) ...
 516    *)
 517   if run = None then exit 0;
 518
 519   (* Get the kernel version (utsname analysis). *)
 520   let images = List.map (Virt_mem_utsname.find_utsname debug) images in
 521
 522   (* Run the tool's main function. *)
 523   (match run with
 524    | None -> ()
 525    | Some run -> List.iter (run debug) images
 526   )