(* virt-dmesg
 * (C) Copyright 2008-2011 Red Hat Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 *)

module C = Libvirt.Connect
module D = Libvirt.Domain

open Printf

open Utils

(* Set the program name. *)
let () =
  let str = Sys.executable_name in
  let str =
    try
      let i = String.rindex str '/' + 1 in
      String.sub str i (String.length str - i)
    with
      Not_found -> str in

  if str <> "" then set_program_name str

type mode = DMesg | Dump | UName

(* Handle command line arguments. *)
let guest_name, mode, uri =
  let mode = ref (
    match get_program_name () with
    | "virt-uname" | "uname" -> UName
    | _ -> DMesg
  ) in
  let set_mode_dump () = mode := Dump in
  let set_mode_uname () = mode := UName in
  let uri = ref None in
  let set_uri = function "" -> uri := None | u -> uri := Some u in

  let display_version () =
    printf "%s %s ocaml-libvirt %s\n"
      Config.package Config.version Libvirt_version.version;
    exit 0
  in

  let argspec = Arg.align [
    "-c", Arg.String set_uri, "uri Connect to libvirt URI";
    "--connect", Arg.String set_uri, "uri Connect to libvirt URI";
    "--dump-kernel", Arg.Unit set_mode_dump, " Dump kernel memory to stdout";
    "--uname", Arg.Unit set_mode_uname, " Display utsname";
    "-v", Arg.Unit set_debug, " Verbose messages (for debugging)";
    "-V", Arg.Unit display_version, " Display version number and exit";
    "--version", Arg.Unit display_version, " Display version number and exit";
  ] in

  let anon_fun, get_args =
    let args = ref [] in
    let anon_fun str = args := str :: !args in
    let get_args () = List.rev !args in
    anon_fun, get_args
  in

  let usage_msg = "\
virt-dmesg: a 'dmesg'-like utility for virtual machines

Usage:
  virt-dmesg [--options] Guest

where 'Guest' is the name of a running virtual machine.

For documentation see the virt-dmesg(1) man page.

Options:
" in

  Arg.parse argspec anon_fun usage_msg;

  let guest_name =
    match get_args () with
    | [n] -> n
    | [] -> error "no guest name given on command line"; exit 1
    | _ -> error "too many command line arguments"; exit 1 in

  guest_name, !mode, !uri

(* Connect to libvirt. *)
let conn =
  let name = uri in
  try
    C.connect ?name ()
  with Libvirt.Virterror err ->
    prerr_endline (Libvirt.Virterror.to_string err);
    exit 1

let dom =
  (* Try in order: UUID, name, ID. *)
  let dom =
    try (*D.lookup_by_uuid_string conn guest_name*)raise Exit(*XXX*)
    with _ ->
      try D.lookup_by_name conn guest_name
      with _ ->
        try D.lookup_by_id conn (int_of_string guest_name)
        with _ ->
          error "%s: unknown domain, not UUID, name or ID of any running guest."
            guest_name;
          exit 1 in
  let is_active = try D.get_id dom >= 0 with _ -> false in
  if not is_active then (
    error "%s: domain is not running" guest_name;
    exit 1
  );
  dom

