From: Richard W.M. Jones Date: Thu, 16 Dec 2010 10:43:19 +0000 (+0000) Subject: Version 0.1.2. X-Git-Tag: 0.1.2^0 X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=3dbb59e3a01f8fd7d494d1e6330ed3e17f674600;p=guestfs-browser.git Version 0.1.2. --- diff --git a/.depend b/.depend index 4df490d..a2f2dac 100644 --- a/.depend +++ b/.depend @@ -8,11 +8,14 @@ deviceSet.cmi: 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 diff --git a/Makefile.am b/Makefile.am index 57023f2..8a1a8d9 100644 --- a/Makefile.am +++ b/Makefile.am @@ -38,6 +38,8 @@ SOURCES = \ deviceSet.ml \ filetree.mli \ filetree.ml \ + filetree_markup.mli \ + filetree_markup.ml \ filetree_ops.mli \ filetree_ops.ml \ filetree_type.mli \ @@ -60,6 +62,7 @@ OBJECTS = \ deviceSet.cmx \ slave.cmx \ filetree_type.cmx \ + filetree_markup.cmx \ filetree_ops.cmx \ filetree.cmx \ window.cmx \ @@ -67,7 +70,8 @@ OBJECTS = \ 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 \ diff --git a/TODO b/TODO index 1e4a09c..d872f12 100644 --- a/TODO +++ b/TODO @@ -14,10 +14,10 @@ x Device checksum (slow?) ? 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. diff --git a/configure.ac b/configure.ac index 14c3bc7..d1853ab 100644 --- a/configure.ac +++ b/configure.ac @@ -15,7 +15,7 @@ dnl You should have received a copy of the GNU General Public License along 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]) @@ -58,11 +58,21 @@ if test "$OCAML_PKG_guestfs" = "no"; then 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'.]) diff --git a/filetree.ml b/filetree.ml index f252f2a..a007d97 100644 --- a/filetree.ml +++ b/filetree.ml @@ -25,12 +25,18 @@ open Utils 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;*) @@ -70,6 +76,7 @@ let rec create ~packing () = 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 @@ -140,7 +147,9 @@ and button_press ({ model = model; view = view } as t) ev = 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 @@ -234,75 +243,11 @@ and make_context_menu t paths = 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'; - - "" ^ str ^ "" - -(* 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 "%04d-%02d-%02d %02d:%02d:%02d" - (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 - "now" - else if ago < 60. *. 60. then - sprintf "%.0f minutes ago" (ago /. 60.) - else if ago < 60. *. 60. *. 24. then - sprintf "%.0f hours ago" (ago /. 60. /. 60.) - else if ago < 60. *. 60. *. 24. *. 28. then - sprintf "%.0f days ago" (ago /. 60. /. 60. /. 24.) - else - show_full_date () - -(* Mark up file sizes. *) -let markup_of_size bytes = - sprintf "%s" (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 @@ -324,51 +269,103 @@ let rec add ({ model = model; hash = hash } as t) name data = (* 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 "%s\n%s\n%s" (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 "%s\nfrom %s" (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 "%s\nfrom %s" + (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 "Loading ..."; 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. *) @@ -396,10 +393,37 @@ and expand_row ({ model = model; hash = hash } as t) row _ = 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 _) } -> @@ -418,9 +442,9 @@ and when_read_directory ({ model = model } as t) path entries = 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); @@ -455,7 +479,8 @@ and when_read_directory_fail ({ model = model } as t) path exn = 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) @@ -463,3 +488,91 @@ and when_read_directory_fail ({ model = model } as t) path exn = | 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 diff --git a/filetree.mli b/filetree.mli index 9207cf7..4bb2c30 100644 --- a/filetree.mli +++ b/filetree.mli @@ -40,6 +40,8 @@ val clear : t -> unit 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. *) diff --git a/filetree_markup.ml b/filetree_markup.ml new file mode 100644 index 0000000..206700b --- /dev/null +++ b/filetree_markup.ml @@ -0,0 +1,290 @@ +(* 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 "%s" + 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 "%s %s %s" + 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 "%s" + 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 "%s" 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 "%s=%s" + 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'; + + "" ^ str ^ "" + +(* 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 "%04d-%02d-%02d %02d:%02d:%02d" + (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 + "now" + else if ago < 60. *. 60. then + sprintf "%.0f minutes ago" (ago /. 60.) + else if ago < 60. *. 60. *. 24. then + sprintf "%.0f hours ago" (ago /. 60. /. 60.) + else if ago < 60. *. 60. *. 24. *. 28. then + sprintf "%.0f days ago" (ago /. 60. /. 60. /. 24.) + else + show_full_date () + +(* Mark up file sizes. *) +let markup_of_size bytes = + sprintf "%s" (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 _ -> () + ) diff --git a/filetree_markup.mli b/filetree_markup.mli new file mode 100644 index 0000000..de4cfb4 --- /dev/null +++ b/filetree_markup.mli @@ -0,0 +1,53 @@ +(* 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. *) diff --git a/filetree_ops.ml b/filetree_ops.ml index 93ecb62..5946a81 100644 --- a/filetree_ops.ml +++ b/filetree_ops.ml @@ -19,8 +19,8 @@ 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 @@ -160,7 +160,8 @@ let rec disk_usage ({ model = model } as t) path () = 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 "Calculating disk usage ..."; Slave.disk_usage src pathname (when_disk_usage t path pathname) @@ -200,7 +201,9 @@ let display_inspection_data ({ model = model } as t) path () = 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 = diff --git a/filetree_type.ml b/filetree_type.ml index 4b70b76..f39137e 100644 --- a/filetree_type.ml +++ b/filetree_type.ml @@ -17,7 +17,6 @@ *) open Utils -open Printf (* See struct/field description in .mli file. *) type t = { @@ -35,6 +34,7 @@ and hdata = { mutable state : state_t; content : content_t; mutable visited : bool; + mutable hiveh : Hivex.t option; } and state_t = @@ -48,8 +48,11 @@ and content_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 = @@ -88,6 +91,8 @@ let find_child_node_by_content ({ model = model } as t) row c = * \_ 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 @@ -106,92 +111,11 @@ let rec get_pathname ({ model = model } as t) row = 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 "%s" - 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 "%s %s %s" - 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 "%s" - 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 diff --git a/filetree_type.mli b/filetree_type.mli index 590b635..e1bd7da 100644 --- a/filetree_type.mli +++ b/filetree_type.mli @@ -16,7 +16,7 @@ * 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. @@ -43,6 +43,7 @@ and hdata = { 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. @@ -62,8 +63,12 @@ and content_t = | 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 @@ -79,9 +84,3 @@ val get_pathname : t -> Gtk.tree_iter -> Slave.source * string (* 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. *) diff --git a/guestfs-browser.spec.in b/guestfs-browser.spec.in index 57265bc..cb745e3 100644 --- a/guestfs-browser.spec.in +++ b/guestfs-browser.spec.in @@ -11,15 +11,19 @@ Source0: http://people.redhat.com/~rjones/guestfs-browser/files/guestfs-b 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 diff --git a/slave.ml b/slave.ml index 880a2b1..e27ced7 100644 --- a/slave.ml +++ b/slave.ml @@ -65,6 +65,11 @@ and inspection_os = { 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 @@ -515,24 +520,72 @@ and open_disk_images images cb = [] 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; diff --git a/slave.mli b/slave.mli index 2b08e04..406e9db 100644 --- a/slave.mli +++ b/slave.mli @@ -105,6 +105,11 @@ and inspection_os = { 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 diff --git a/utils.ml b/utils.ml index 02bd7a0..ca2432f 100644 --- a/utils.ml +++ b/utils.ml @@ -88,10 +88,14 @@ let unique = let i = ref 0 in fun () -> incr i; !i 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 @@ -139,3 +143,62 @@ and is_wo mode = test_bit 0o002L mode 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) diff --git a/utils.mli b/utils.mli index 1bc1669..ad14dd0 100644 --- a/utils.mli +++ b/utils.mli @@ -75,7 +75,8 @@ val mklabel : string -> GObj.widget 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. *) @@ -107,3 +108,24 @@ val is_ro : int64 -> bool 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. *)