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 kimages =
 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 kimage =
 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           kimage
 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; arch = arch;
 498             kernel_min = kernel_min; kernel_max = kernel_max;
 499             mem = mem; addrmap = Kernel.AddrMap.empty;
 500             ksyms = Ksymmap.empty; have_ksyms = false; have_kallsyms = false;
 501             utsname = None;
 502             have_tasks = false; have_net_devices = false }
 503       ) testimages
 504     ) in
 505
 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 =
 514     if needs_net_devices then true, true
 515     else needs_ksyms, needs_utsname in
 516   let needs_ksyms, needs_utsname, needs_tasks, needs_net_devices =
 517     if needs_everything then true, true, true, true
 518     else needs_ksyms, needs_utsname, needs_tasks, needs_net_devices in
 519
 520   let errors = ref 0 in
 521
 522   List.iter (
 523     fun kimage ->
 524       try
 525         (* Do the kernel symbol analysis. *)
 526         let kimage =
 527           if not needs_ksyms then kimage
 528           else (
 529             (* Look for ordinary kernel symbols: *)
 530             let kimage = Virt_mem_ksyms.find_kernel_symbols debug kimage in
 531
 532             if kimage.have_ksyms then
 533               (* Look for kallsyms: *)
 534               Virt_mem_kallsyms.find_kallsyms debug kimage
 535             else kimage
 536           ) in
 537
 538         (* Get the kernel version (utsname analysis). *)
 539         let kimage =
 540           if not needs_utsname then kimage
 541           else (
 542             if kimage.have_ksyms then
 543               Virt_mem_utsname.find_utsname debug kimage
 544             else
 545               kimage
 546           ) in
 547
 548         (* Get the tasks. *)
 549         let kimage =
 550           if not needs_tasks then kimage
 551           else (
 552             let { ksyms = ksyms; have_ksyms = have_ksyms; utsname = utsname;
 553                   addrmap = addrmap } = kimage in
 554             match have_ksyms, utsname with
 555             | true, Some { uts_kernel_release = kversion } ->
 556                 let kimage = ref kimage in
 557                 let load struct_name addr size =
 558                   if debug then
 559                     eprintf "load for task, %s: %Lx %d ...\n"
 560                       struct_name addr size;
 561                   let mapped =
 562                     Virt_mem_mmap.is_mapped_range !kimage.mem addr size in
 563                   if not mapped then kimage := load_memory !kimage addr size;
 564                   let bits = Virt_mem_mmap.get_bytes !kimage.mem addr size in
 565                   Bitstring.bitstring_of_string bits
 566                 in
 567                 let init_task = Ksymmap.find "init_task" ksyms in
 568                 let addrmap =
 569                   Kernel.task_struct_follower kversion load addrmap init_task in
 570                 { !kimage with addrmap = addrmap }
 571             | _, _ -> kimage
 572           ) in
 573
 574         (* Get the net devices. *)
 575         let kimage =
 576           if not needs_net_devices then kimage
 577           else (
 578             let { ksyms = ksyms; have_ksyms = have_ksyms; utsname = utsname;
 579                   addrmap = addrmap } = kimage in
 580             match have_ksyms, utsname with
 581             | true, Some { uts_kernel_release = kversion } ->
 582                 let kimage = ref kimage in
 583                 let load struct_name addr size =
 584                   if debug then
 585                     eprintf "load for net dev, %s: %Lx %d ...\n"
 586                       struct_name addr size;
 587                   let mapped =
 588                     Virt_mem_mmap.is_mapped_range !kimage.mem addr size in
 589                   if not mapped then kimage := load_memory !kimage addr size;
 590                   let bits = Virt_mem_mmap.get_bytes !kimage.mem addr size in
 591                   Bitstring.bitstring_of_string bits
 592                 in
 593                 let addrmap =
 594                   try
 595                     let dev_base = Ksymmap.find "dev_base" ksyms in
 596                     Kernel.net_device_follower kversion load addrmap dev_base
 597                   with Not_found ->
 598                     try
 599                       let dev_base_head = Ksymmap.find "dev_base_head" ksyms in
 600                       (* XXX adjust to get offset of start of net_device *)
 601                       assert false
 602                     with Not_found ->
 603                       try
 604                         let init_net = Ksymmap.find "init_net" ksyms in
 605                         Kernel.net_follower kversion load addrmap init_net
 606                       with Not_found ->
 607                         eprintf (f_"%s: cannot find dev_base, dev_base_head or init_net symbols in kernel image.\n") !kimage.domname;
 608                         addrmap in
 609                 { !kimage with addrmap = addrmap }
 610             | _, _ -> kimage
 611           ) in
 612
 613         (* Run the tool's main function. *)
 614         if not needs_everything then (
 615           if needs_ksyms && kimage.have_ksyms = false then
 616             failwith (s_"could not read kernel symbols")
 617           else if needs_utsname && kimage.utsname = None then
 618             failwith (s_"could not read kernel version")
 619           else if needs_tasks && kimage.have_tasks = false then
 620             failwith (s_"could not read process table")
 621           else if needs_net_devices && kimage.have_net_devices = false then
 622             failwith (s_"could not read net device table")
 623         );
 624         run debug kimage
 625       with exn ->
 626         eprintf "%s: %s\n" kimage.domname (Printexc.to_string exn);
 627         incr errors
 628   ) kimages;
 629
 630   exit (if !errors > 0 then 1 else 0)