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