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   (* Function to collect up any anonymous args (domain names/IDs). *)
 243   let anon_arg str = anon_args := str :: !anon_args in
 244
 245   (* Construct the argspec.
 246    * May include extra arguments specified by the tool.
 247    *)
 248   let argspec =
 249     let extra_args = match tool with
 250       | None -> []
 251       | Some (_, _, _, _, _, _, _, _, _, extra_args, _) -> extra_args in
 252     let argspec = [
 253       "-A", Arg.String set_architecture,
 254         "arch " ^ s_"Set kernel architecture, endianness and word size";
 255       "-E", Arg.String set_endian,
 256         "endian " ^ s_"Set kernel endianness";
 257       "-T", Arg.String set_text_addr,
 258         "addr " ^ s_"Set kernel text address";
 259       "-W", Arg.String set_wordsize,
 260         "addr " ^ s_"Set kernel word size";
 261       "-c", Arg.Set_string uri,
 262         "uri " ^ s_ "Connect to URI";
 263       "--connect", Arg.Set_string uri,
 264         "uri " ^ s_ "Connect to URI";
 265       "--debug", Arg.Set debug,
 266         " " ^ s_"Debug mode (default: false)";
 267       "-t", Arg.String memory_image,
 268         "image " ^ s_"Use saved kernel memory image";
 269       "--version", Arg.Unit version,
 270         " " ^ s_"Display version and exit";
 271     ] @ extra_args in
 272
 273     (* Sort options alphabetically on first alpha character. *)
 274     let cmp (a,_,_) (b,_,_) =
 275       let chars = "-" in
 276       let a = String.strip ~chars a and b = String.strip ~chars b in
 277       compare a b
 278     in
 279     let argspec = List.sort ~cmp argspec in
 280     (* Make the options line up nicely. *)
 281     Arg.align argspec in
 282
 283   (* Parse the command line.  This will exit if --version or --help found. *)
 284   Arg.parse argspec anon_arg usage_msg;
 285
 286   let testimages = !testimages in
 287   let debug = !debug in
 288   let uri = if !uri = "" then None else Some !uri in
 289
 290   (* Discard the first anonymous argument if, above, we previously
 291    * found it contained the tool name.
 292    *)
 293   let anon_args = List.rev !anon_args in
 294   let anon_args =
 295     if ignore_first_anon_arg then List.tl anon_args else anon_args in
 296
 297   (* At this point, either --help was specified on the command line
 298    * (and so the program has exited) or we must have determined tool,
 299    * or the user didn't give us a valid tool (eg. "virt-mem foobar").
 300    * Detect that final case now and give an error.
 301    *)
 302   let name, _, _,
 303     needs_ksyms, needs_utsname, needs_tasks, needs_everything,
 304     run, external_cmd, extra_args, argcheck =
 305     match tool with
 306     | Some t -> t
 307     | None ->
 308         prerr_endline (s_"\
 309 virt-mem: I could not work out which tool you are trying to run.
 310 Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
 311         exit 1
 312   in
 313   if debug then eprintf "tool = %s\n%!" name;
 314
 315   (* Optional argument checking in the tool. *)
 316   (match argcheck with
 317    | None -> ()
 318    | Some argcheck -> argcheck debug
 319   );
 320
 321   (* Get the kernel images. *)
 322   let images =
 323     if testimages = [] then (
 324       let conn =
 325         let name = uri in
 326         try C.connect_readonly ?name ()
 327         with Libvirt.Virterror err ->
 328           prerr_endline (Libvirt.Virterror.to_string err);
 329           (* If non-root and no explicit connection URI, print a warning. *)
 330           if Unix.geteuid () <> 0 && name = None then (
 331             print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
 332           );
 333           exit 1 in
 334
 335       (* If we have a list of parameters, then it is the domain names / UUIDs /
 336        * IDs ONLY that we wish to display.  Otherwise, display all active.
 337        *)
 338       let doms =
 339         if anon_args = [] then (
 340           (* List of active domains. *)
 341           let nr_active_doms = C.num_of_domains conn in
 342           let active_doms =
 343             Array.to_list (C.list_domains conn nr_active_doms) in
 344           List.map (D.lookup_by_id conn) active_doms
 345         ) else (
 346           List.map (
 347             fun arg ->
 348               let dom =
 349                 try D.lookup_by_uuid_string conn arg
 350                 with _ ->
 351                   try D.lookup_by_name conn arg
 352                   with _ ->
 353                     try D.lookup_by_id conn (int_of_string arg)
 354                     with _ ->
 355                       failwith (sprintf (f_"%s: unknown domain (not a UUID, name or ID of any active domain)") arg) in
 356
 357               (* XXX Primitive test to see if the domain is active. *)
 358               let is_active = try D.get_id dom >= 0 with _ -> false in
 359               if not is_active then
 360                 failwith (sprintf (f_"%s: domain is not running") arg);
 361
 362               dom
 363           ) anon_args
 364         ) in
 365
 366       (* Get their XML. *)
 367       let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
 368
 369       (* Parse the XML. *)
 370       let xmls = List.map (fun (dom, xml) ->
 371                              dom, Xml.parse_string xml) xmls in
 372
 373       (* XXX Do something with the XML XXX
 374        * such as detecting arch, wordsize, endianness.
 375        * XXXXXXXXXXXXXX
 376        *
 377        *
 378        *
 379        *)
 380
 381
 382       List.map (
 383         fun (dom, _) ->
 384           let domname = D.get_name dom in
 385
 386           let wordsize =
 387             match !def_wordsize with
 388             | None ->
 389                 failwith
 390                   (sprintf (f_"%s: use -W to define word size for this image")
 391                      domname);
 392             | Some ws -> ws in
 393           let endian =
 394             match !def_endian with
 395             | None ->
 396                 failwith
 397                   (sprintf (f_"%s: use -E to define endianness for this image")
 398                      domname);
 399             | Some e -> e in
 400
 401           let arch =
 402             match !def_architecture with
 403             | Some I386 -> I386 | Some X86_64 -> X86_64
 404             | _ ->
 405                 failwith
 406                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") domname) in
 407
 408           if !def_text_addr = 0L ||
 409             !def_kernel_min = 0L ||
 410             !def_kernel_max = 0L then
 411               failwith
 412                 (sprintf (f_"%s: use -T to define kernel load address for this image") domname);
 413
 414           (* Download the static part of the kernel. *)
 415           let start_t = gettimeofday () in
 416
 417           let image =
 418             try
 419               load_static_memory ~dom ~domname ~arch
 420                 ~wordsize ~endian
 421                 ~kernel_min:!def_kernel_min ~kernel_max:!def_kernel_max
 422                 !def_text_addr kernel_size
 423             with
 424             | LoadMemoryError (AddressOutOfRange, _) ->
 425                 prerr_endline (s_"virt-mem: error loading kernel memory: address out of range
 426 Possibly the '-T' command line parameter was used inconsistently.");
 427                 exit 1
 428             (* Allow any other exceptions to escape & kill the program. *) in
 429
 430           if debug then (
 431             let end_t = gettimeofday () in
 432             eprintf "timing: downloading kernel took %f seconds\n%!"
 433               (end_t -. start_t)
 434           );
 435
 436           image
 437
 438       ) xmls
 439     ) else (
 440       (* One or more -t options passed. *)
 441       if anon_args <> [] then
 442         failwith (s_"virt-mem: if -t given on command line, then no domain arguments should be listed");
 443
 444       List.map (
 445         fun (wordsize, endian, arch,
 446              text_addr, kernel_min, kernel_max, filename) ->
 447           (* Quite a lot of limitations on the kernel images we can
 448            * handle at the moment ...
 449            *)
 450           (* XXX We could auto-detect wordsize easily. *)
 451           let wordsize =
 452             match wordsize with
 453             | None ->
 454                 failwith
 455                   (sprintf (f_"%s: use -W to define word size for this image")
 456                      filename);
 457             | Some ws -> ws in
 458           let endian =
 459             match endian with
 460             | None ->
 461                 failwith
 462                   (sprintf (f_"%s: use -E to define endianness for this image")
 463                      filename);
 464             | Some e -> e in
 465
 466           let arch =
 467             match arch with
 468             | Some I386 -> I386 | Some X86_64 -> X86_64
 469             | _ ->
 470                 failwith
 471                   (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") filename) in
 472
 473           if text_addr = 0L then
 474             failwith
 475               (sprintf (f_"%s: use -T to define kernel load address for this image")
 476                  filename);
 477
 478           (* Map the virtual memory. *)
 479           let fd = openfile filename [O_RDONLY] 0 in
 480           let mem = Virt_mem_mmap.of_file fd text_addr in
 481
 482           (* Force the wordsize and endianness. *)
 483           let mem = Virt_mem_mmap.set_wordsize mem wordsize in
 484           let mem = Virt_mem_mmap.set_endian mem endian in
 485
 486           { dom = None; domname = filename; mem = mem; arch = arch;
 487             kernel_min = kernel_min; kernel_max = kernel_max }
 488       ) testimages
 489     ) in
 490
 491   (* Now build the kdata, depending on what the tool asked for. *)
 492   let images =
 493     List.map (
 494       fun image ->
 495         let kdata = { ksyms = None; utsname = None; tasks = None } in
 496         image, kdata
 497     ) images in
 498   (* Certain needs are dependent on others ... *)
 499   let needs_ksyms =
 500     if needs_utsname then true
 501     else needs_ksyms in
 502   let needs_ksyms, needs_utsname =
 503     if needs_tasks then true, true
 504     else needs_ksyms, needs_utsname in
 505   let needs_ksyms, needs_utsname, needs_tasks =
 506     if needs_everything then true, true, true
 507     else needs_ksyms, needs_utsname, needs_tasks in
 508
 509   (* Do the kernel symbol analysis. *)
 510   let images =
 511     if not needs_ksyms then images
 512     else
 513       List.map (
 514         fun (image, kdata) ->
 515           (* Look for ordinary kernel symbols: *)
 516           let image, ksyms =
 517             Virt_mem_ksyms.find_kernel_symbols debug image in
 518
 519           match ksyms with
 520           | None -> image, kdata
 521           | Some ksyms ->
 522               (* Look for kallsyms: *)
 523               let image, kallsyms =
 524                 Virt_mem_kallsyms.find_kallsyms debug image ksyms in
 525
 526               let ksyms =
 527                 match kallsyms with
 528                 | None -> ksyms (* no kallsyms, just use module symbols *)
 529                 | Some kallsyms -> kallsyms (* ksyms + kallsyms *) in
 530
 531               image, { kdata with ksyms = Some ksyms }
 532       ) images in
 533
 534   (* Get the kernel version (utsname analysis). *)
 535   let images =
 536     if not needs_utsname then images
 537     else
 538       List.map (
 539         fun (image, ({ ksyms = ksyms } as kdata)) ->
 540           match ksyms with
 541           | None -> image, kdata
 542           | Some ksyms ->
 543               let image, utsname =
 544                 Virt_mem_utsname.find_utsname debug image ksyms in
 545               let kdata = { kdata with utsname = utsname } in
 546               image, kdata
 547       ) images in
 548
 549   (* Get the tasks. *)
 550   let images =
 551     if not needs_tasks then images
 552     else
 553       List.map (
 554         fun (image, ({ ksyms = ksyms; utsname = utsname } as kdata)) ->
 555           match ksyms, utsname with
 556           | Some ksyms, Some { kernel_release = kversion } ->
 557               let image, tasks =
 558                 Virt_mem_tasks.find_tasks debug image ksyms kversion in
 559               let kdata = { kdata with tasks = tasks } in
 560               image, kdata
 561           | _, _ -> image, kdata
 562       ) images in
 563
 564   (* Run the tool's main function. *)
 565   let errors = ref 0 in
 566   List.iter (
 567     fun (image, kdata) ->
 568       try
 569         if not needs_everything then (
 570           if needs_ksyms && kdata.ksyms = None then
 571             failwith (s_"could not read kernel symbols")
 572           else if needs_utsname && kdata.utsname = None then
 573             failwith (s_"could not read kernel version")
 574           else if needs_tasks && kdata.tasks = None then
 575             failwith (s_"could not read process table")
 576         );
 577         run debug image kdata
 578       with exn ->
 579         eprintf "%s: %s\n" image.domname (Printexc.to_string exn);
 580         incr errors
 581   ) images;
 582   exit (if !errors > 0 then 1 else 0)