1 (* Memory info for virtual domains.
2 (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
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.
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.
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.
25 module C = Libvirt.Connect
26 module D = Libvirt.Domain
28 open Virt_mem_gettext.Gettext
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.
36 if Sys.word_size = 32 then Sys.max_string_length
38 let max_memory_peek = 65536 (* XXX Use D.max_peek function *)
40 (* When tools register themselves, they are added to this list.
41 * Later, we will alphabetize the list.
45 (* Registration function used by the tools. *)
46 let register ?(external_cmd = true) ?(extra_args = [])
47 ?argcheck ?beforeksyms ?beforeutsname ?run
48 name summary description =
50 (name, (name, summary, description, external_cmd, extra_args,
51 argcheck, beforeksyms, beforeutsname, run))
54 (* Main program, called from mem/virt_mem_main.ml when all the
55 * tools have had a chance to register themselves.
58 (* Get the registered tools, alphabetically. *)
60 let tools = List.sort ~cmp:(fun (a,_) (b,_) -> compare a b) tools in
62 (* Which tool did the user want to run? Look at the executable
63 * name (eg. 'virt-dmesg' => tool == dmesg). If we don't recognise
64 * the executable name then we must look for the first parameter
65 * which doesn't begin with a '-' character.
67 * Note that we must do all of this before using the OCaml Arg
68 * module to properly parse the command line (below), so that
69 * we can have a usage message ready.
71 let tool, ignore_first_anon_arg =
72 let prog = Sys.executable_name in (* eg. "/usr/bin/virt-dmesg.opt" *)
73 let prog = Filename.basename prog in(* eg. "virt-dmesg.opt" *)
74 let prog = (* eg. "virt-dmesg" *)
75 try Filename.chop_extension prog with Invalid_argument _ -> prog in
76 let prog = (* eg. "dmesg" *)
77 if String.starts_with prog "virt-" then
78 String.sub prog 5 (String.length prog - 5)
80 try Some (List.assoc prog tools), false
82 let arg1 = (* First non-option argument. *)
83 match Array.to_list Sys.argv with
86 let rec loop = function
88 | a::args when String.length a > 0 && a.[0] = '-' -> loop args
94 | Some prog -> (* Recognisable first argument? *)
96 try Filename.chop_extension prog with Invalid_argument _ -> prog in
98 if String.starts_with prog "virt-" then
99 String.sub prog 5 (String.length prog - 5)
101 (try Some (List.assoc prog tools), true
102 with Not_found -> None, false) in
104 (* Make a usage message. *)
107 | None -> (* Generic usage message. *)
108 let tools = List.map (
109 fun (name, (_, summary, _, external_cmd, _, _, _, _, _)) ->
110 if external_cmd then "virt-"^name, summary
111 else "virt-mem "^name, summary
113 (* Maximum width of field in the left hand column. *)
115 List.fold_left max 0 (List.map String.length (List.map fst tools)) in
116 let tools = List.map (fun (l,r) -> pad max_width l, r) tools in
117 let tools = List.map (fun (l,r) -> " " ^ l ^ " - " ^ r) tools in
118 let tools = String.concat "\n" tools in
122 virt-mem: Tools for providing information about virtual machines
124 Currently available tools include:
128 <tool> [-options] [domains...]
130 To display extra help for a single tool, do:
135 (* Tool-specific usage message. *)
136 | Some (name, summary, description, external_cmd, _, _, _, _, _) ->
138 if external_cmd then "virt-" ^ name else "virt-mem " ^ name in
147 Options:") cmd summary description in
149 (* Now begin proper parsing of the command line arguments. *)
150 let debug = ref false in
151 let testimages = ref [] in
153 let anon_args = ref [] in
155 (* Default wordsize. *)
156 let def_wordsize = ref None in
157 let set_wordsize = function
158 | "32" -> def_wordsize := Some W32
159 | "64" -> def_wordsize := Some W64
160 | "auto" -> def_wordsize := None
161 | str -> failwith (sprintf (f_"set_wordsize: %s: unknown wordsize") str)
164 (* Default endianness. *)
165 let def_endian = ref None in
166 let set_endian = function
167 | "auto" -> def_endian := None
168 | "le" | "little" | "littleendian" | "intel" ->
169 def_endian := Some Bitstring.LittleEndian
170 | "be" | "big" | "bigendian" | "motorola" ->
171 def_endian := Some Bitstring.BigEndian
172 | str -> failwith (sprintf (f_"set_endian: %s: unknown endianness") str)
175 (* Default architecture. *)
176 let def_architecture = ref None in
177 let set_architecture = function
178 | "auto" -> def_architecture := None
180 let arch = architecture_of_string arch in
181 def_architecture := Some arch;
182 def_endian := Some (endian_of_architecture arch);
183 def_wordsize := Some (wordsize_of_architecture arch)
186 (* Default text address. *)
187 let def_text_addr = ref 0L (* 0 = auto-detect *) in
188 let set_text_addr = function
189 | "auto" -> def_text_addr := 0L
190 | "i386" -> def_text_addr := 0xc010_0000_L (* common for x86 *)
191 | "x86-64"|"x86_64" -> def_text_addr := 0xffffffff_81000000_L (* x86-64? *)
192 | str -> def_text_addr := Int64.of_string str
195 (* Handle -t option. *)
196 let memory_image filename =
198 (!def_wordsize, !def_endian, !def_architecture, !def_text_addr, filename)
202 (* Handle --version option. *)
204 printf "virt-mem %s\n" Virt_mem_version.version;
206 let major, minor, release =
207 let v, _ = Libvirt.get_version () in
208 v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
209 printf "libvirt %d.%d.%d\n" major minor release;
213 (* Function to collect up any anonymous args (domain names/IDs). *)
214 let anon_arg str = anon_args := str :: !anon_args in
216 (* Construct the argspec.
217 * May include extra arguments specified by the tool.
220 let extra_args = match tool with
222 | Some (_, _, _, _, extra_args, _, _, _, _) -> extra_args in
224 "-A", Arg.String set_architecture,
225 "arch " ^ s_"Set kernel architecture, endianness and word size";
226 "-E", Arg.String set_endian,
227 "endian " ^ s_"Set kernel endianness";
228 "-T", Arg.String set_text_addr,
229 "addr " ^ s_"Set kernel text address";
230 "-W", Arg.String set_wordsize,
231 "addr " ^ s_"Set kernel word size";
232 "-c", Arg.Set_string uri,
233 "uri " ^ s_ "Connect to URI";
234 "--connect", Arg.Set_string uri,
235 "uri " ^ s_ "Connect to URI";
236 "--debug", Arg.Set debug,
237 " " ^ s_"Debug mode (default: false)";
238 "-t", Arg.String memory_image,
239 "image " ^ s_"Use saved kernel memory image";
240 "--version", Arg.Unit version,
241 " " ^ s_"Display version and exit";
244 (* Sort options alphabetically on first alpha character. *)
245 let cmp (a,_,_) (b,_,_) =
247 let a = String.strip ~chars a and b = String.strip ~chars b in
250 let argspec = List.sort ~cmp argspec in
251 (* Make the options line up nicely. *)
254 (* Parse the command line. This will exit if --version or --help found. *)
255 Arg.parse argspec anon_arg usage_msg;
257 let testimages = !testimages in
258 let debug = !debug in
259 let uri = if !uri = "" then None else Some !uri in
261 (* Discard the first anonymous argument if, above, we previously
262 * found it contained the tool name.
264 let anon_args = List.rev !anon_args in
266 if ignore_first_anon_arg then List.tl anon_args else anon_args in
268 (* At this point, either --help was specified on the command line
269 * (and so the program has exited) or we must have determined tool,
270 * or the user didn't give us a valid tool (eg. "virt-mem foobar").
271 * Detect that final case now and give an error.
273 let name, _, _, _, _, argcheck, beforeksyms, beforeutsname, run =
278 virt-mem: I could not work out which tool you are trying to run.
279 Use 'virt-mem --help' for more help or read the manual page virt-mem(1)");
282 if debug then eprintf "tool = %s\n%!" name;
284 (* Optional argument checking in the tool. *)
287 | Some argcheck -> argcheck debug
290 (* Get the kernel images. *)
292 if testimages = [] then (
295 try C.connect_readonly ?name ()
296 with Libvirt.Virterror err ->
297 prerr_endline (Libvirt.Virterror.to_string err);
298 (* If non-root and no explicit connection URI, print a warning. *)
299 if Unix.geteuid () <> 0 && name = None then (
300 print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
304 (* If we have a list of parameters, then it is the domain names / UUIDs /
305 * IDs ONLY that we wish to display. Otherwise, display all active.
308 if anon_args = [] then (
309 (* List of active domains. *)
310 let nr_active_doms = C.num_of_domains conn in
312 Array.to_list (C.list_domains conn nr_active_doms) in
313 List.map (D.lookup_by_id conn) active_doms
318 try D.lookup_by_uuid_string conn arg
320 try D.lookup_by_name conn arg
322 try D.lookup_by_id conn (int_of_string arg)
324 failwith (sprintf (f_"%s: unknown domain (not a UUID, name or ID of any active domain)") arg) in
326 (* XXX Primitive test to see if the domain is active. *)
327 let is_active = try D.get_id dom >= 0 with _ -> false in
328 if not is_active then
329 failwith (sprintf (f_"%s: domain is not running") arg);
336 let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
339 let xmls = List.map (fun (dom, xml) ->
340 dom, Xml.parse_string xml) xmls in
342 (* XXX Do something with the XML XXX
343 * such as detecting arch, wordsize, endianness.
353 let domname = D.get_name dom in
356 match !def_wordsize with
359 (sprintf (f_"%s: use -W to define word size for this image")
363 match !def_endian with
366 (sprintf (f_"%s: use -E to define endianness for this image")
371 match !def_architecture with
372 | Some I386 -> I386 | Some X86_64 -> X86_64
375 (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") domname) in
377 if !def_text_addr = 0L then
379 (sprintf (f_"%s: use -T to define kernel load address for this image") domname);
381 let start_t = gettimeofday () in
383 (* Read the kernel memory.
384 * Maximum 64K can be read over remote connections.
386 let str = String.create kernel_size in
388 let remaining = kernel_size - i in
389 if remaining > 0 then (
390 let size = min remaining max_memory_peek in
391 D.memory_peek dom [D.Virtual]
392 (!def_text_addr +^ Int64.of_int i) size str i;
399 let end_t = gettimeofday () in
400 eprintf "timing: downloading kernel took %f seconds\n%!"
404 (* Map the virtual memory. *)
405 let mem = Virt_mem_mmap.of_string str !def_text_addr in
407 (* Force the wordsize and endianness. *)
408 let mem = Virt_mem_mmap.set_wordsize mem wordsize in
409 let mem = Virt_mem_mmap.set_endian mem endian in
411 { dom = Some dom; domname = domname; mem = mem; arch = arch }
414 (* One or more -t options passed. *)
415 if anon_args <> [] then
416 failwith (s_"virt-mem: if -t given on command line, then no domain arguments should be listed");
419 fun (wordsize, endian, arch, text_addr, filename) ->
420 (* Quite a lot of limitations on the kernel images we can
421 * handle at the moment ...
423 (* XXX We could auto-detect wordsize easily. *)
428 (sprintf (f_"%s: use -W to define word size for this image")
435 (sprintf (f_"%s: use -E to define endianness for this image")
441 | Some I386 -> I386 | Some X86_64 -> X86_64
444 (sprintf (f_"%s: use -A to define architecture (i386/x86-64 only) for this image") filename) in
446 if text_addr = 0L then
448 (sprintf (f_"%s: use -T to define kernel load address for this image")
451 (* Map the virtual memory. *)
452 let fd = openfile filename [O_RDONLY] 0 in
453 let mem = Virt_mem_mmap.of_file fd text_addr in
455 (* Force the wordsize and endianness. *)
456 let mem = Virt_mem_mmap.set_wordsize mem wordsize in
457 let mem = Virt_mem_mmap.set_endian mem endian in
459 { dom = None; domname = filename; mem = mem; arch = arch }
463 (* Optional callback into the tool before we start looking for
466 (match beforeksyms with
468 | Some beforeksyms -> beforeksyms debug images
471 (* If there are no more callback functions, then there is no point
472 * continuing with the rest of the program (kernel symbol analysis) ...
474 if beforeutsname = None && run = None then exit 0;
476 (* Do the kernel symbol analysis. *)
480 (* Look for ordinary kernel symbols: *)
481 let image = Virt_mem_ksyms.find_kernel_symbols debug image in
482 (* Look for kallsyms: *)
483 let image = Virt_mem_kallsyms.find_kallsyms debug image in
486 (* Finally, just wrap the lookup_ksym call in something
487 * which prints the query when debug is set.
491 let (domid, name, arch, mem, lookup_ksym) = image in
492 let lookup_ksym sym =
494 let value = lookup_ksym sym in
495 eprintf "lookup_ksym %S = %Lx\n%!" sym value;
498 eprintf "lookup_ksym %S failed\n%!" sym;
501 (domid, name, arch, mem, lookup_ksym)
509 (* Before utsname analysis. *)
510 (match beforeutsname with
512 | Some beforeutsname -> List.iter (beforeutsname debug) images
515 (* If there are no more callback functions, then there is no point
516 * continuing with the rest of the program (kernel version analysis) ...
518 if run = None then exit 0;
520 (* Get the kernel version (utsname analysis). *)
521 let images = List.map (Virt_mem_utsname.find_utsname debug) images in
523 (* Run the tool's main function. *)
526 | Some run -> List.iter (run debug) images