src/main.ml

   1 (* virt-dmesg
   2  * (C) Copyright 2008-2011 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  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.
  17  *)
  18
  19 module C = Libvirt.Connect
  20 module D = Libvirt.Domain
  21
  22 open Printf
  23
  24 open Utils
  25
  26 (* Set the program name. *)
  27 let () =
  28   let str = Sys.executable_name in
  29   let str =
  30     try
  31       let i = String.rindex str '/' + 1 in
  32       String.sub str i (String.length str - i)
  33     with
  34       Not_found -> str in
  35
  36   if str <> "" then set_program_name str
  37
  38 type mode = DMesg | Dump | UName
  39
  40 (* Handle command line arguments. *)
  41 let guest_name, mode, uri =
  42   let mode = ref (
  43     match get_program_name () with
  44     | "virt-uname" | "uname" -> UName
  45     | _ -> DMesg
  46   ) in
  47   let set_mode_dump () = mode := Dump in
  48   let set_mode_uname () = mode := UName in
  49   let uri = ref None in
  50   let set_uri = function "" -> uri := None | u -> uri := Some u in
  51
  52   let display_version () =
  53     printf "%s %s ocaml-libvirt %s\n"
  54       Config.package Config.version Libvirt_version.version;
  55     exit 0
  56   in
  57
  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";
  66   ] in
  67
  68   let anon_fun, get_args =
  69     let args = ref [] in
  70     let anon_fun str = args := str :: !args in
  71     let get_args () = List.rev !args in
  72     anon_fun, get_args
  73   in
  74
  75   let usage_msg = "\
  76 virt-dmesg: a 'dmesg'-like utility for virtual machines
  77
  78 Usage:
  79   virt-dmesg [--options] Guest
  80
  81 where 'Guest' is the name of a running virtual machine.
  82
  83 For documentation see the virt-dmesg(1) man page.
  84
  85 Options:
  86 " in
  87
  88   Arg.parse argspec anon_fun usage_msg;
  89
  90   let guest_name =
  91     match get_args () with
  92     | [n] -> n
  93     | [] -> error "no guest name given on command line"; exit 1
  94     | _ -> error "too many command line arguments"; exit 1 in
  95
  96   guest_name, !mode, !uri
  97
  98 (* Connect to libvirt. *)
  99 let conn =
 100   let name = uri in
 101   try
 102     C.connect ?name ()
 103   with Libvirt.Virterror err ->
 104     prerr_endline (Libvirt.Virterror.to_string err);
 105     exit 1
 106
 107 let dom =
 108   (* Try in order: UUID, name, ID. *)
 109   let dom =
 110     try (*D.lookup_by_uuid_string conn guest_name*)raise Exit(*XXX*)
 111     with _ ->
 112       try D.lookup_by_name conn guest_name
 113       with _ ->
 114         try D.lookup_by_id conn (int_of_string guest_name)
 115         with _ ->
 116           error "%s: unknown domain, not UUID, name or ID of any running guest."
 117             guest_name;
 118           exit 1 in
 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;
 122     exit 1
 123   );
 124   dom
 125
 126 (* Search for kernel. *)
 127 let () =
 128   let k, symbols =
 129     match mode with
 130     | DMesg | UName ->
 131         (try Search.search dom
 132          with Not_found ->
 133            error "cannot find kernel
 134
 135 If this is a Linux virtual machine, try:
 136
 137   virt-dmesg --dump-kernel %s | strings | less
 138
 139 See virt-dmesg(1) man page for more suggestions." guest_name;
 140            exit 1
 141         )
 142
 143     | Dump ->                           (* --dump-kernel *)
 144         (try Search.search ~dump:true dom
 145          with Not_found ->
 146            error "cannot find kernel";
 147            exit 1
 148         ) in
 149
 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)
 153     k.Kernel.base_addr;
 154
 155   match mode with
 156   | Dump ->
 157       exit 0
 158
 159   | DMesg ->
 160       (try
 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
 164           *)
 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
 177
 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
 181           * backwards.
 182           *)
 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)
 186          in
 187
 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
 191
 192          let rec loop i =
 193            if i >= 0L then (
 194              let j = limit-^1L-^i in
 195              if j +^ log_buf_len >= log_end then (
 196                let c = get_log_buf j in
 197                printf "%c" c;
 198                loop (i-^1L)
 199              )
 200            )
 201          in
 202          loop (count-^1L)
 203        with
 204          Not_found ->
 205            error "could not find kernel log buffer in kernel image";
 206            error "try: %s --dump-kernel %s | strings | less"
 207              (get_program_name ()) guest_name;
 208            exit 1
 209       )
 210
 211   | UName ->
 212       let addr =
 213         (* In Linux 2.6.25, the symbol is init_uts_ns.
 214          * http://lxr.linux.no/linux/init/version.c
 215          *)
 216         try Some (StringMap.find "init_uts_ns" symbols)
 217         with Not_found ->
 218           (* In Linux 2.6.9, the symbol is system_utsname.
 219            * http://lxr.linux.no/linux-bk+v2.6.9/include/linux/utsname.h#L24
 220            *)
 221           try Some (StringMap.find "system_utsname" symbols)
 222           with Not_found -> None in
 223
 224       match addr with
 225       | None ->
 226           error "init_uts_ns nor system_utsname symbols not found in this kernel";
 227           error "try: %s --dump-kernel %s | strings | less"
 228              (get_program_name ()) guest_name;
 229           exit 1
 230
 231       | Some addr ->
 232           (* In versions with init_uts_ns, the table is prefixed by a
 233            * kref (atomic_t, always 4 bytes).  Since we know that the
 234            * first interesting string is "Linux\000" we can just search
 235            * for that and discard anything before that.
 236            *)
 237           let addr =
 238             if Kernel.get_string k (addr+^4L) = "Linux" then
 239               addr +^ 4L
 240             else
 241               addr in
 242
 243           let system = Kernel.get_string k addr in
 244
 245           (* Sanity check. *)
 246           if system <> "Linux" then (
 247             error "utsname symbols found in kernel, but points to unknown structure";
 248             error "try: %s --dump-kernel %s | strings | less"
 249              (get_program_name ()) guest_name;
 250             exit 1
 251           );
 252
 253           let nodename   = Kernel.get_string k (addr +^ 65L      ) in
 254           let release    = Kernel.get_string k (addr +^ 65L *^ 2L) in
 255           let version    = Kernel.get_string k (addr +^ 65L *^ 3L) in
 256           let machine    = Kernel.get_string k (addr +^ 65L *^ 4L) in
 257           let domainname = Kernel.get_string k (addr +^ 65L *^ 5L) in
 258
 259           printf "%s %s %s %s %s %s\n"
 260             system nodename release version machine domainname