2 * (C) Copyright 2008-2011 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 module C = Libvirt.Connect
20 module D = Libvirt.Domain
26 (* Set the program name. *)
28 let str = Sys.executable_name in
31 let i = String.rindex str '/' + 1 in
32 String.sub str i (String.length str - i)
36 if str <> "" then set_program_name str
38 type mode = DMesg | Dump | UName
40 (* Handle command line arguments. *)
41 let guest_name, mode, uri =
43 match get_program_name () with
44 | "virt-uname" | "uname" -> UName
47 let set_mode_dump () = mode := Dump in
48 let set_mode_uname () = mode := UName in
50 let set_uri = function "" -> uri := None | u -> uri := Some u in
52 let display_version () =
53 printf "%s %s ocaml-libvirt %s\n"
54 Config.package Config.version Libvirt_version.version;
58 let argspec = Arg.align [
59 "-c", Arg.String set_uri, "uri Connect to libvirt URI";
60 "--connect", Arg.String set_uri, "uri Connect to libvirt URI";
61 "--dump-kernel", Arg.Unit set_mode_dump, " Dump kernel memory to stdout";
62 "--uname", Arg.Unit set_mode_uname, " Display utsname";
63 "-v", Arg.Unit set_debug, " Verbose messages (for debugging)";
64 "-V", Arg.Unit display_version, " Display version number and exit";
65 "--version", Arg.Unit display_version, " Display version number and exit";
68 let anon_fun, get_args =
70 let anon_fun str = args := str :: !args in
71 let get_args () = List.rev !args in
76 virt-dmesg: a 'dmesg'-like utility for virtual machines
79 virt-dmesg [--options] Guest
81 where 'Guest' is the name of a running virtual machine.
83 For documentation see the virt-dmesg(1) man page.
88 Arg.parse argspec anon_fun usage_msg;
91 match get_args () with
93 | [] -> error "no guest name given on command line"; exit 1
94 | _ -> error "too many command line arguments"; exit 1 in
96 guest_name, !mode, !uri
98 (* Connect to libvirt. *)
103 with Libvirt.Virterror err ->
104 prerr_endline (Libvirt.Virterror.to_string err);
108 (* Try in order: UUID, name, ID. *)
110 try (*D.lookup_by_uuid_string conn guest_name*)raise Exit(*XXX*)
112 try D.lookup_by_name conn guest_name
114 try D.lookup_by_id conn (int_of_string guest_name)
116 error "%s: unknown domain, not UUID, name or ID of any running guest."
119 let is_active = try D.get_id dom >= 0 with _ -> false in
120 if not is_active then (
121 error "%s: domain is not running" guest_name;
126 (* Search for kernel. *)
131 (try Search.search dom
133 error "cannot find kernel
135 If this is a Linux virtual machine, try:
137 virt-dmesg --dump-kernel %s | strings | less
139 See virt-dmesg(1) man page for more suggestions." guest_name;
143 | Dump -> (* --dump-kernel *)
144 (try Search.search ~dump:true dom
146 error "cannot find kernel";
150 debug "%s %s kernel found at address %Lx"
151 (Kernel.string_of_endian k.Kernel.endian)
152 (Kernel.string_of_wordsize k.Kernel.wordsize)
161 (* I don't know why but this symbol doesn't exist in 2.6.9
162 * even in kallsyms. Hence this won't work with that kernel.
163 * It's possible we can fall back to memory scanning. XXX
165 let log_buf = StringMap.find "log_buf" symbols in
166 let log_buf = Kernel.follow_pointer k log_buf in
167 let log_buf_len = StringMap.find "log_buf_len" symbols in
168 let log_buf_len = Kernel.get_int32 k log_buf_len in
169 (* let log_start = StringMap.find "log_start" symbols in
170 let log_start = Kernel.get_int64 k log_start in *)
171 let log_end = StringMap.find "log_end" symbols in
172 let log_end = Kernel.get_int64 k log_end in
173 (* let con_start = StringMap.find "con_start" symbols in
174 let con_start = Kernel.get_int64 k con_start in *)
175 let logged_chars = StringMap.find "logged_chars" symbols in
176 let logged_chars = Kernel.get_int64 k logged_chars in
178 (* This is basically the same algorithm from
179 * printk.c:do_syslog type=3, translated into OCaml. Unlike
180 * the kernel version however we don't copy the buffer
183 let get_log_buf idx =
184 let addr = log_buf +^ (idx &^ (log_buf_len -^ 1L)) in
185 Char.chr (Kernel.get_byte k addr)
188 let count = log_buf_len in
189 let count = if count > logged_chars then logged_chars else count in
190 let limit = log_end in
194 let j = limit-^1L-^i in
195 if j +^ log_buf_len >= log_end then (
196 let c = get_log_buf j in
205 error "could not find kernel log buffer in kernel image";
211 (* In Linux 2.6.25, the symbol is init_uts_ns.
212 * http://lxr.linux.no/linux/init/version.c
214 try Some (StringMap.find "init_uts_ns" symbols)
216 (* In Linux 2.6.9, the symbol is system_utsname.
217 * http://lxr.linux.no/linux-bk+v2.6.9/include/linux/utsname.h#L24
219 try Some (StringMap.find "system_utsname" symbols)
220 with Not_found -> None in
224 error "init_uts_ns nor system_utsname symbols not found in this kernel";
228 (* In versions with init_uts_ns, the table is prefixed by a
229 * kref (atomic_t, always 4 bytes). Since we know that the
230 * first interesting string is "Linux\000" we can just search
231 * for that and discard anything before that.
234 if Kernel.get_string k (addr+^4L) = "Linux" then
239 let system = Kernel.get_string k addr in
242 if system <> "Linux" then (
243 error "utsname symbols found in kernel, but points to unknown structure";
247 let nodename = Kernel.get_string k (addr +^ 65L ) in
248 let release = Kernel.get_string k (addr +^ 65L *^ 2L) in
249 let version = Kernel.get_string k (addr +^ 65L *^ 3L) in
250 let machine = Kernel.get_string k (addr +^ 65L *^ 4L) in
251 let domainname = Kernel.get_string k (addr +^ 65L *^ 5L) in
253 printf "%s %s %s %s %s %s\n"
254 system nodename release version machine domainname