-open Virt_mem_mmap
-
-let run debug images =
- (* 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
- (* Expect the first (sysname) field to always be "Linux", which is
- * also a good way to tell if we're synchronized to the right bit of
- * memory.
- *)
- bitmatch bs with
- | { "Linux\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000" : 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: Linux %s %s %s %s %s\n"
- name
- (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
-
- let bs = Bitstring.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
-
- let bs =
- Bitstring.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