(* Search for kernel. *)
let () =
  let k, symbols =
    match mode with
    | DMesg | UName ->
        (try Search.search dom
         with Not_found ->
           error "cannot find kernel

If this is a Linux virtual machine, try:

  virt-dmesg --dump-kernel %s | strings | less

See virt-dmesg(1) man page for more suggestions." guest_name;
           exit 1
        )

    | Dump ->                           (* --dump-kernel *)
        (try Search.search ~dump:true dom
         with Not_found ->
           error "cannot find kernel";
           exit 1
        ) in

  debug "%s %s kernel found at address %Lx"
    (Kernel.string_of_endian k.Kernel.endian)
    (Kernel.string_of_wordsize k.Kernel.wordsize)
    k.Kernel.base_addr;

  match mode with
  | Dump ->
      exit 0

  | DMesg ->
      (try
         (* I don't know why but this symbol doesn't exist in 2.6.9
          * even in kallsyms.  Hence this won't work with that kernel.
          * It's possible we can fall back to memory scanning. XXX
          *)
         let log_buf = StringMap.find "log_buf" symbols in
         let log_buf = Kernel.follow_pointer k log_buf in
         let log_buf_len = StringMap.find "log_buf_len" symbols in
         let log_buf_len = Kernel.get_int32 k log_buf_len in
         (*	let log_start = StringMap.find "log_start" symbols in
	        let log_start = Kernel.get_int64 k log_start in *)
         let log_end = StringMap.find "log_end" symbols in
         let log_end = Kernel.get_int64 k log_end in
         (*	let con_start = StringMap.find "con_start" symbols in
	        let con_start = Kernel.get_int64 k con_start in *)
         let logged_chars = StringMap.find "logged_chars" symbols in
         let logged_chars = Kernel.get_int64 k logged_chars in

         (* This is basically the same algorithm from
          * printk.c:do_syslog type=3, translated into OCaml.  Unlike
          * the kernel version however we don't copy the buffer
          * backwards.
          *)
         let get_log_buf idx =
           let addr = log_buf +^ (idx &^ (log_buf_len -^ 1L)) in
           Char.chr (Kernel.get_byte k addr)
         in

         let count = log_buf_len in
         let count = if count > logged_chars then logged_chars else count in
         let limit = log_end in

         let rec loop i =
           if i >= 0L then (
	     let j = limit-^1L-^i in
	     if j +^ log_buf_len >= log_end then (
	       let c = get_log_buf j in
	       printf "%c" c;
	       loop (i-^1L)
	     )
           )
         in
         loop (count-^1L)
       with
         Not_found ->
           error "could not find kernel log buffer in kernel image";
           error "try: %s --dump-kernel %s | strings | less"
             (get_program_name ()) guest_name;
           exit 1
      )

  | UName ->
      let addr =
        (* In Linux 2.6.25, the symbol is init_uts_ns.
         * http://lxr.linux.no/linux/init/version.c
         *)
        try Some (StringMap.find "init_uts_ns" symbols)
        with Not_found ->
          (* In Linux 2.6.9, the symbol is system_utsname.
           * http://lxr.linux.no/linux-bk+v2.6.9/include/linux/utsname.h#L24
           *)
          try Some (StringMap.find "system_utsname" symbols)
          with Not_found -> None in

      match addr with
      | None ->
          error "init_uts_ns nor system_utsname symbols not found in this kernel";
          error "try: %s --dump-kernel %s | strings | less"
             (get_program_name ()) guest_name;
          exit 1

      | Some addr ->
          (* In versions with init_uts_ns, the table is prefixed by a
           * kref (atomic_t, always 4 bytes).  Since we know that the
           * first interesting string is "Linux\000" we can just search
           * for that and discard anything before that.
           *)
          let addr =
            if Kernel.get_string k (addr+^4L) = "Linux" then
              addr +^ 4L
            else
              addr in

          let system = Kernel.get_string k addr in

          (* Sanity check. *)
          if system <> "Linux" then (
            error "utsname symbols found in kernel, but points to unknown structure";
            error "try: %s --dump-kernel %s | strings | less"
             (get_program_name ()) guest_name;
            exit 1
          );

          let nodename   = Kernel.get_string k (addr +^ 65L      ) in
          let release    = Kernel.get_string k (addr +^ 65L *^ 2L) in
          let version    = Kernel.get_string k (addr +^ 65L *^ 3L) in
          let machine    = Kernel.get_string k (addr +^ 65L *^ 4L) in
          let domainname = Kernel.get_string k (addr +^ 65L *^ 5L) in

          printf "%s %s %s %s %s %s\n"
            system nodename release version machine domainname