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.2])
+AC_INIT([guestfs-browser],[0.1.3])
AM_INIT_AUTOMAKE([foreign])
AC_CONFIG_MACRO_DIR([m4])
(* Based on number of selected rows and what is selected, construct
* the context menu.
*)
- if paths <> [] then (
- let menu = make_context_menu t paths in
- menu#popup ~button ~time
+ (match make_context_menu t paths with
+ | Some menu -> menu#popup ~button ~time
+ | None -> ()
);
(* Return true so no other handler will run. *)
let menu = GMenu.menu () in
let factory = new GMenu.factory menu in
- let item = factory#add_item "Open" in
- item#misc#set_sensitive false;
-
let rec add_file_items path =
let item = factory#add_item "File information" in
item#misc#set_sensitive false;
let item = factory#add_item "Download list of filenames ..." in
ignore (item#connect#activate ~callback:(download_dir_find0 t path));
- and add_os_items path =
+ and add_top_os_items path =
let item = factory#add_item "Operating system information" in
ignore (item#connect#activate ~callback:(display_inspection_data t path));
ignore (factory#add_separator ());
- add_volume_items path
+ add_top_volume_items path
- and add_volume_items path =
+ and add_top_volume_items path =
let item = factory#add_item "Filesystem used & free" in
item#misc#set_sensitive false;
let item = factory#add_item "Block device information" in
item#misc#set_sensitive false;
ignore (factory#add_separator ());
add_directory_items path
+
+ and add_topwinreg_items path =
+ let item = factory#add_item "Download hive file ..." in
+ item#misc#set_sensitive false;
+ ignore (factory#add_separator ());
+ add_regkey_items path
+
+ and add_regkey_items path =
+ let item = factory#add_item "Download as .reg file ..." in
+ item#misc#set_sensitive false
+
+ and add_regvalue_items path =
+ let item = factory#add_item "Copy value to clipboard" in
+ ignore (item#connect#activate ~callback:(copy_regvalue t path));
+
in
- (match paths with
- (* single selection *)
- | [path, { content=Top (Slave.OS os)} ] -> (* top level operating system *)
- add_os_items path
+ let has_menu =
+ match paths with
+ | [] -> false
- | [path, { content=Top (Slave.Volume dev) }] -> (* top level volume *)
- add_volume_items path
+ (* single selection *)
+ | [path, { content=Top (Slave.OS os)} ] -> (* top level operating system *)
+ add_top_os_items path; true
- | [path, { content=Directory direntry }] -> (* directory *)
- add_directory_items path
+ | [path, { content=Top (Slave.Volume dev) }] -> (* top level volume *)
+ add_top_volume_items path; true
- | [path, { content=File direntry }] -> (* file *)
- add_file_items path
+ | [path, { content=Directory _ }] -> (* directory *)
+ add_directory_items path; true
- | [_, { content=Loading }]
- | [_, { content=ErrorMessage _ }] -> ()
+ | [path, { content=File _ }] -> (* file *)
+ add_file_items path; true
- | _ ->
- (* At the moment multiple selection is disabled. When/if we
- * enable it we should do something intelligent here. XXX
- *)
- ()
- );
+ | [path, { content=TopWinReg _ }] -> (* top level registry node *)
+ add_topwinreg_items path; true
+
+ | [path, { content=RegKey _ }] -> (* registry node *)
+ add_regkey_items path; true
+
+ | [path, { content=RegValue _ }] -> (* registry key/value pair *)
+ add_regvalue_items path; true
- menu
+ | [_, { content=(Loading|ErrorMessage _|Info _) }] -> false
+
+ | _::_::_ ->
+ (* At the moment multiple selection is disabled. When/if we
+ * enable it we should do something intelligent here. XXX
+ *)
+ false in
+ if has_menu then Some menu else None
let clear { model = model; hash = hash } =
model#clear ();
let row = model#get_iter path in
+ (* Sort the entries by lexicographic ordering. *)
+ let cmp { Slave.dent_name = n1 } { Slave.dent_name = n2 } =
+ UTF8.compare n1 n2
+ in
+ let entries = List.sort ~cmp entries in
+
(* Add the entries. *)
List.iter (
fun direntry ->
* 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
+ let cmp v1 v2 = UTF8.compare (Hivex.value_key h v1) (Hivex.value_key h v2) in
Array.sort cmp values;
Array.iter (
fun 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
+ let cmp n1 n2 = UTF8.compare (Hivex.node_name h n1) (Hivex.node_name h n2) in
Array.sort cmp children;
Array.iter (
fun node ->
(* 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 k = if k = "" then "@" else k 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 ->
- (bitmatch Bitstring.bitstring_of_string v with
- | { i : 32 : littleendian } -> sprintf "%08lx" i
- | { _ } -> markup_hex_data v)
- | Hivex.REG_DWORD_BIG_ENDIAN ->
- (bitmatch Bitstring.bitstring_of_string v with
- | { i : 32 : bigendian } -> sprintf "%08lx" i
- | { _ } -> 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 ->
- (bitmatch Bitstring.bitstring_of_string v with
- | { i : 64 : littleendian } -> sprintf "%016Lx" i
- | { _ } -> markup_hex_data v)
- | Hivex.REG_UNKNOWN i32 -> markup_hex_data v
- ) in
+ if len >= 512 then sprintf "<%d bytes not printed>" len
+ else markup_escape (printable_hivex_value ~split_long_lines:true t 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 =
- try markup_escape (windows_string_to_utf8 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
model#set ~row ~column:t.name_col data
)
+
+(* Copy registry key value to clipboard. *)
+let copy_regvalue ({ model = model } as t) path () =
+ let row = model#get_iter path in
+ let hdata = get_hdata t row in
+ match hdata with
+ | { content=RegValue value; hiveh = Some h } ->
+ let t, v = Hivex.value_value h value in
+ let v = printable_hivex_value t v in
+ let cb = GData.clipboard Gdk.Atom.clipboard in
+ cb#set_text v
+
+ | _ -> () (* not a registry value row, ignore *)
(**/**)
+val copy_regvalue : Filetree_type.t -> Gtk.tree_path -> unit -> unit
+
val disk_usage : Filetree_type.t -> Gtk.tree_path -> unit -> unit
val display_inspection_data : Filetree_type.t -> Gtk.tree_path -> unit -> unit
BuildRequires: libvirt-devel
BuildRequires: ocaml
BuildRequires: ocaml-bitstring-devel
+BuildRequires: ocaml-camlp4-devel
BuildRequires: ocaml-camomile-devel, ocaml-camomile-data
BuildRequires: ocaml-extlib-devel
BuildRequires: ocaml-findlib-devel
dom_name = D.get_name d;
dom_state = (D.get_info d).D.state }
) doms in
- let cmp { dom_name = n1 } { dom_name = n2 } = compare n1 n2 in
+ let cmp { dom_name = n1 } { dom_name = n2 } = UTF8.compare n1 n2 in
let doms = List.sort ~cmp doms in
status "Connected to %s" printable_name;
*)
open ExtString
+open ExtList
open CamomileLibrary
open Default.Camomile
String.sub str 0 (UTF8.last str)
else
str
+
+(* Best effort convert hive value to printable string. *)
+let rec printable_hivex_value ?split_long_lines t v =
+ let hex = reg_hex_of_string ?split_long_lines in
+ match t with
+ | Hivex.REG_NONE -> if v = "" then "" else hex v
+ | Hivex.REG_SZ ->
+ (try windows_string_to_utf8 v with _ -> hex v)
+ | Hivex.REG_EXPAND_SZ ->
+ (try windows_string_to_utf8 v with _ -> hex v)
+ | Hivex.REG_BINARY -> hex v
+ | Hivex.REG_DWORD ->
+ (bitmatch Bitstring.bitstring_of_string v with
+ | { i : 32 : littleendian } -> sprintf "%08lx" i
+ | { _ } -> hex v)
+ | Hivex.REG_DWORD_BIG_ENDIAN ->
+ (bitmatch Bitstring.bitstring_of_string v with
+ | { i : 32 : bigendian } -> sprintf "%08lx" i
+ | { _ } -> hex v)
+ | Hivex.REG_LINK -> hex v
+ | Hivex.REG_MULTI_SZ -> (* XXX should be better for this one *)
+ hex v
+ | Hivex.REG_RESOURCE_LIST -> hex v
+ | Hivex.REG_FULL_RESOURCE_DESCRIPTOR -> hex v
+ | Hivex.REG_RESOURCE_REQUIREMENTS_LIST -> hex v
+ | Hivex.REG_QWORD ->
+ (bitmatch Bitstring.bitstring_of_string v with
+ | { i : 64 : littleendian } -> sprintf "%016Lx" i
+ | { _ } -> hex v)
+ | Hivex.REG_UNKNOWN i32 -> hex v
+
+(* Convert binary data to a hex string. This includes line breaks. *)
+and reg_hex_of_string ?(split_long_lines=false) v =
+ let vs = String.explode v in
+ let vs = List.mapi (
+ fun i c ->
+ sprintf "%s%02x"
+ (if split_long_lines && i mod 16 = 0 then "\n" else "")
+ (int_of_char c)
+ ) vs in
+ String.concat "," vs
This may fail in multiple ways, raising a Camomile exception
which you probably need to catch. *)
+
+val printable_hivex_value : ?split_long_lines:bool -> Hivex.hive_type -> string -> string
+ (** [printable_hivex_value t v] converts raw registry value
+ [v] of type [t] to a printable string. *)
git.annexia.org / guestfs-browser.git / commitdiff