deviceSet.cmo: deviceSet.cmi
deviceSet.cmx: deviceSet.cmi
filetree.cmi: slave.cmi
-filetree.cmo: utils.cmi slave.cmi filetree_type.cmi filetree_ops.cmi deviceSet.cmi filetree.cmi
-filetree.cmx: utils.cmx slave.cmx filetree_type.cmx filetree_ops.cmx deviceSet.cmx filetree.cmi
+filetree.cmo: utils.cmi slave.cmi filetree_type.cmi filetree_ops.cmi filetree_markup.cmi deviceSet.cmi filetree.cmi
+filetree.cmx: utils.cmx slave.cmx filetree_type.cmx filetree_ops.cmx filetree_markup.cmx deviceSet.cmx filetree.cmi
+filetree_markup.cmi: slave.cmi filetree_type.cmi
+filetree_markup.cmo: utils.cmi slave.cmi filetree_type.cmi filetree_markup.cmi
+filetree_markup.cmx: utils.cmx slave.cmx filetree_type.cmx filetree_markup.cmi
filetree_ops.cmi: slave.cmi filetree_type.cmi
-filetree_ops.cmo: utils.cmi slave.cmi filetree_type.cmi filetree_ops.cmi
-filetree_ops.cmx: utils.cmx slave.cmx filetree_type.cmx filetree_ops.cmi
+filetree_ops.cmo: utils.cmi slave.cmi filetree_type.cmi filetree_markup.cmi filetree_ops.cmi
+filetree_ops.cmx: utils.cmx slave.cmx filetree_type.cmx filetree_markup.cmx filetree_ops.cmi
filetree_type.cmi: slave.cmi
filetree_type.cmo: utils.cmi slave.cmi filetree_type.cmi
filetree_type.cmx: utils.cmx slave.cmx filetree_type.cmi
deviceSet.ml \
filetree.mli \
filetree.ml \
+ filetree_markup.mli \
+ filetree_markup.ml \
filetree_ops.mli \
filetree_ops.ml \
filetree_type.mli \
deviceSet.cmx \
slave.cmx \
filetree_type.cmx \
+ filetree_markup.cmx \
filetree_ops.cmx \
filetree.cmx \
window.cmx \
bin_SCRIPTS = guestfs-browser
-OCAMLPACKAGES = libvirt,guestfs,lablgtk2,extlib,xml-light,threads
+OCAMLPACKAGES = \
+ libvirt,guestfs,hivex,lablgtk2,extlib,xml-light,camomile,threads
OCAMLCFLAGS = \
-g \
-warn-error CDEFLMPSUVYZX \
? LV information
? Ext2 superblock info (tune2fs)
-Display Windows Registry as a separate tree.
-
The slave thread should not have to remount filesystems.
If the mount points are the same as the previous command, it
should cache them.
About dialog
+
+Extended attributes, SELinux.
dnl with this program; if not, write to the Free Software Foundation, Inc.,
dnl 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-AC_INIT([guestfs-browser],[0.1.1])
+AC_INIT([guestfs-browser],[0.1.2])
AM_INIT_AUTOMAKE([foreign])
AC_CONFIG_MACRO_DIR([m4])
AC_MSG_ERROR([Please install OCaml module 'guestfs'.])
fi
+AC_CHECK_OCAML_PKG([hivex])
+if test "$OCAML_PKG_hivex" = "no"; then
+ AC_MSG_ERROR([Please install OCaml module 'hivex'.])
+fi
+
AC_CHECK_OCAML_PKG([xml-light])
if test "$OCAML_PKG_xml_light" = "no"; then
AC_MSG_ERROR([Please install OCaml module 'xml-light'.])
fi
+AC_CHECK_OCAML_PKG([camomile])
+if test "$OCAML_PKG_camomile" = "no"; then
+ AC_MSG_ERROR([Please install OCaml module 'camomile'.])
+fi
+
AC_CHECK_OCAML_PKG([extlib])
if test "$OCAML_PKG_extlib" = "no"; then
AC_MSG_ERROR([Please install OCaml module 'extlib'.])
open DeviceSet
open Filetree_type
+open Filetree_markup
open Filetree_ops
module G = Guestfs
type t = Filetree_type.t
+(* Temporary directory for shared use by all instances of this widget,
+ * cleaned up when the program exits.
+ *)
+let tmpdir = tmpdir ()
+
let rec create ~packing () =
let view = GTree.view ~packing () in
(*view#set_rules_hint true;*)
let renderer = GTree.cell_renderer_text [], ["markup", name_col] in
let name_view = GTree.view_column ~title:"Filename" ~renderer () in
name_view#set_resizable true;
+ name_view#set_sizing `AUTOSIZE;
ignore (view#append_column name_view);
let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", size_col] in
let hdata = get_hdata t row in
match hdata with
| { content=(Loading | ErrorMessage _ | Info _) } -> None
- | { content=(Top _ | Directory _ | File _) } -> Some (path, hdata)
+ | { content=(Top _ | Directory _ | File _ |
+ TopWinReg _ | RegKey _ | RegValue _ ) } ->
+ Some (path, hdata)
) paths in
(* Based on number of selected rows and what is selected, construct
menu
-(* Mark up mode. *)
-let markup_of_mode mode =
- let c =
- if is_socket mode then 's'
- else if is_symlink mode then 'l'
- else if is_regular_file mode then '-'
- else if is_block mode then 'b'
- else if is_directory mode then 'd'
- else if is_char mode then 'c'
- else if is_fifo mode then 'p' else '?' in
- let ru = if is_ru mode then 'r' else '-' in
- let wu = if is_wu mode then 'w' else '-' in
- let xu = if is_xu mode then 'x' else '-' in
- let rg = if is_rg mode then 'r' else '-' in
- let wg = if is_wg mode then 'w' else '-' in
- let xg = if is_xg mode then 'x' else '-' in
- let ro = if is_ro mode then 'r' else '-' in
- let wo = if is_wo mode then 'w' else '-' in
- let xo = if is_xo mode then 'x' else '-' in
- let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in
-
- let suid = is_suid mode in
- let sgid = is_sgid mode in
- let svtx = is_svtx mode in
- if suid then str.[3] <- 's';
- if sgid then str.[6] <- 's';
- if svtx then str.[9] <- 't';
-
- "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
-
-(* Mark up dates. *)
-let markup_of_date t =
- (* Guestfs gives us int64's, we want float which is OCaml's
- * equivalent of time_t.
- *)
- let t = Int64.to_float t in
-
- let show_full_date () =
- let tm = localtime t in
- sprintf "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
- (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
- tm.tm_hour tm.tm_min tm.tm_sec
- in
-
- (* How long ago? *)
- let now = time () in
- let ago = now -. t in
- if ago < 0. then (* future *)
- show_full_date ()
- else if ago < 60. then
- "<small>now</small>"
- else if ago < 60. *. 60. then
- sprintf "<small>%.0f minutes ago</small>" (ago /. 60.)
- else if ago < 60. *. 60. *. 24. then
- sprintf "<small>%.0f hours ago</small>" (ago /. 60. /. 60.)
- else if ago < 60. *. 60. *. 24. *. 28. then
- sprintf "<small>%.0f days ago</small>" (ago /. 60. /. 60. /. 24.)
- else
- show_full_date ()
-
-(* Mark up file sizes. *)
-let markup_of_size bytes =
- sprintf "<small>%s</small>" (human_size bytes)
-
let clear { model = model; hash = hash } =
model#clear ();
Hashtbl.clear hash
-let rec add ({ model = model; hash = hash } as t) name data =
+let rec add ({ model = model } as t) name data =
clear t;
(* Populate the top level of the filetree. If there are operating
(* Add top level left-over filesystems. *)
DeviceSet.iter (add_top_level_vol t name) other_filesystems;
+ (* If it's Windows and registry files exist, create a node for
+ * each file.
+ *)
+ List.iter (
+ fun os ->
+ (match os.Slave.insp_winreg_SAM with
+ | Some filename ->
+ add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SAM" filename
+ | None -> ()
+ );
+ (match os.Slave.insp_winreg_SECURITY with
+ | Some filename ->
+ add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SECURITY"
+ filename
+ | None -> ()
+ );
+ (match os.Slave.insp_winreg_SOFTWARE with
+ | Some filename ->
+ add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
+ filename
+ | None -> ()
+ );
+ (match os.Slave.insp_winreg_SYSTEM with
+ | Some filename ->
+ add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SYSTEM"
+ filename
+ | None -> ()
+ );
+ (match os.Slave.insp_winreg_DEFAULT with
+ | Some filename ->
+ add_top_level_winreg t name os "HKEY_USERS\\.DEFAULT" filename
+ | None -> ()
+ );
+ ) data.Slave.insp_oses;
+
(* Expand the first top level node. *)
match model#get_iter_first with
| None -> ()
| Some row ->
t.view#expand_row (model#get_path row)
-and add_top_level_os ({ model = model; hash = hash } as t) name os =
+(* Add a top level operating system node. *)
+and add_top_level_os ({ model = model } as t) name os =
let markup =
sprintf "<b>%s</b>\n<small>%s</small>\n<small>%s</small>"
(markup_escape name) (markup_escape os.Slave.insp_hostname)
(markup_escape os.Slave.insp_product_name) in
let row = model#append () in
- make_node t row (Top (Slave.OS os));
+ make_node t row (Top (Slave.OS os)) None;
model#set ~row ~column:t.name_col markup
-and add_top_level_vol ({ model = model; hash = hash } as t) name dev =
+(* Add a top level volume (left over filesystem) node. *)
+and add_top_level_vol ({ model = model } as t) name dev =
let markup =
sprintf "<b>%s</b>\n<small>from %s</small>"
(markup_escape dev) (markup_escape name) in
let row = model#append () in
- make_node t row (Top (Slave.Volume dev));
+ make_node t row (Top (Slave.Volume dev)) None;
+ model#set ~row ~column:t.name_col markup
+
+(* Add a top level Windows Registry node. *)
+and add_top_level_winreg ({ model = model } as t) name os rootkey
+ remotefile =
+ let cachefile = tmpdir // string_of_int (unique ()) ^ ".hive" in
+
+ let markup =
+ sprintf "<b>%s</b>\n<small>from %s</small>"
+ (markup_escape rootkey) (markup_escape name) in
+
+ let row = model#append () in
+ make_node t row
+ (TopWinReg (Slave.OS os, rootkey, remotefile, cachefile)) None;
model#set ~row ~column:t.name_col markup
(* Generic function to make an openable node to the tree. *)
-and make_node ({ model = model; hash = hash } as t) row content =
- let hdata = { state=NodeNotStarted; content=content; visited=false } in
+and make_node ({ model = model } as t) row content hiveh =
+ let hdata =
+ { state=NodeNotStarted; content=content; visited=false; hiveh=hiveh } in
store_hdata t row hdata;
(* Create a placeholder "loading ..." row underneath this node so
* the user has something to expand.
*)
let placeholder = model#append ~parent:row () in
- let hdata = { state=IsLeaf; content=Loading; visited=false } in
+ let hdata = { state=IsLeaf; content=Loading; visited=false; hiveh=None } in
store_hdata t placeholder hdata;
model#set ~row:placeholder ~column:t.name_col "<i>Loading ...</i>";
ignore (t.view#connect#row_expanded ~callback:(expand_row t))
-and make_leaf ({ model = model; hash = hash } as t) row content =
- let hdata = { state=IsLeaf; content=content; visited=false } in
+and make_leaf ({ model = model } as t) row content hiveh =
+ let hdata = { state=IsLeaf; content=content; visited=false; hiveh=hiveh } in
store_hdata t row hdata
(* This is called when the user expands a row. *)
-and expand_row ({ model = model; hash = hash } as t) row _ =
+and expand_row ({ model = model } as t) row _ =
match get_hdata t row with
| { state=NodeNotStarted; content=Top src } as hdata ->
(* User has opened a top level node that was not previously opened. *)
Slave.read_directory ~fail:(when_read_directory_fail t path)
src pathname (when_read_directory t path)
+ | { state=NodeNotStarted;
+ content=TopWinReg (src, rootkey, remotefile, cachefile) } as hdata ->
+ (* User has opened a Windows Registry top level node
+ * not previously opened.
+ *)
+
+ (* Mark this row as loading. *)
+ hdata.state <- NodeLoading;
+
+ (* Get a stable path for this row. *)
+ let path = model#get_path row in
+
+ (* Since the user has opened this top level registry node for the
+ * first time, we now need to download the hive.
+ *)
+ Slave.download_file ~fail:(when_downloaded_registry_fail t path)
+ src remotefile cachefile (when_downloaded_registry t path)
+
+ | { state=NodeNotStarted; content=RegKey node } as hdata ->
+ (* User has opened a Windows Registry key node not previously opened. *)
+
+ (* Mark this row as loading. *)
+ hdata.state <- NodeLoading;
+
+ expand_hive_node t row node
+
+ (* Ignore when a user opens a node which is loading or has been loaded. *)
| { state=(NodeLoading|IsNode) } -> ()
(* These are not nodes so it should never be possible to open them. *)
- | { content=File _ } | { state=IsLeaf } -> assert false
+ | { content=(File _ | RegValue _) } | { state=IsLeaf } -> assert false
(* Node should not exist in the tree. *)
| { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
direntry in
let row = model#append ~parent:row () in
if is_directory stat.G.mode then
- make_node t row (Directory direntry)
+ make_node t row (Directory direntry) None
else
- make_leaf t row (File direntry);
+ make_leaf t row (File direntry) None;
model#set ~row ~column:t.name_col (markup_of_name direntry);
model#set ~row ~column:t.mode_col (markup_of_mode stat.G.mode);
model#set ~row ~column:t.size_col (markup_of_size stat.G.size);
let row = model#get_iter path in
let row = model#iter_children ~nth:0 (Some row) in
- let hdata = { state=IsLeaf; content=ErrorMessage msg; visited=false } in
+ let hdata =
+ { state=IsLeaf; content=ErrorMessage msg; visited=false; hiveh=None } in
store_hdata t row hdata;
model#set ~row ~column:t.name_col (markup_escape msg)
| exn ->
(* unexpected exception: re-raise it *)
raise exn
+
+(* Called when the top level registry node has been opened and the
+ * hive file was downloaded to the cache file successfully.
+ *)
+and when_downloaded_registry ({ model = model } as t) path () =
+ debug "when_downloaded_registry";
+ let row = model#get_iter path in
+
+ let hdata = get_hdata t row in
+ match hdata.content with
+ | TopWinReg (src, rootkey, remotefile, cachefile) ->
+ (try
+ (* Open the hive and save the hive handle in the row hdata. *)
+ let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
+ let h = Hivex.open_file cachefile flags in
+ hdata.hiveh <- Some h;
+
+ (* Continue as if expanding any other hive node. *)
+ let root = Hivex.root h in
+ expand_hive_node t row root
+ with
+ Hivex.Error _ as exn -> when_downloaded_registry_fail t path exn
+ )
+ | _ -> assert false
+
+(* Called instead of {!when_downloaded_registry} if the download failed. *)
+and when_downloaded_registry_fail ({ model = model } as t) path exn =
+ debug "when_downloaded_registry_fail: %s" (Printexc.to_string exn);
+
+ match exn with
+ | G.Error msg
+ | Hivex.Error (_, _, msg) ->
+ let row = model#get_iter path in
+ let row = model#iter_children ~nth:0 (Some row) in
+
+ let hdata =
+ { state=IsLeaf; content=ErrorMessage msg; visited=false; hiveh=None } in
+ store_hdata t row hdata;
+
+ model#set ~row ~column:t.name_col (markup_escape msg)
+
+ | exn ->
+ (* unexpected exception: re-raise it *)
+ raise exn
+
+(* Expand a hive node. *)
+and expand_hive_node ({ model = model } as t) row node =
+ debug "expand_hive_node";
+ let hdata = get_hdata t row in
+ let h = Option.get hdata.hiveh in
+
+ (* Read the hive entries (values, subkeys) at this node and add them
+ * to the tree.
+ *)
+ let values = Hivex.node_values h node in
+ let cmp v1 v2 = compare (Hivex.value_key h v1) (Hivex.value_key h v2) in
+ Array.sort cmp values;
+ Array.iter (
+ fun value ->
+ let row = model#append ~parent:row () in
+ make_leaf t row (RegValue value) (Some h);
+ model#set ~row ~column:t.name_col (markup_of_regvalue h value);
+ model#set ~row ~column:t.size_col (markup_of_regvaluesize h value);
+ model#set ~row ~column:t.date_col (markup_of_regvaluetype h value);
+ ) values;
+
+ let children = Hivex.node_children h node in
+ let cmp n1 n2 = compare (Hivex.node_name h n1) (Hivex.node_name h n2) in
+ Array.sort cmp children;
+ Array.iter (
+ fun node ->
+ let row = model#append ~parent:row () in
+ make_node t row (RegKey node) (Some h);
+ model#set ~row ~column:t.name_col (markup_of_regkey h node);
+ ) children;
+
+ (* Remove the placeholder "Loading" entry. NB. Must be done AFTER
+ * adding the other entries, or else Gtk will unexpand the row.
+ *)
+ (try
+ let row = find_child_node_by_content t row Loading in
+ ignore (model#remove row)
+ with Invalid_argument _ | Not_found -> ()
+ );
+
+ (* The original entry has now been loaded, so update its state. *)
+ hdata.state <- IsNode;
+ set_visited t row
val add : t -> string -> Slave.inspection_data -> unit
(** [add t name data] clears out the widget and adds the operating
- system and/or filesystems described by the [data] struct. The
- [name] parameter should be some host-side (verifiable) name;
- usually we pass the name of the guest from libvirt here. *)
+ system and/or filesystems described by the [data] struct.
+
+ The [name] parameter should be some host-side (verifiable) name,
+ not any untrusted string from the guest; usually we pass the
+ name of the guest from libvirt here. *)
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2010 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.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open ExtString
+open ExtList
+open Unix
+
+open CamomileLibrary
+open Default.Camomile
+
+open Utils
+open Filetree_type
+
+open Printf
+
+(* Base colours. XXX Should be configurable somewhere. *)
+let file_color = 0x20, 0x20, 0xff (* regular file *)
+let dir_color = 0x80, 0x80, 0x20 (* directory *)
+let symlink_color = file_color (* symlink *)
+let suid_color = 0x20, 0x20, 0x80 (* setuid bit set on regular file *)
+let suid_bgcolor = 0xff, 0xc0, 0xc0
+let sgid_color = suid_color (* setgid bit set on regular file *)
+let sgid_bgcolor = suid_bgcolor
+let block_color = 0x00, 0x60, 0x60 (* block device *)
+let char_color = block_color (* char device *)
+let fifo_color = 0x60, 0x00, 0x60 (* fifo *)
+let socket_color = fifo_color (* socket *)
+let other_color = file_color (* anything not one of the above *)
+
+(* Mark up a filename for the name_col column.
+ *
+ * See also
+ * http://library.gnome.org/devel/pango/stable/PangoMarkupFormat.html
+ *)
+let rec markup_of_name ?(visited = false) direntry =
+ let name = direntry.Slave.dent_name in
+ let mode = direntry.Slave.dent_stat.Guestfs.mode in
+ if is_directory mode then ( (* directory *)
+ let fg = if not visited then normal dir_color else darken dir_color in
+ sprintf "<span weight=\"bold\" fgcolor=\"%s\">%s</span>"
+ fg (markup_escape name)
+ )
+ else if is_symlink mode then ( (* symlink *)
+ let link = direntry.Slave.dent_link in
+ let fg =
+ if not visited then normal symlink_color else darken symlink_color in
+ sprintf "<span style=\"italic\" fgcolor=\"%s\">%s</span> %s <span style=\"italic\" fgcolor=\"%s\">%s</span>"
+ fg (markup_escape name) utf8_rarrow fg (markup_escape link)
+ )
+ else ( (* not directory, not symlink *)
+ let fg, bg =
+ if is_regular_file mode then (
+ if is_suid mode then suid_color, Some suid_bgcolor
+ else if is_sgid mode then sgid_color, Some sgid_bgcolor
+ else file_color, None
+ )
+ else if is_block mode then block_color, None
+ else if is_char mode then char_color, None
+ else if is_fifo mode then fifo_color, None
+ else if is_socket mode then socket_color, None
+ else other_color, None in
+ let fg = if not visited then normal fg else darken fg in
+ let bg =
+ match bg with
+ | Some bg -> sprintf " bgcolor=\"%s\"" (normal bg)
+ | None -> "" in
+ sprintf "<span fgcolor=\"%s\"%s>%s</span>"
+ fg bg (markup_escape name)
+ )
+
+(* Mark up a registry key. *)
+and markup_of_regkey ?(visited = false) h node =
+ let name = Hivex.node_name h node in
+ let name = if name = "" then "@" else name in
+ let fg = if not visited then normal dir_color else darken dir_color in
+ sprintf "<span fgcolor=\"%s\">%s</span>" fg (markup_escape name)
+
+(* Mark up a registry value. *)
+and markup_of_regvalue ?(visited = false) h value =
+ debug "markup_of_regvalue";
+ let k = Hivex.value_key h value in
+ let t, v = Hivex.value_value h value in
+
+ (* Ignore long values. *)
+ let len = String.length v in
+ let v =
+ if len >= 256 then
+ sprintf "<%d bytes not printed>" len
+ else (
+ (* Deal as best we can with printing the value. *)
+ match t with
+ | Hivex.REG_NONE -> if v = "" then "" else markup_hex_data v
+ | Hivex.REG_SZ -> markup_windows_string v
+ | Hivex.REG_EXPAND_SZ -> markup_windows_string v
+ | Hivex.REG_BINARY -> markup_hex_data v
+ | Hivex.REG_DWORD ->
+ if len = 4 then
+ sprintf "%08lx" (i32_of_string_le v)
+ else
+ markup_hex_data v
+ | Hivex.REG_DWORD_BIG_ENDIAN ->
+ if len = 4 then
+ sprintf "%08lx" (i32_of_string_be v)
+ else
+ markup_hex_data v
+ | Hivex.REG_LINK -> markup_hex_data v
+ | Hivex.REG_MULTI_SZ -> (* XXX could do better with this *)
+ markup_hex_data v
+ | Hivex.REG_RESOURCE_LIST -> markup_hex_data v
+ | Hivex.REG_FULL_RESOURCE_DESCRIPTOR -> markup_hex_data v
+ | Hivex.REG_RESOURCE_REQUIREMENTS_LIST -> markup_hex_data v
+ | Hivex.REG_QWORD ->
+ if len = 8 then
+ sprintf "%016Lx" (i64_of_string_le v)
+ else
+ markup_hex_data v
+ | Hivex.REG_UNKNOWN i32 -> markup_hex_data v
+ ) in
+
+ let fg = if not visited then normal file_color else darken file_color in
+ sprintf "<span fgcolor=\"%s\">%s</span>=<span fgcolor=\"%s\">%s</span>"
+ fg (markup_escape k) fg v
+
+(* Mark up registry value as hex data. *)
+and markup_hex_data v =
+ let vs = String.explode v in
+ let vs = List.mapi (
+ fun i c ->
+ sprintf "%s%02x" (if i mod 16 = 0 then "\n" else "") (int_of_char c)
+ ) vs in
+ String.concat "," vs
+
+(* Best guess the format of the string and convert to UTF-8. *)
+and markup_windows_string v =
+ let utf16le = CharEncoding.utf16le in
+ let utf8 = CharEncoding.utf8 in
+ try
+ let v = CharEncoding.recode_string ~in_enc:utf16le ~out_enc:utf8 v in
+ (* Registry strings include the final \0 so remove this if present. *)
+ let len = UTF8.length v in
+ let v =
+ if len > 0 && UChar.code (UTF8.get v (len-1)) = 0 then
+ String.sub v 0 (UTF8.last v)
+ else
+ v in
+ markup_escape v
+ with
+ | CharEncoding.Malformed_code
+ | CharEncoding.Out_of_range ->
+ (* Fallback to displaying the string as hex. *)
+ markup_hex_data v
+
+and normal (r, g, b) =
+ let r = if r < 0 then 0 else if r > 255 then 255 else r in
+ let g = if g < 0 then 0 else if g > 255 then 255 else g in
+ let b = if b < 0 then 0 else if b > 255 then 255 else b in
+ sprintf "#%02x%02x%02x" r g b
+
+and darken (r, g, b) =
+ normal (r * 4 / 10, g * 4 / 10, b * 4 / 10)
+
+(* Mark up mode. *)
+let markup_of_mode mode =
+ let c =
+ if is_socket mode then 's'
+ else if is_symlink mode then 'l'
+ else if is_regular_file mode then '-'
+ else if is_block mode then 'b'
+ else if is_directory mode then 'd'
+ else if is_char mode then 'c'
+ else if is_fifo mode then 'p' else '?' in
+ let ru = if is_ru mode then 'r' else '-' in
+ let wu = if is_wu mode then 'w' else '-' in
+ let xu = if is_xu mode then 'x' else '-' in
+ let rg = if is_rg mode then 'r' else '-' in
+ let wg = if is_wg mode then 'w' else '-' in
+ let xg = if is_xg mode then 'x' else '-' in
+ let ro = if is_ro mode then 'r' else '-' in
+ let wo = if is_wo mode then 'w' else '-' in
+ let xo = if is_xo mode then 'x' else '-' in
+ let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in
+
+ let suid = is_suid mode in
+ let sgid = is_sgid mode in
+ let svtx = is_svtx mode in
+ if suid then str.[3] <- 's';
+ if sgid then str.[6] <- 's';
+ if svtx then str.[9] <- 't';
+
+ "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
+
+(* Mark up dates. *)
+let markup_of_date t =
+ (* Guestfs gives us int64's, we want float which is OCaml's
+ * equivalent of time_t.
+ *)
+ let t = Int64.to_float t in
+
+ let show_full_date () =
+ let tm = localtime t in
+ sprintf "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
+ (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
+ tm.tm_hour tm.tm_min tm.tm_sec
+ in
+
+ (* How long ago? *)
+ let now = time () in
+ let ago = now -. t in
+ if ago < 0. then (* future *)
+ show_full_date ()
+ else if ago < 60. then
+ "<small>now</small>"
+ else if ago < 60. *. 60. then
+ sprintf "<small>%.0f minutes ago</small>" (ago /. 60.)
+ else if ago < 60. *. 60. *. 24. then
+ sprintf "<small>%.0f hours ago</small>" (ago /. 60. /. 60.)
+ else if ago < 60. *. 60. *. 24. *. 28. then
+ sprintf "<small>%.0f days ago</small>" (ago /. 60. /. 60. /. 24.)
+ else
+ show_full_date ()
+
+(* Mark up file sizes. *)
+let markup_of_size bytes =
+ sprintf "<small>%s</small>" (human_size bytes)
+
+(* Mark up registry value types. *)
+let markup_of_regvaluetype h value =
+ let t, _ = Hivex.value_value h value in
+
+ match t with
+ | Hivex.REG_NONE -> "none(0)"
+ | Hivex.REG_SZ -> "str(1)"
+ | Hivex.REG_EXPAND_SZ -> "str(2)"
+ | Hivex.REG_BINARY -> "hex(3)"
+ | Hivex.REG_DWORD -> "dword(4)"
+ | Hivex.REG_DWORD_BIG_ENDIAN -> "dword(5)"
+ | Hivex.REG_LINK -> "link(6)"
+ | Hivex.REG_MULTI_SZ -> "multi string (7)"
+ | Hivex.REG_RESOURCE_LIST -> "resource list (8)"
+ | Hivex.REG_FULL_RESOURCE_DESCRIPTOR -> "full resource descriptor (9)"
+ | Hivex.REG_RESOURCE_REQUIREMENTS_LIST -> "resource requirements list (10)"
+ | Hivex.REG_QWORD -> "qword (11)"
+ | Hivex.REG_UNKNOWN i32 -> sprintf "type 0x%08lx" i32
+
+(* Mark up registry value sizes. *)
+let markup_of_regvaluesize h value =
+ let _, len = Hivex.value_type h value in
+ sprintf "%d" len
+
+(* This is a bit of a hack. Ideally just setting 'visited' would
+ * darken the colour when the cell was re-rendered. However that would
+ * mean we couldn't store other stuff in the name column. Therefore,
+ * repopulate the name column.
+ *)
+let set_visited ({ model = model; name_col = name_col } as t) row =
+ let hdata = get_hdata t row in
+ if hdata.visited = false then (
+ hdata.visited <- true;
+ match hdata.content with
+ | Directory direntry | File direntry ->
+ debug "set_visited %s" direntry.Slave.dent_name;
+ model#set ~row ~column:name_col
+ (markup_of_name ~visited:true direntry)
+ | RegKey node ->
+ debug "set_visited RegKey";
+ let h = Option.get hdata.hiveh in
+ model#set ~row ~column:name_col
+ (markup_of_regkey ~visited:true h node)
+ | RegValue value ->
+ debug "set_visited RegValue";
+ let h = Option.get hdata.hiveh in
+ model#set ~row ~column:name_col
+ (markup_of_regvalue ~visited:true h value)
+ | Loading | ErrorMessage _ | Info _ | Top _ | TopWinReg _ -> ()
+ )
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2010 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.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+(** Deals with generating markup and displaying fields in the file tree.
+
+ The types and functions in this file should be considered
+ private to the file tree implementation.
+
+ See {!Filetree} for the full description and public interface. *)
+
+(**/**)
+
+val markup_of_name : ?visited:bool -> Slave.direntry -> string
+ (* Create markup for filenames. *)
+
+val markup_of_date : int64 -> string
+ (* Create markup for dates. *)
+
+val markup_of_size : int64 -> string
+ (* Create markup for sizes. *)
+
+val markup_of_mode : int64 -> string
+ (* Create markup for mode (permissions). *)
+
+val markup_of_regkey : ?visited:bool -> Hivex.t -> Hivex.node -> string
+ (* Create markup for registry keys. *)
+
+val markup_of_regvalue : ?visited:bool -> Hivex.t -> Hivex.value -> string
+ (* Create markup for registry values. *)
+
+val markup_of_regvaluetype : Hivex.t -> Hivex.value -> string
+ (* Create markup for registry value types. *)
+
+val markup_of_regvaluesize : Hivex.t -> Hivex.value -> string
+ (* Create markup for registry value sizes. *)
+
+val set_visited : Filetree_type.t -> Gtk.tree_iter -> unit
+ (* Set a file as visited. *)
open Printf
open Utils
-
open Filetree_type
+open Filetree_markup
(* Get the basename of a file, using path conventions which are valid
* for libguestfs. So [Filename.basename] won't necessarily work
if not (has_child_node_equals t row content) then (
(* Create the child node first. *)
let row = model#insert ~parent:row 0 in
- store_hdata t row { state=IsLeaf; content=content; visited=false };
+ let hdata = { state=IsLeaf; content=content; visited=false; hiveh=None } in
+ store_hdata t row hdata;
model#set ~row ~column:t.name_col "<i>Calculating disk usage ...</i>";
Slave.disk_usage src pathname (when_disk_usage t path pathname)
let content = Info "inspection_data" in
if not (has_child_node_equals t row content) then (
let row = model#insert ~parent:row 0 in
- store_hdata t row { state=IsLeaf; content=content; visited=false };
+ let hdata =
+ { state=IsLeaf; content=content; visited=false; hiveh=None } in
+ store_hdata t row hdata;
(* XXX UGHLEE *)
let data =
*)
open Utils
-open Printf
(* See struct/field description in .mli file. *)
type t = {
mutable state : state_t;
content : content_t;
mutable visited : bool;
+ mutable hiveh : Hivex.t option;
}
and state_t =
| ErrorMessage of string
| Info of string
| Top of Slave.source
+ | TopWinReg of Slave.source * string * string * string
| Directory of Slave.direntry
| File of Slave.direntry
+ | RegKey of Hivex.node
+ | RegValue of Hivex.value
(* Store hdata into a row. *)
let store_hdata {model = model; hash = hash; index_col = index_col} row hdata =
* \_ Directory
* \_ Directory
* \_ Loading <--- you are here
+ *
+ * Note this function cannot be called on registry keys.
*)
let rec get_pathname ({ model = model } as t) row =
let hdata = get_hdata t row in
else parent_name ^ "/" ^ name in
src, path
| { content=Top src }, _ -> src, "/"
- | { content=Directory _}, None -> assert false
- | { content=File _}, None -> assert false
+ | { content=Directory _ }, None -> assert false
+ | { content=File _ }, None -> assert false
| { content=Loading }, _ -> assert false
- | { content=ErrorMessage _}, _ -> assert false
- | { content=Info _}, _ -> assert false
-
-(* Base colours. XXX Should be configurable somewhere. *)
-let file_color = 0x20, 0x20, 0xff (* regular file *)
-let dir_color = 0x80, 0x80, 0x20 (* directory *)
-let symlink_color = file_color (* symlink *)
-let suid_color = 0x20, 0x20, 0x80 (* setuid bit set on regular file *)
-let suid_bgcolor = 0xff, 0xc0, 0xc0
-let sgid_color = suid_color (* setgid bit set on regular file *)
-let sgid_bgcolor = suid_bgcolor
-let block_color = 0x00, 0x60, 0x60 (* block device *)
-let char_color = block_color (* char device *)
-let fifo_color = 0x60, 0x00, 0x60 (* fifo *)
-let socket_color = fifo_color (* socket *)
-let other_color = file_color (* anything not one of the above *)
-
-(* Mark up a filename for the name_col column.
- *
- * XXX This shouldn't be in Filetree_type module, but we have to have
- * it here because set_visited is here.
- *
- * See also
- * http://library.gnome.org/devel/pango/stable/PangoMarkupFormat.html
- *)
-let rec markup_of_name ?(visited = false) direntry =
- let name = direntry.Slave.dent_name in
- let mode = direntry.Slave.dent_stat.Guestfs.mode in
- if is_directory mode then ( (* directory *)
- let fg = if not visited then normal dir_color else darken dir_color in
- sprintf "<span weight=\"bold\" fgcolor=\"%s\">%s</span>"
- fg (markup_escape name)
- )
- else if is_symlink mode then ( (* symlink *)
- let link = direntry.Slave.dent_link in
- let fg =
- if not visited then normal symlink_color else darken symlink_color in
- sprintf "<span style=\"italic\" fgcolor=\"%s\">%s</span> %s <span style=\"italic\" fgcolor=\"%s\">%s</span>"
- fg (markup_escape name) utf8_rarrow fg (markup_escape link)
- )
- else ( (* not directory, not symlink *)
- let fg, bg =
- if is_regular_file mode then (
- if is_suid mode then suid_color, Some suid_bgcolor
- else if is_sgid mode then sgid_color, Some sgid_bgcolor
- else file_color, None
- )
- else if is_block mode then block_color, None
- else if is_char mode then char_color, None
- else if is_fifo mode then fifo_color, None
- else if is_socket mode then socket_color, None
- else other_color, None in
- let fg = if not visited then normal fg else darken fg in
- let bg =
- match bg with
- | Some bg -> sprintf " bgcolor=\"%s\"" (normal bg)
- | None -> "" in
- sprintf "<span fgcolor=\"%s\"%s>%s</span>"
- fg bg (markup_escape name)
- )
-
-and normal (r, g, b) =
- let r = if r < 0 then 0 else if r > 255 then 255 else r in
- let g = if g < 0 then 0 else if g > 255 then 255 else g in
- let b = if b < 0 then 0 else if b > 255 then 255 else b in
- sprintf "#%02x%02x%02x" r g b
-
-and darken (r, g, b) =
- normal (r * 4 / 10, g * 4 / 10, b * 4 / 10)
-
-(* This is a bit of a hack. Ideally just setting 'visited' would
- * darken the colour when the cell was re-rendered. However that would
- * mean we couldn't store other stuff in the name column. Therefore,
- * repopulate the name column.
- *)
-let set_visited ({ model = model; name_col = name_col } as t) row =
- let hdata = get_hdata t row in
- if hdata.visited = false then (
- hdata.visited <- true;
- match hdata.content with
- | Directory direntry | File direntry ->
- debug "set_visited %s" direntry.Slave.dent_name;
- model#set ~row ~column:name_col
- (markup_of_name ~visited:true direntry)
- | Loading | ErrorMessage _ | Info _ | Top _ -> ()
- )
+ | { content=ErrorMessage _ }, _ -> assert false
+ | { content=Info _ }, _ -> assert false
+ | { content=TopWinReg _ }, _ -> assert false
+ | { content=RegKey _ }, _ -> assert false
+ | { content=RegValue _ }, _ -> assert false
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-(** This is the base class for the file tree.
+(** This is the base module for the file tree.
The types and functions in this file should be considered
private to the file tree implementation.
mutable state : state_t;
content : content_t;
mutable visited : bool;
+ mutable hiveh : Hivex.t option;
}
(* The type of the hidden column used to implement on-demand loading.
| ErrorMessage of string (* error message node *)
| Info of string (* information node (eg. disk usage) *)
| Top of Slave.source (* top level OS or volume node *)
+ (* top level Windows Registry node *)
+ | TopWinReg of Slave.source * string * string * string
| Directory of Slave.direntry (* a directory *)
| File of Slave.direntry (* a file inc. special files *)
+ | RegKey of Hivex.node (* a registry key (like a dir) *)
+ | RegValue of Hivex.value (* a registry value (like a file) *)
val store_hdata : t -> Gtk.tree_iter -> hdata -> unit
val get_hdata : t -> Gtk.tree_iter -> hdata
(* Get the full path to a row by chasing up through the tree to the
top. This also returns the source (eg. operating system or single
volume). *)
-
-val markup_of_name : ?visited:bool -> Slave.direntry -> string
- (* Create markup for filenames. *)
-
-val set_visited : t -> Gtk.tree_iter -> unit
- (* Set a file as visited. *)
BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
+BuildRequires: hivex-devel >= 1.2.4-3
BuildRequires: libguestfs-devel >= 1.7.9
BuildRequires: libvirt-devel
BuildRequires: ocaml
+BuildRequires: ocaml-camomile-devel
+BuildRequires: ocaml-camomile-data
+BuildRequires: ocaml-extlib-devel
BuildRequires: ocaml-findlib-devel
+BuildRequires: ocaml-hivex-devel
+BuildRequires: ocaml-lablgtk-devel
BuildRequires: ocaml-libvirt-devel
BuildRequires: ocaml-libguestfs-devel
BuildRequires: ocaml-xml-light-devel
-BuildRequires: ocaml-extlib-devel
-BuildRequires: ocaml-lablgtk-devel
BuildRequires: /usr/bin/pod2man
BuildRequires: /usr/bin/pod2html
insp_product_name : string;
insp_type : string;
insp_windows_systemroot : string option;
+ insp_winreg_DEFAULT : string option;
+ insp_winreg_SAM : string option;
+ insp_winreg_SECURITY : string option;
+ insp_winreg_SOFTWARE : string option;
+ insp_winreg_SYSTEM : string option;
}
and source = OS of inspection_os | Volume of string
[] in
let oses = List.map (
- fun root -> {
- insp_root = root;
- insp_arch = g#inspect_get_arch root;
- insp_distro = g#inspect_get_distro root;
- insp_filesystems = g#inspect_get_filesystems root;
- insp_hostname = g#inspect_get_hostname root;
- insp_major_version = g#inspect_get_major_version root;
- insp_minor_version = g#inspect_get_minor_version root;
- insp_mountpoints = g#inspect_get_mountpoints root;
- insp_package_format = g#inspect_get_package_format root;
- insp_package_management = g#inspect_get_package_management root;
- insp_product_name = g#inspect_get_product_name root;
- insp_type = g#inspect_get_type root;
- insp_windows_systemroot =
- try Some (g#inspect_get_windows_systemroot root)
- with Guestfs.Error _ -> None
- }
+ fun root ->
+ let typ = g#inspect_get_type root in
+ let windows_systemroot =
+ if typ <> "windows" then None
+ else (
+ try Some (g#inspect_get_windows_systemroot root)
+ with Guestfs.Error _ -> None
+ ) in
+
+ (* Create most of the OS object that we're going to return. We
+ * have to pass this to with_mount_ro below which is why we need
+ * to partially create it here.
+ *)
+ let os = {
+ insp_root = root;
+ insp_arch = g#inspect_get_arch root;
+ insp_distro = g#inspect_get_distro root;
+ insp_filesystems = g#inspect_get_filesystems root;
+ insp_hostname = g#inspect_get_hostname root;
+ insp_major_version = g#inspect_get_major_version root;
+ insp_minor_version = g#inspect_get_minor_version root;
+ insp_mountpoints = g#inspect_get_mountpoints root;
+ insp_package_format = g#inspect_get_package_format root;
+ insp_package_management = g#inspect_get_package_management root;
+ insp_product_name = g#inspect_get_product_name root;
+ insp_type = typ;
+ insp_windows_systemroot = windows_systemroot;
+ insp_winreg_DEFAULT = None; (* incomplete, see below *)
+ insp_winreg_SAM = None;
+ insp_winreg_SECURITY = None;
+ insp_winreg_SOFTWARE = None;
+ insp_winreg_SYSTEM = None;
+ } in
+
+ (* We need to mount the root in order to look for Registry hives. *)
+ let winreg_DEFAULT, winreg_SAM, winreg_SECURITY, winreg_SOFTWARE,
+ winreg_SYSTEM =
+ match windows_systemroot with
+ | None -> None, None, None, None, None
+ | Some sysroot ->
+ with_mount_ro g (OS os) (
+ fun () ->
+ let check_for_hive filename =
+ let path =
+ sprintf "%s/system32/config/%s" sysroot filename in
+ try Some (g#case_sensitive_path path)
+ with Guestfs.Error _ -> None
+ in
+ check_for_hive "default",
+ check_for_hive "sam",
+ check_for_hive "security",
+ check_for_hive "software",
+ check_for_hive "system"
+ ) in
+
+ (* Fill in the remaining struct fields. *)
+ let os = { os with
+ insp_winreg_DEFAULT = winreg_DEFAULT;
+ insp_winreg_SAM = winreg_SAM;
+ insp_winreg_SECURITY = winreg_SECURITY;
+ insp_winreg_SOFTWARE = winreg_SOFTWARE;
+ insp_winreg_SYSTEM = winreg_SYSTEM
+ } in
+ os
) roots in
+
let data = {
insp_all_filesystems = fses;
insp_oses = oses;
insp_product_name : string;
insp_type : string;
insp_windows_systemroot : string option;
+ insp_winreg_DEFAULT : string option; (* registry files *)
+ insp_winreg_SAM : string option;
+ insp_winreg_SECURITY : string option;
+ insp_winreg_SOFTWARE : string option;
+ insp_winreg_SYSTEM : string option;
}
val open_domain : ?fail:exn callback -> string -> inspection_data callback -> unit
let mklabel text =
(GMisc.label ~text () :> GObj.widget)
-(* XXX No binding for g_markup_escape in lablgtk2. *)
+(* g_markup_escape is not bound by lablgtk2, but we want to provide
+ * extra protection for \0 characters appearing in the string
+ * anyway.
+ *)
let markup_escape name =
let f = function
| '&' -> "&" | '<' -> "<" | '>' -> ">"
+ | '\000' -> "\\0"
| c -> String.make 1 c
in
String.replace_chars f name
and is_xo mode = test_bit 0o001L mode
and test_bit mask mode = Int64.logand mode mask = mask
+
+let tmpdir () =
+ let chan = open_in "/dev/urandom" in
+ let data = String.create 16 in
+ really_input chan data 0 (String.length data);
+ close_in chan;
+ let data = Digest.to_hex (Digest.string data) in
+ (* Note this is secure, because if the name already exists, even as a
+ * symlink, mkdir(2) will fail.
+ *)
+ let tmpdir = Filename.temp_dir_name // sprintf "febootstrap%s.tmp" data in
+ Unix.mkdir tmpdir 0o700;
+ at_exit
+ (fun () ->
+ let cmd = sprintf "rm -rf %s" (Filename.quote tmpdir) in
+ ignore (Sys.command cmd));
+ tmpdir
+
+(* This would be so much simpler with ChriS's delimited
+ * overloading macro XXX
+ *)
+let i32_of_string_le v =
+ let b0 = int_of_char (String.unsafe_get v 0) in
+ let b1 = int_of_char (String.unsafe_get v 1) in
+ let b2 = int_of_char (String.unsafe_get v 2) in
+ let b3 = Int32.of_int (int_of_char (String.unsafe_get v 3)) in
+ Int32.logor
+ (Int32.of_int (b0 lor (b1 lsl 8) lor (b2 lsl 16)))
+ (Int32.shift_left b3 24)
+
+let i32_of_string_be v =
+ let b0 = Int32.of_int (int_of_char (String.unsafe_get v 0)) in
+ let b1 = int_of_char (String.unsafe_get v 1) in
+ let b2 = int_of_char (String.unsafe_get v 2) in
+ let b3 = int_of_char (String.unsafe_get v 3) in
+ Int32.logor
+ (Int32.of_int (b3 lor (b2 lsl 8) lor (b1 lsl 16)))
+ (Int32.shift_left b0 24)
+
+let i64_of_string_le v =
+ let b0 = int_of_char (String.unsafe_get v 0) in
+ let b1 = int_of_char (String.unsafe_get v 1) in
+ let b2 = int_of_char (String.unsafe_get v 2) in
+ let b3 = Int64.of_int (int_of_char (String.unsafe_get v 3)) in
+ let b4 = Int64.of_int (int_of_char (String.unsafe_get v 4)) in
+ let b5 = Int64.of_int (int_of_char (String.unsafe_get v 5)) in
+ let b6 = Int64.of_int (int_of_char (String.unsafe_get v 6)) in
+ let b7 = Int64.of_int (int_of_char (String.unsafe_get v 7)) in
+ Int64.logor
+ (Int64.logor
+ (Int64.logor
+ (Int64.logor
+ (Int64.logor
+ (Int64.of_int (b0 lor (b1 lsl 8) lor (b2 lsl 16)))
+ (Int64.shift_left b3 24))
+ (Int64.shift_left b4 32))
+ (Int64.shift_left b5 40))
+ (Int64.shift_left b6 48))
+ (Int64.shift_left b7 56)
returned as a generic widget. *)
val markup_escape : string -> string
- (** Call g_markup_escape. *)
+ (** Like g_markup_escape but with extra protection for strings
+ containing \0 characters. *)
val libguestfs_version_string : unit -> string
(** Return the version of libguestfs as a string. *)
val is_wo : int64 -> bool
val is_xo : int64 -> bool
(** rwx/ugo bits. *)
+
+val tmpdir : unit -> string
+ (** [tmpdir ()] returns a newly created temporary directory. The
+ tmp directory is automatically removed when the program exits.
+ Note that a fresh temporary directory is returned each time you
+ call this function. *)
+
+val i32_of_string_le : string -> int32
+ (** [i32_of_string_le str] treats the 4 character string [str] as
+ a little endian 32 bit int. NB. The string {b must} be
+ 4 characters or longer. *)
+
+val i32_of_string_be : string -> int32
+ (** [i32_of_string_le str] treats the 4 character string [str] as
+ a big endian 32 bit int. NB. The string {b must} be
+ 4 characters or longer. *)
+
+val i64_of_string_le : string -> int64
+ (** [i64_of_string_le str] treats the 8 character string [str] as
+ a little endian 64 bit int. NB. The string {b must} be
+ 8 characters or longer. *)