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