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