X-Git-Url: http://git.annexia.org/?p=virt-mem.git;a=blobdiff_plain;f=uname%2Fvirt_uname.ml;h=d90974d2d8b950e85c01645414b617656b8b0849;hp=dcdf5c8e90f3e2f5027317dd7b8c7e669e6324cd;hb=cf4669f31197abcfb14dee874a4b738c9c2e6483;hpb=91d5f5dedf46f607388e0a1cd77f540e24b0b0ba

diff --git a/uname/virt_uname.ml b/uname/virt_uname.ml
index dcdf5c8..d90974d 100644
--- a/uname/virt_uname.ml
+++ b/uname/virt_uname.ml
@@ -21,80 +21,22 @@ open Printf
 
 open Virt_mem_gettext.Gettext
 open Virt_mem_utils
-open Virt_mem_mmap
-
-let usage = s_"NAME
-  virt-uname - uname command for virtual machines
-
-SUMMARY
-  virt-uname [-options] [domains]
-
-DESCRIPTION
-  virt-uname prints the uname information such as OS version,
-  architecture and node name for virtual machines running under
-  libvirt."
-
-let verbose, images = Virt_mem.start usage
-
-let () =
-  (* Print new_utsname structure from bitstring. *)
-  let print_new_utsname name bs =
-    (* Truncate an OCaml string at the first ASCII NUL character, ie. as
-     * if it were a C string.
-     *)
-    let truncate str =
-      try
-	let i = String.index str '\000' in
-	String.sub str 0 i
-      with
-	Not_found -> str
-    in
-    bitmatch bs with
-    | { sysname : 65*8 : string;
-	nodename : 65*8 : string;
-	release : 65*8 : string;
-	version : 65*8 : string;
-	machine : 65*8 : string;
-	domainname : 65*8 : string } ->
-	printf "%s: %s %s %s %s %s %s\n"
-	  name
-	  (truncate sysname) (truncate nodename) (truncate release)
-	  (truncate version) (truncate machine) (truncate domainname)
-    | { _ } ->
-	eprintf (f_"%s: unexpected system_utsname in kernel image\n")
-	  name
-  in
-
-  List.iter (
-    fun (name, arch, mem, lookup_ksym) ->
-      (* In Linux 2.6.25, the symbol is init_uts_ns.
-       * http://lxr.linux.no/linux/init/version.c
-       *)
-      try
-	let addr = lookup_ksym "init_uts_ns" in
-	if verbose then printf "init_uts_ns at %Lx\n" addr;
-
-	let bs = Bitmatch.bitstring_of_string (get_bytes mem addr (65*6+4)) in
-	(bitmatch bs with
-	 | { _ : 32 : int;		(* the kref, atomic_t, always 32 bits *)
-	     new_utsname : -1 : bitstring } ->
-	     print_new_utsname name new_utsname
-	 | { _ } ->
-	     eprintf (f_"%s: unexpected init_uts_ns in kernel image\n")
-	       name)
-      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
-	    let addr = lookup_ksym "system_utsname" in
-	    if verbose then printf "system_utsname at %Lx\n" addr;
-
-	    let bs =
-	      Bitmatch.bitstring_of_string (get_bytes mem addr (65*6)) in
-	    print_new_utsname name bs
-	  with
-	    Not_found ->
-	      eprintf (f_"%s: could not find utsname in kernel image\n") name
-  ) images
+open Virt_mem_types
+
+let run debug { domname = domname } { utsname = utsname } =
+  match utsname with
+  | Some u ->
+      printf "%s: %s %s %s %s %s %s\n"
+	domname
+	u.kernel_name u.nodename u.kernel_release
+	u.kernel_version u.machine u.domainname
+  | None ->
+      eprintf (f_"%s: no system_utsname in kernel image\n") domname
+
+let summary = s_"uname command for virtual machines"
+let description = s_"\
+virt-uname prints the uname information such as OS version,
+architecture and node name for virtual machines running under
+libvirt."
+
+let () = Virt_mem.register "uname" summary description ~needs_utsname:true ~run