Turn Filetree into a Gtk object.
This changes the public interface of Filetree to be a Gtk object,
inheriting from GTree.view. This allows us to attach signals to this
object.
Second, we add the inspection dialog as a separate module.
The filetree and inspection dialog modules are loosely coupled by two
signals. The tree#op_inspection_dialog signal is emitted by the tree
when the inspection dialog should be opened. tree#clear_tree is
emitted by the tree when the inspection dialog should be closed (it
can also be closed by user action).
The inspection dialog is not implemented by this commit. It is just
empty for now.
The other operations are modified to work in the same way as the
inspection dialog. eg. file checksum is implemented using a separate,
loosely-coupled module called Op_checksum_file, which listens for a
tree#op_checksum_file signal and runs when that signal is emitted.
deviceSet.cmi:
deviceSet.cmo: deviceSet.cmi
deviceSet.cmx: deviceSet.cmi
-filetree.cmi: slave_types.cmi
-filetree.cmo: utils.cmi slave_types.cmi slave.cmi filetree_type.cmi filetree_ops.cmi filetree_markup.cmi deviceSet.cmi config.cmi filetree.cmi
-filetree.cmx: utils.cmx slave_types.cmx slave.cmx filetree_type.cmx filetree_ops.cmx filetree_markup.cmx deviceSet.cmx config.cmx filetree.cmi
-filetree_markup.cmi: slave_types.cmi filetree_type.cmi
-filetree_markup.cmo: utils.cmi slave_types.cmi filetree_type.cmi filetree_markup.cmi
-filetree_markup.cmx: utils.cmx slave_types.cmx filetree_type.cmx filetree_markup.cmi
-filetree_ops.cmi: slave_types.cmi filetree_type.cmi
-filetree_ops.cmo: utils.cmi slave_types.cmi slave.cmi filetree_type.cmi filetree_markup.cmi filetree_ops.cmi
-filetree_ops.cmx: utils.cmx slave_types.cmx slave.cmx filetree_type.cmx filetree_markup.cmx filetree_ops.cmi
-filetree_type.cmi: slave_types.cmi slave.cmi
-filetree_type.cmo: utils.cmi slave_types.cmi slave.cmi filetree_type.cmi
-filetree_type.cmx: utils.cmx slave_types.cmx slave.cmx filetree_type.cmi
+filetree.cmi: slave_types.cmi slave.cmi
+filetree.cmo: utils.cmi slave_types.cmi slave.cmi filetree_markup.cmi deviceSet.cmi config.cmi filetree.cmi
+filetree.cmx: utils.cmx slave_types.cmx slave.cmx filetree_markup.cmx deviceSet.cmx config.cmx filetree.cmi
+filetree_markup.cmi: slave_types.cmi
+filetree_markup.cmo: utils.cmi slave_types.cmi filetree_markup.cmi
+filetree_markup.cmx: utils.cmx slave_types.cmx filetree_markup.cmi
main.cmo: window.cmi utils.cmi slave.cmi config.cmi cmdline.cmi
main.cmx: window.cmx utils.cmx slave.cmx config.cmx cmdline.cmx
+op_checksum_file.cmi: filetree.cmi
+op_checksum_file.cmo: utils.cmi slave.cmi op_checksum_file.cmi
+op_checksum_file.cmx: utils.cmx slave.cmx op_checksum_file.cmi
+op_copy_regvalue.cmi: filetree.cmi
+op_copy_regvalue.cmo: utils.cmi op_copy_regvalue.cmi
+op_copy_regvalue.cmx: utils.cmx op_copy_regvalue.cmi
+op_disk_usage.cmi: filetree.cmi
+op_disk_usage.cmo: utils.cmi slave.cmi op_disk_usage.cmi
+op_disk_usage.cmx: utils.cmx slave.cmx op_disk_usage.cmi
+op_download_as_reg.cmi: filetree.cmi
+op_download_as_reg.cmo: utils.cmi slave.cmi filetree.cmi op_download_as_reg.cmi
+op_download_as_reg.cmx: utils.cmx slave.cmx filetree.cmx op_download_as_reg.cmi
+op_download_dir_find0.cmi: filetree.cmi
+op_download_dir_find0.cmo: utils.cmi slave.cmi op_download_dir_find0.cmi
+op_download_dir_find0.cmx: utils.cmx slave.cmx op_download_dir_find0.cmi
+op_download_dir_tarball.cmi: slave_types.cmi filetree.cmi
+op_download_dir_tarball.cmo: utils.cmi slave_types.cmi slave.cmi op_download_dir_tarball.cmi
+op_download_dir_tarball.cmx: utils.cmx slave_types.cmx slave.cmx op_download_dir_tarball.cmi
+op_download_file.cmi: filetree.cmi
+op_download_file.cmo: utils.cmi slave.cmi op_download_file.cmi
+op_download_file.cmx: utils.cmx slave.cmx op_download_file.cmi
+op_file_information.cmi: filetree.cmi
+op_file_information.cmo: utils.cmi slave.cmi op_file_information.cmi
+op_file_information.cmx: utils.cmx slave.cmx op_file_information.cmi
+op_inspection_dialog.cmi: slave_types.cmi filetree.cmi
+op_inspection_dialog.cmo: utils.cmi filetree.cmi op_inspection_dialog.cmi
+op_inspection_dialog.cmx: utils.cmx filetree.cmx op_inspection_dialog.cmi
+op_view_file.cmi: filetree.cmi
+op_view_file.cmo: utils.cmi slave.cmi op_view_file.cmi
+op_view_file.cmx: utils.cmx slave.cmx op_view_file.cmi
slave.cmi: slave_types.cmi
slave.cmo: utils.cmi slave_utils.cmi slave_types.cmi slave.cmi
slave.cmx: utils.cmx slave_utils.cmx slave_types.cmx slave.cmi
utils.cmo: config.cmi utils.cmi
utils.cmx: config.cmx utils.cmi
window.cmi: cmdline.cmi
-window.cmo: utils.cmi throbber.cmo slave_types.cmi slave.cmi filetree.cmi cmdline.cmi window.cmi
-window.cmx: utils.cmx throbber.cmx slave_types.cmx slave.cmx filetree.cmx cmdline.cmx window.cmi
+window.cmo: utils.cmi throbber.cmo slave_types.cmi slave.cmi op_view_file.cmi op_inspection_dialog.cmi op_file_information.cmi op_download_file.cmi op_download_dir_tarball.cmi op_download_dir_find0.cmi op_download_as_reg.cmi op_disk_usage.cmi op_copy_regvalue.cmi op_checksum_file.cmi filetree.cmi cmdline.cmi window.cmi
+window.cmx: utils.cmx throbber.cmx slave_types.cmx slave.cmx op_view_file.cmx op_inspection_dialog.cmx op_file_information.cmx op_download_file.cmx op_download_dir_tarball.cmx op_download_dir_find0.cmx op_download_as_reg.cmx op_disk_usage.cmx op_copy_regvalue.cmx op_checksum_file.cmx filetree.cmx cmdline.cmx window.cmi
filetree.ml \
filetree_markup.mli \
filetree_markup.ml \
- filetree_ops.mli \
- filetree_ops.ml \
- filetree_type.mli \
- filetree_type.ml \
main.ml \
+ op_checksum_file.mli \
+ op_checksum_file.ml \
+ op_copy_regvalue.mli \
+ op_copy_regvalue.ml \
+ op_disk_usage.mli \
+ op_disk_usage.ml \
+ op_download_as_reg.mli \
+ op_download_as_reg.ml \
+ op_download_dir_find0.mli \
+ op_download_dir_find0.ml \
+ op_download_dir_tarball.mli \
+ op_download_dir_tarball.ml \
+ op_download_file.mli \
+ op_download_file.ml \
+ op_file_information.mli \
+ op_file_information.ml \
+ op_inspection_dialog.mli \
+ op_inspection_dialog.ml \
+ op_view_file.mli \
+ op_view_file.ml \
slave.mli \
slave.ml \
slave_types.mli \
slave_types.cmo \
slave_utils.cmo \
slave.cmo \
- filetree_type.cmo \
filetree_markup.cmo \
- filetree_ops.cmo \
filetree.cmo \
+ op_checksum_file.cmo \
+ op_copy_regvalue.cmo \
+ op_disk_usage.cmo \
+ op_download_as_reg.cmo \
+ op_download_dir_find0.cmo \
+ op_download_dir_tarball.cmo \
+ op_download_file.cmo \
+ op_file_information.cmo \
+ op_inspection_dialog.cmo \
+ op_view_file.cmo \
window.cmo \
main.cmo
-Current use of callbacks in the main window is extremely clunky and
-causes all sorts of complex dependency problems in the OCaml code. We
-should use Gtk signals instead.
-
Context menu:
. Open file (view / open dir)
open DeviceSet
open Slave_types
-open Filetree_type
open Filetree_markup
-open Filetree_ops
module G = Guestfs
module UTF8 = CamomileLibraryDefault.Camomile.UTF8
-type t = Filetree_type.t
-
(* Temporary directory for shared use by any function in this file.
* It is cleaned up when the program exits.
*)
let tmpdir = tmpdir ()
-let rec create ~packing () =
- let view = GTree.view ~packing () in
+(* The internal data we store attached to each row, telling us about
+ * the state of the row and what is in it.
+ *)
+type 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.
+ * All rows are classified as either nodes or leafs (eg. a "node" might
+ * be a directory, or a top-level operating system, or anything else
+ * which the user could open and look inside).
+ *)
+and state_t =
+ | IsLeaf (* there are no children *)
+ | NodeNotStarted (* user has not tried to open this *)
+ | NodeLoading (* user tried to open it, still loading *)
+ | IsNode (* we've loaded the children of this directory *)
+
+(* The actual content of a row. *)
+and content_t =
+ | Loading (* special "loading ..." node *)
+ | ErrorMessage of string (* error message node *)
+ | Info of string (* information node (eg. disk usage) *)
+ | Top of Slave_types.source (* top level OS or volume node *)
+ | TopWinReg of registry_t (* top level Windows Registry node *)
+ | Directory of Slave_types.direntry(* a directory *)
+ | File of Slave_types.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) *)
+
+(* Source, root key, remote filename, cache filename *)
+and registry_t = Slave_types.source * string * string * string
+
+let source_of_registry_t (src, _, _, _) = src
+let root_key_of_registry_t (_, root_key, _, _) = root_key
+
+(* This is the Filetree.tree class, derived from GTree.view
+ * (ie. GtkTreeView).
+ *)
+class tree ?packing () =
+ let clear_tree = new GUtil.signal () in
+ let op_checksum_file = new GUtil.signal () in
+ let op_copy_regvalue = new GUtil.signal () in
+ let op_disk_usage = new GUtil.signal () in
+ let op_download_as_reg = new GUtil.signal () in
+ let op_download_dir_find0 = new GUtil.signal () in
+ let op_download_dir_tarball = new GUtil.signal () in
+ let op_download_file = new GUtil.signal () in
+ let op_file_information = new GUtil.signal () in
+ let op_inspection_dialog = new GUtil.signal () in
+ let op_view_file = new GUtil.signal () in
+
+ let view = GTree.view ?packing () in
(*view#set_rules_hint true;*)
(*view#selection#set_mode `MULTIPLE; -- add this later *)
(* Create the model. *)
let model = GTree.tree_store cols in
- (* Create the view. *)
- view#set_model (Some (model :> GTree.model));
-
- let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
- let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
- mode_view#set_resizable true;
- ignore (view#append_column mode_view);
-
- 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 size_view = GTree.view_column ~title:"Size" ~renderer () in
- size_view#set_resizable true;
- ignore (view#append_column size_view);
-
- let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", date_col] in
- let date_view = GTree.view_column ~title:"Date" ~renderer () in
- date_view#set_resizable true;
- ignore (view#append_column date_view);
-
- let t = {
- view = view; model = model; hash = hash;
- index_col = index_col;
- mode_col = mode_col; name_col = name_col; size_col = size_col;
- date_col = date_col;
- } in
-
- (* Open a context menu when a button is pressed. *)
- ignore (view#event#connect#button_press ~callback:(button_press t));
-
- t
-
-(* Handle mouse button press on the selected row. This opens the
- * pop-up context menu.
- * http://scentric.net/tutorial/sec-selections-context-menus.html
- *)
-and button_press ({ model = model; view = view } as t) ev =
- let button = GdkEvent.Button.button ev in
- let x = int_of_float (GdkEvent.Button.x ev) in
- let y = int_of_float (GdkEvent.Button.y ev) in
- let time = GdkEvent.Button.time ev in
-
- (* Right button for opening the context menu. *)
- if button = 3 then (
-(*
- (* If no row is selected, select the row under the mouse. *)
- let paths =
- let sel = view#selection in
- if sel#count_selected_rows < 1 then (
- match view#get_path_at_pos ~x ~y with
- | None -> []
- | Some (path, _, _, _) ->
- sel#unselect_all ();
- sel#select_path path;
- [path]
- ) else
- sel#get_selected_rows (* actually returns paths *) in
-*)
- (* Select the row under the mouse. *)
- let paths =
- let sel = view#selection in
- match view#get_path_at_pos ~x ~y with
- | None -> []
- | Some (path, _, _, _) ->
- sel#unselect_all ();
- sel#select_path path;
- [path] in
-
- (* Get the hdata for all the paths. Filter out rows that it doesn't
- * make sense to select.
+object (self)
+ inherit GTree.view view#as_tree_view
+ inherit GUtil.ml_signals [clear_tree#disconnect;
+ op_checksum_file#disconnect;
+ op_copy_regvalue#disconnect;
+ op_disk_usage#disconnect;
+ op_download_as_reg#disconnect;
+ op_download_dir_find0#disconnect;
+ op_download_dir_tarball#disconnect;
+ op_download_file#disconnect;
+ op_file_information#disconnect;
+ op_inspection_dialog#disconnect;
+ op_view_file#disconnect]
+
+ initializer
+ (* Open a context menu when a button is pressed. *)
+ ignore (view#event#connect#button_press ~callback:self#button_press);
+
+ (* Create the view. *)
+ view#set_model (Some (model :> GTree.model));
+
+ (* Cell renderers. *)
+ let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
+ let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
+ mode_view#set_resizable true;
+ ignore (view#append_column mode_view);
+
+ 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 size_view = GTree.view_column ~title:"Size" ~renderer () in
+ size_view#set_resizable true;
+ ignore (view#append_column size_view);
+
+ let renderer =
+ GTree.cell_renderer_text [`XALIGN 1.], ["markup", date_col] in
+ let date_view = GTree.view_column ~title:"Date" ~renderer () in
+ date_view#set_resizable true;
+ ignore (view#append_column date_view)
+
+ method clear () : unit =
+ model#clear ();
+ Hashtbl.clear hash;
+ clear_tree#call ()
+
+ method add_os name data : unit =
+ self#clear ();
+
+ (* Populate the top level of the filetree. If there are operating
+ * systems from inspection, these have their own top level entries
+ * followed by only unreferenced filesystems. If we didn't get
+ * anything from inspection, then at the top level we just show
+ * filesystems.
*)
- let paths =
- List.filter_map (
- fun path ->
- let row = model#get_iter path in
- let hdata = get_hdata t row in
- match hdata with
- | { content=(Loading | ErrorMessage _ | Info _) } -> None
- | { content=(Top _ | Directory _ | File _ |
- TopWinReg _ | RegKey _ | RegValue _ ) } ->
- Some (path, hdata)
- ) paths in
-
- (* Based on number of selected rows and what is selected, construct
- * the context menu.
- *)
- (match make_context_menu t paths with
- | Some menu -> menu#popup ~button ~time
- | None -> ()
- );
+ let other_filesystems =
+ DeviceSet.of_list (List.map fst data.insp_all_filesystems) in
+ let other_filesystems =
+ List.fold_left (fun set { insp_filesystems = fses } ->
+ DeviceSet.subtract set (DeviceSet.of_array fses))
+ other_filesystems data.insp_oses in
- (* Return true so no other handler will run. *)
- true
- )
- (* We didn't handle this, defer to other handlers. *)
- else false
-
-and make_context_menu t paths =
- let menu = GMenu.menu () in
- let factory = new GMenu.factory menu in
-
- let rec add_file_items path =
- let item = factory#add_item "View ..." in
- (match Config.opener with
- | Some opener ->
- ignore (item#connect#activate ~callback:(view_file t path opener));
- | None ->
- item#misc#set_sensitive false
- );
- let item = factory#add_item "File information" in
- ignore (item#connect#activate ~callback:(file_information t path));
- let item = factory#add_item "MD5 checksum" in
- ignore (item#connect#activate ~callback:(checksum_file t path "md5"));
- let item = factory#add_item "SHA1 checksum" in
- ignore (item#connect#activate ~callback:(checksum_file t path "sha1"));
- ignore (factory#add_separator ());
- let item = factory#add_item "Download ..." in
- ignore (item#connect#activate ~callback:(download_file t path));
-
- and add_directory_items path =
- let item = factory#add_item "Directory information" in
- item#misc#set_sensitive false;
- let item = factory#add_item "Calculate disk usage" in
- ignore (item#connect#activate ~callback:(disk_usage t path));
- ignore (factory#add_separator ());
- let item = factory#add_item "Download ..." in
- item#misc#set_sensitive false;
- let item = factory#add_item "Download as .tar ..." in
- ignore (item#connect#activate
- ~callback:(download_dir_tarball t Tar path));
- let item = factory#add_item "Download as .tar.gz ..." in
- ignore (item#connect#activate
- ~callback:(download_dir_tarball t TGZ path));
- let item = factory#add_item "Download as .tar.xz ..." in
- ignore (item#connect#activate
- ~callback:(download_dir_tarball t TXZ path));
- let item = factory#add_item "Download list of filenames ..." in
- ignore (item#connect#activate ~callback:(download_dir_find0 t 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_top_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
- (match Config.hivexregedit with
- | Some hivexregedit ->
- ignore (item#connect#activate
- ~callback:(download_as_reg t path hivexregedit));
- | None ->
- item#misc#set_sensitive false
- )
+ (* Add top level operating systems. *)
+ List.iter (self#add_top_level_os name) data.insp_oses;
+
+ (* Add top level left-over filesystems. *)
+ DeviceSet.iter (self#add_top_level_vol name) other_filesystems;
- and add_regvalue_items path =
- let item = factory#add_item "Copy value to clipboard" in
- ignore (item#connect#activate ~callback:(copy_regvalue t path));
+ (* If it's Windows and registry files exist, create a node for
+ * each file.
+ *)
+ List.iter (
+ fun os ->
+ (match os.insp_winreg_SAM with
+ | Some filename ->
+ self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SAM"
+ filename
+ | None -> ()
+ );
+ (match os.insp_winreg_SECURITY with
+ | Some filename ->
+ self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SECURITY"
+ filename
+ | None -> ()
+ );
+ (match os.insp_winreg_SOFTWARE with
+ | Some filename ->
+ self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
+ filename
+ | None -> ()
+ );
+ (match os.insp_winreg_SYSTEM with
+ | Some filename ->
+ self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SYSTEM"
+ filename
+ | None -> ()
+ );
+ (match os.insp_winreg_DEFAULT with
+ | Some filename ->
+ self#add_top_level_winreg name os "HKEY_USERS\\.DEFAULT" filename
+ | None -> ()
+ );
+ ) data.insp_oses;
+
+ (* Expand the first top level node. *)
+ match model#get_iter_first with
+ | None -> ()
+ | Some row ->
+ self#expand_row (model#get_path row)
+
+ (* Add a top level operating system node. *)
+ method private add_top_level_os name os =
+ let markup =
+ sprintf "<b>%s</b>\n<small>%s</small>\n<small>%s</small>"
+ (markup_escape name) (markup_escape os.insp_hostname)
+ (markup_escape os.insp_product_name) in
+
+ let row = model#append () in
+ self#make_node row (Top (OS os)) None;
+ model#set ~row ~column:name_col markup
+
+ (* Add a top level volume (left over filesystem) node. *)
+ method private add_top_level_vol 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
+ self#make_node row (Top (Volume dev)) None;
+ model#set ~row ~column:name_col markup
+
+ (* Add a top level Windows Registry node. *)
+ method private add_top_level_winreg 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
+ self#make_node row
+ (TopWinReg (OS os, rootkey, remotefile, cachefile)) None;
+ model#set ~row ~column:name_col markup
+
+ (* Generic function to make an openable node to the tree. *)
+ method private make_node row content hiveh =
+ let hdata =
+ { state=NodeNotStarted; content=content; visited=false; hiveh=hiveh } in
+ self#store_hdata 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; hiveh=None } in
+ self#store_hdata placeholder hdata;
+ model#set ~row:placeholder ~column:name_col "<i>Loading ...</i>";
+ ignore (self#connect#row_expanded ~callback:self#user_expand_row)
- in
+ method private make_leaf row content hiveh =
+ let hdata = { state=IsLeaf; content=content; visited=false; hiveh=hiveh } in
+ self#store_hdata row hdata
- let has_menu =
- match paths with
- | [] -> false
+ (* This is called when the user expands a row. *)
+ method private user_expand_row row _ =
+ match self#get_hdata row with
+ | { state=NodeNotStarted; content=Top src } as hdata ->
+ (* User has opened a top level node that was not previously opened. *)
- (* single selection *)
- | [path, { content=Top (OS os)} ] -> (* top level operating system *)
- add_top_os_items path; true
+ (* Mark this row as loading, so we don't try to open it again. *)
+ hdata.state <- NodeLoading;
- | [path, { content=Top (Volume dev) }] -> (* top level volume *)
- add_top_volume_items path; true
+ (* Get a stable path for this row. *)
+ let path = model#get_path row in
- | [path, { content=Directory _ }] -> (* directory *)
- add_directory_items path; true
+ Slave.read_directory ~fail:(self#when_read_directory_fail path)
+ src "/" (self#when_read_directory path)
- | [path, { content=File _ }] -> (* file *)
- add_file_items path; true
+ | { state=NodeNotStarted; content=Directory direntry } as hdata ->
+ (* User has opened a filesystem directory not previously opened. *)
- | [path, { content=TopWinReg _ }] -> (* top level registry node *)
- add_topwinreg_items path; true
+ (* Mark this row as loading. *)
+ hdata.state <- NodeLoading;
- | [path, { content=RegKey _ }] -> (* registry node *)
- add_regkey_items path; true
+ (* Get a stable path for this row. *)
+ let path = model#get_path row in
- | [path, { content=RegValue _ }] -> (* registry key/value pair *)
- add_regvalue_items path; true
+ let src, pathname = self#get_pathname row in
- | [_, { content=(Loading|ErrorMessage _|Info _) }] -> false
+ Slave.read_directory ~fail:(self#when_read_directory_fail path)
+ src pathname (self#when_read_directory path)
- | _::_::_ ->
- (* At the moment multiple selection is disabled. When/if we
- * enable it we should do something intelligent here. XXX
+ | { state=NodeNotStarted;
+ content=TopWinReg topdata } as hdata ->
+ (* User has opened a Windows Registry top level node
+ * not previously opened.
*)
- false in
- if has_menu then Some menu else None
-let clear { model = model; hash = hash } =
- model#clear ();
- Hashtbl.clear hash
+ (* Mark this row as loading. *)
+ hdata.state <- NodeLoading;
-let rec add ({ model = model } as t) name data =
- clear t;
+ (* Get a stable path for this row. *)
+ let path = model#get_path row in
- (* Populate the top level of the filetree. If there are operating
- * systems from inspection, these have their own top level entries
- * followed by only unreferenced filesystems. If we didn't get
- * anything from inspection, then at the top level we just show
- * filesystems.
- *)
- let other_filesystems =
- DeviceSet.of_list (List.map fst data.insp_all_filesystems) in
- let other_filesystems =
- List.fold_left (fun set { insp_filesystems = fses } ->
- DeviceSet.subtract set (DeviceSet.of_array fses))
- other_filesystems data.insp_oses in
+ (* Since the user has opened this top level registry node for the
+ * first time, we now need to download the hive.
+ *)
+ self#get_registry_file ~fail:(self#when_downloaded_registry_fail path)
+ path topdata (self#when_downloaded_registry path)
- (* Add top level operating systems. *)
- List.iter (add_top_level_os t name) data.insp_oses;
+ | { state=NodeNotStarted; content=RegKey node } as hdata ->
+ (* User has opened a Windows Registry key node not previously opened. *)
- (* Add top level left-over filesystems. *)
- DeviceSet.iter (add_top_level_vol t name) other_filesystems;
+ (* Mark this row as loading. *)
+ hdata.state <- NodeLoading;
- (* If it's Windows and registry files exist, create a node for
- * each file.
- *)
- List.iter (
- fun os ->
- (match os.insp_winreg_SAM with
- | Some filename ->
- add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SAM" filename
- | None -> ()
- );
- (match os.insp_winreg_SECURITY with
- | Some filename ->
- add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SECURITY"
- filename
- | None -> ()
- );
- (match os.insp_winreg_SOFTWARE with
- | Some filename ->
- add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
- filename
- | None -> ()
- );
- (match os.insp_winreg_SYSTEM with
- | Some filename ->
- add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SYSTEM"
- filename
- | None -> ()
- );
- (match os.insp_winreg_DEFAULT with
- | Some filename ->
- add_top_level_winreg t name os "HKEY_USERS\\.DEFAULT" filename
- | None -> ()
- );
- ) data.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)
-
-(* 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.insp_hostname)
- (markup_escape os.insp_product_name) in
-
- let row = model#append () in
- make_node t row (Top (OS os)) None;
- model#set ~row ~column:t.name_col markup
-
-(* 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 (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 (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 } 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; 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))
+ self#expand_hive_node row node
-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
+ (* Ignore when a user opens a node which is loading or has been loaded. *)
+ | { state=(NodeLoading|IsNode) } -> ()
-(* This is called when the user expands a 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. *)
+ (* In some circumstances these can be nodes, eg. if we have added Info
+ * nodes below them. Just ignore them if opened.
+ *)
+ | { content=(File _ | RegValue _) } | { state=IsLeaf } -> ()
+
+ (* Node should not exist in the tree. *)
+ | { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
+ assert false
+
+ (* This is the callback when the slave has read the directory for us. *)
+ method private when_read_directory path entries =
+ debug "when_read_directory";
+
+ let row = model#get_iter path in
+
+ (* Sort the entries by lexicographic ordering. *)
+ let cmp { dent_name = n1 } { dent_name = n2 } =
+ UTF8.compare n1 n2
+ in
+ let entries = List.sort ~cmp entries in
+
+ (* Add the entries. *)
+ List.iter (
+ fun direntry ->
+ let { dent_name = name; dent_stat = stat; dent_link = link } =
+ direntry in
+ let row = model#append ~parent:row () in
+ if is_directory stat.G.mode then
+ self#make_node row (Directory direntry) None
+ else
+ self#make_leaf row (File direntry) None;
+ model#set ~row ~column:name_col (markup_of_name direntry);
+ model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
+ model#set ~row ~column:size_col (markup_of_size stat.G.size);
+ model#set ~row ~column:date_col (markup_of_date stat.G.mtime);
+ ) entries;
+
+ (* Remove the placeholder "Loading" entry. NB. Must be done AFTER
+ * adding the other entries, or else Gtk will unexpand the row.
+ *)
+ (try
+ let row = self#find_child_node_by_content row Loading in
+ ignore (model#remove row)
+ with Invalid_argument _ | Not_found -> ()
+ );
- (* Mark this row as loading, so we don't try to open it again. *)
- hdata.state <- NodeLoading;
+ (* The original directory entry has now been loaded, so
+ * update its state.
+ *)
+ let hdata = self#get_hdata row in
+ hdata.state <- IsNode;
+ self#set_visited row
- (* Get a stable path for this row. *)
- let path = model#get_path row in
+ (* This is called instead of when_read_directory when the read directory
+ * (or mount etc) failed. Convert the "Loading" entry into the
+ * error message.
+ *)
+ method private when_read_directory_fail path exn =
+ debug "when_read_directory_fail: %s" (Printexc.to_string exn);
- Slave.read_directory ~fail:(when_read_directory_fail t path)
- src "/" (when_read_directory t path)
+ match exn with
+ | G.Error msg ->
+ let row = model#get_iter path in
+ let row = model#iter_children ~nth:0 (Some row) in
- | { state=NodeNotStarted; content=Directory direntry } as hdata ->
- (* User has opened a filesystem directory not previously opened. *)
+ let hdata =
+ { state=IsLeaf; content=ErrorMessage msg;
+ visited=false; hiveh=None } in
+ self#store_hdata row hdata;
- (* Mark this row as loading. *)
- hdata.state <- NodeLoading;
+ model#set ~row ~column:name_col (markup_escape msg)
- (* Get a stable path for this row. *)
- let path = model#get_path row in
+ | exn ->
+ (* unexpected exception: re-raise it *)
+ raise exn
- let src, pathname = get_pathname t row in
+ (* Called when the top level registry node has been opened and the
+ * hive file was downloaded to the cache file successfully.
+ *)
+ method private when_downloaded_registry path _ =
+ debug "when_downloaded_registry";
+ let row = model#get_iter path in
+ let hdata = self#get_hdata row in
+ let h = Option.get hdata.hiveh in
+
+ (* Continue as if expanding any other hive node. *)
+ let root = Hivex.root h in
+ self#expand_hive_node row root
+
+ (* Called instead of {!when_downloaded_registry} if the download failed. *)
+ method private when_downloaded_registry_fail 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
+ self#store_hdata row hdata;
+
+ model#set ~row ~column:name_col (markup_escape msg)
+
+ | exn ->
+ (* unexpected exception: re-raise it *)
+ raise exn
+
+ (* Expand a hive node. *)
+ method private expand_hive_node row node =
+ debug "expand_hive_node";
+ let hdata = self#get_hdata 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 =
+ UTF8.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
+ self#make_leaf row (RegValue value) (Some h);
+ model#set ~row ~column:name_col (markup_of_regvalue h value);
+ model#set ~row ~column:size_col (markup_of_regvaluesize h value);
+ model#set ~row ~column:date_col (markup_of_regvaluetype h value);
+ ) values;
+
+ let children = Hivex.node_children h node 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 ->
+ let row = model#append ~parent:row () in
+ self#make_node row (RegKey node) (Some h);
+ model#set ~row ~column: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 = self#find_child_node_by_content row Loading in
+ ignore (model#remove row)
+ with Invalid_argument _ | Not_found -> ()
+ );
- Slave.read_directory ~fail:(when_read_directory_fail t path)
- src pathname (when_read_directory t path)
+ (* The original entry has now been loaded, so update its state. *)
+ hdata.state <- IsNode;
+ self#set_visited row
+
+ (* Signals. *)
+ method clear_tree : callback:(unit -> unit) -> GtkSignal.id =
+ clear_tree#connect ~after
+ method op_checksum_file = op_checksum_file#connect ~after
+ method op_copy_regvalue = op_copy_regvalue#connect ~after
+ method op_disk_usage = op_disk_usage#connect ~after
+ method op_download_as_reg = op_download_as_reg#connect ~after
+ method op_download_dir_find0 = op_download_dir_find0#connect ~after
+ method op_download_dir_tarball = op_download_dir_tarball#connect ~after
+ method op_download_file = op_download_file#connect ~after
+ method op_file_information = op_file_information#connect ~after
+ method op_inspection_dialog = op_inspection_dialog#connect ~after
+ method op_view_file = op_view_file#connect ~after
+
+ (* Handle mouse button press on the selected row. This opens the
+ * pop-up context menu.
+ * http://scentric.net/tutorial/sec-selections-context-menus.html
+ *)
+ method private button_press ev =
+ let button = GdkEvent.Button.button ev in
+ let x = int_of_float (GdkEvent.Button.x ev) in
+ let y = int_of_float (GdkEvent.Button.y ev) in
+ let time = GdkEvent.Button.time ev in
+
+ (* Right button for opening the context menu. *)
+ if button = 3 then (
+(*
+ (* If no row is selected, select the row under the mouse. *)
+ let paths =
+ let sel = view#selection in
+ if sel#count_selected_rows < 1 then (
+ match view#get_path_at_pos ~x ~y with
+ | None -> []
+ | Some (path, _, _, _) ->
+ sel#unselect_all ();
+ sel#select_path path;
+ [path]
+ ) else
+ sel#get_selected_rows (* actually returns paths *) in
+*)
+ (* Select the row under the mouse. *)
+ let paths =
+ let sel = view#selection in
+ match view#get_path_at_pos ~x ~y with
+ | None -> []
+ | Some (path, _, _, _) ->
+ sel#unselect_all ();
+ sel#select_path path;
+ [path] in
- | { state=NodeNotStarted;
- content=TopWinReg (src, rootkey, remotefile, cachefile) } as hdata ->
- (* User has opened a Windows Registry top level node
- * not previously opened.
+ (* Get the hdata for all the paths. Filter out rows that it doesn't
+ * make sense to select.
*)
-
- (* 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.
+ let paths =
+ List.filter_map (
+ fun path ->
+ let row = model#get_iter path in
+ let hdata = self#get_hdata row in
+ match hdata with
+ | { content=(Loading | ErrorMessage _ | Info _) } -> None
+ | { content=(Top _ | Directory _ | File _ |
+ TopWinReg _ | RegKey _ | RegValue _ ) } ->
+ Some (path, hdata)
+ ) paths in
+
+ (* Based on number of selected rows and what is selected, construct
+ * the context menu.
*)
- cache_registry_file ~fail:(when_downloaded_registry_fail t path)
- 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) } -> ()
+ (match self#make_context_menu paths with
+ | Some menu -> menu#popup ~button ~time
+ | None -> ()
+ );
- (* In some circumstances these can be nodes, eg. if we have added Info
- * nodes below them. Just ignore them if opened.
- *)
- | { content=(File _ | RegValue _) } | { state=IsLeaf } -> ()
-
- (* Node should not exist in the tree. *)
- | { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
- assert false
-
-(* This is the callback when the slave has read the directory for us. *)
-and when_read_directory ({ model = model } as t) path entries =
- debug "when_read_directory";
-
- let row = model#get_iter path in
-
- (* Sort the entries by lexicographic ordering. *)
- let cmp { dent_name = n1 } { dent_name = n2 } =
- UTF8.compare n1 n2
- in
- let entries = List.sort ~cmp entries in
-
- (* Add the entries. *)
- List.iter (
- fun direntry ->
- let { dent_name = name; dent_stat = stat; dent_link = link } =
- direntry in
- let row = model#append ~parent:row () in
- if is_directory stat.G.mode then
- make_node t row (Directory direntry) None
+ (* Return true so no other handler will run. *)
+ true
+ )
+ (* We didn't handle this, defer to other handlers. *)
+ else false
+
+ method private make_context_menu paths =
+ let menu = GMenu.menu () in
+ let factory = new GMenu.factory menu in
+
+ let rec add_file_items path =
+ let item = factory#add_item "View ..." in
+ (match Config.opener with
+ | Some opener ->
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_view_file#call (path, opener)));
+ | None ->
+ item#misc#set_sensitive false
+ );
+ let item = factory#add_item "File information" in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_file_information#call path));
+ let item = factory#add_item "MD5 checksum" in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_checksum_file#call (path, "md5")));
+ let item = factory#add_item "SHA1 checksum" in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_checksum_file#call (path, "sha1")));
+ ignore (factory#add_separator ());
+ let item = factory#add_item "Download ..." in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_download_file#call path));
+
+ and add_directory_items path =
+ let item = factory#add_item "Directory information" in
+ item#misc#set_sensitive false;
+ let item = factory#add_item "Calculate disk usage" in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_disk_usage#call path));
+ ignore (factory#add_separator ());
+ let item = factory#add_item "Download ..." in
+ item#misc#set_sensitive false;
+ let item = factory#add_item "Download as .tar ..." in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_download_dir_tarball#call (Tar, path)));
+ let item = factory#add_item "Download as .tar.gz ..." in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_download_dir_tarball#call (TGZ, path)));
+ let item = factory#add_item "Download as .tar.xz ..." in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_download_dir_tarball#call (TXZ, path)));
+ let item = factory#add_item "Download list of filenames ..." in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_download_dir_find0#call path));
+
+ and add_top_os_items os path =
+ let item = factory#add_item "Operating system information" in
+ ignore (item#connect#activate
+ ~callback:(fun () -> op_inspection_dialog#call os));
+ ignore (factory#add_separator ());
+ add_top_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
+ (match Config.hivexregedit with
+ | Some hivexregedit ->
+ ignore (item#connect#activate
+ ~callback:(fun () ->
+ op_download_as_reg#call (path, hivexregedit)));
+ | None ->
+ 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:(fun () -> op_copy_regvalue#call path));
+
+ in
+
+ let has_menu =
+ match paths with
+ | [] -> false
+
+ (* single selection *)
+ | [path, { content=Top (OS os)} ] -> (* top level operating system *)
+ add_top_os_items os path; true
+
+ | [path, { content=Top (Volume dev) }] -> (* top level volume *)
+ add_top_volume_items path; true
+
+ | [path, { content=Directory _ }] -> (* directory *)
+ add_directory_items path; true
+
+ | [path, { content=File _ }] -> (* file *)
+ add_file_items path; true
+
+ | [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
+
+ | [_, { 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
+
+ (* Store hdata into a row. *)
+ method private store_hdata row hdata =
+ let index = unique () in
+ Hashtbl.add hash index hdata;
+ model#set ~row ~column:index_col index
+
+ (* Retrieve previously stored hdata from a row. *)
+ method private get_hdata row =
+ let index = model#get ~row ~column:index_col in
+ try Hashtbl.find hash index
+ with Not_found -> assert false
+
+ (* [find_child_node_by_content row content] searches the direct
+ children of [row] looking for one which exactly matches
+ [hdata.content] and returns that child. If no child found,
+ raises [Not_found]. *)
+ method private find_child_node_by_content row c =
+ let rec loop row =
+ if (self#get_hdata row).content = c then
+ row
+ else if model#iter_next row then
+ loop row
else
- 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);
- model#set ~row ~column:t.date_col (markup_of_date stat.G.mtime);
- ) entries;
-
- (* Remove the placeholder "Loading" entry. NB. Must be done AFTER
- * adding the other entries, or else Gtk will unexpand the row.
+ raise Not_found
+ in
+
+ if not (model#iter_has_child row) then
+ raise Not_found;
+
+ let first_child = model#iter_children (Some row) in
+ loop first_child
+
+ (* Search up to the top of the tree so we know if this directory
+ * comes from an OS or a volume, and the full path to here.
+ *
+ * The path up the tree will always look something like:
+ * Top
+ * \_ Directory
+ * \_ Directory
+ * \_ Loading <--- you are here
+ *
+ * Note this function cannot be called on registry keys. See
+ * {!get_registry_path} for that.
*)
- (try
- let row = find_child_node_by_content t row Loading in
- ignore (model#remove row)
- with Invalid_argument _ | Not_found -> ()
- );
-
- (* The original directory entry has now been loaded, so
- * update its state.
+ method get_pathname row =
+ let hdata = self#get_hdata row in
+ let parent = model#iter_parent row in
+
+ match hdata, parent with
+ | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
+ self#get_pathname parent
+ | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
+ assert false
+ | { content=Directory { dent_name = name }}, Some parent
+ | { content=File { dent_name = name }}, Some parent ->
+ let src, parent_name = self#get_pathname parent in
+ let path =
+ if parent_name = "/" then "/" ^ name
+ else parent_name ^ "/" ^ name in
+ src, path
+ | { content=Top src }, _ -> src, "/"
+ | { content=Directory _ }, None -> assert false
+ | { content=File _ }, None -> assert false
+ | { content=Loading }, _ -> assert false
+ | { content=ErrorMessage _ }, _ -> assert false
+ | { content=Info _ }, _ -> assert false
+ | { content=TopWinReg _ }, _ -> assert false
+ | { content=RegKey _ }, _ -> assert false
+ | { content=RegValue _ }, _ -> assert false
+
+ (* Search up to the top of the tree from a registry key.
+ *
+ * The path up the tree will always look something like:
+ * TopWinReg
+ * \_ RegKey
+ * \_ RegKey <--- you are here
+ * \_ Loading <--- or here
+ *
+ * Note this function cannot be called on ordinary paths. Use
+ * {!get_pathname} for that.
*)
- let hdata = get_hdata t row in
- hdata.state <- IsNode;
- set_visited t row
-
-(* This is called instead of when_read_directory when the read directory
- * (or mount etc) failed. Convert the "Loading" entry into the
- * error message.
- *)
-and when_read_directory_fail ({ model = model } as t) path exn =
- debug "when_read_directory_fail: %s" (Printexc.to_string exn);
-
- match exn with
- | G.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
-
-(* 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
- let h = Option.get hdata.hiveh in
-
- (* Continue as if expanding any other hive node. *)
- let root = Hivex.root h in
- expand_hive_node t row root
-
-(* 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 = UTF8.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 = UTF8.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.
+ method get_registry_path row =
+ let hdata = self#get_hdata row in
+ let parent = model#iter_parent row in
+
+ match hdata, parent with
+ | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
+ self#get_registry_path parent
+ | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
+ assert false
+ | { content=RegKey node; hiveh = Some h }, Some parent ->
+ let top, path = self#get_registry_path parent in
+ let path = Hivex.node_name h node :: path in
+ top, path
+ | { content=TopWinReg (a,b,c,d) }, None -> (a,b,c,d), []
+ | { content=TopWinReg _ }, _ -> assert false
+ | { content=RegKey _}, _ -> assert false
+ | { content=Top _ }, _ -> assert false
+ | { content=Directory _ }, _ -> assert false
+ | { content=File _ }, _ -> assert false
+ | { content=Loading }, _ -> assert false
+ | { content=ErrorMessage _ }, _ -> assert false
+ | { content=Info _ }, _ -> assert false
+ | { content=RegValue _ }, _ -> assert false
+
+ method get_registry_value row =
+ let hdata = self#get_hdata row in
+ match hdata with
+ | { content=RegValue value; hiveh = Some h } ->
+ Hivex.value_value h value
+ | _ -> assert false (* not a registry value *)
+
+ (* This is called whenever we need the registry cache file and we
+ can't be sure that it has already been downloaded. *)
+ method get_registry_file ?fail path (src, _, remotefile, cachefile) cb =
+ let row = model#get_iter path in
+ let top =
+ let rec loop row =
+ match model#iter_parent row with
+ | None -> row
+ | Some parent -> loop parent
+ in
+ loop row in
+
+ Slave.download_file_if_not_exist ?fail src remotefile cachefile
+ (self#when_got_registry_file ?fail top cb)
+
+ method private when_got_registry_file ?fail top cb () =
+ debug "when_got_registry_file";
+ let hdata = self#get_hdata top in
+
+ match hdata with
+ | { hiveh=Some _; content=TopWinReg (_, _, _, cachefile) } ->
+ (* Hive handle already opened. *)
+ cb cachefile
+
+ | { hiveh=None; content=TopWinReg (src, rootkey, remotefile, cachefile) } ->
+ (* Hive handle not opened, open it and save it in the handle. *)
+ (try
+ let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
+ let h = Hivex.open_file cachefile flags in
+ hdata.hiveh <- Some h;
+ cb cachefile
+ with
+ Hivex.Error _ as exn ->
+ match fail with
+ | Some fail -> fail exn
+ | None -> raise exn
+ )
+
+ | _ -> assert false
+
+ (* 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.
*)
- (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
+ method set_visited row =
+ let hdata = self#get_hdata row in
+ if hdata.visited = false then (
+ hdata.visited <- true;
+ match hdata.content with
+ | Directory direntry | File direntry ->
+ debug "set_visited %s" direntry.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 _ -> ()
+ )
+
+ method has_child_info_node path info_text =
+ let row = model#get_iter path in
+ let content = Info info_text in
+ try ignore (self#find_child_node_by_content row content); true
+ with Not_found -> false
+
+ method set_child_info_node path info_text text =
+ self#expand_row path;
+ let row = model#get_iter path in
+ let content = Info info_text in
+ let row =
+ try self#find_child_node_by_content row content
+ with Not_found -> model#insert ~parent:row 0 in
+ let hdata = { state=IsLeaf; content=content; visited=false; hiveh=None } in
+ self#store_hdata row hdata;
+ model#set ~row ~column:name_col text
+
+end
to this trick:
http://mail.gnome.org/archives/gtk-app-devel-list/2003-May/msg00241.html *)
-type t
- (** A filetree widget. Actually an opaque object which contains the
- widget and other data. Use the accessors below. *)
+type registry_t
+val source_of_registry_t : registry_t -> Slave_types.source
+val root_key_of_registry_t : registry_t -> string
-val create : packing:(GObj.widget -> unit) -> unit -> t
- (** Create a new filetree widget (empty).
+(** The filetree widget. *)
+class tree : ?packing:(GObj.widget -> unit) -> unit ->
+object ('a)
+ inherit GTree.view
- [~packing] is the required packing for the widget. *)
+ method clear : unit -> unit
+ (** Clear out all rows in existing widget. *)
-val clear : t -> unit
- (** Clear out all rows in existing widget. *)
+ method add_os : string -> Slave_types.inspection_data -> unit
+ (** [add_os name data] clears out the widget and adds the operating
+ system and/or filesystems described by the [data] struct.
-val add : t -> string -> Slave_types.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,
+ not any untrusted string from the guest; usually we pass the
+ name of the guest from libvirt here. *)
- 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. *)
+ method get_pathname : Gtk.tree_iter -> Slave_types.source * string
+ (** Use [get_pathname row] on a [row] representing a file or
+ directory. It searches back up the tree to get the source
+ OS and the full pathname of the file.
+
+ Don't use this on registry entries. Use {!get_registry_path}
+ instead. *)
+
+ method get_registry_path : Gtk.tree_iter -> registry_t * string list
+ (** Use [get_registry_path row] on a [row] representing a registry
+ entry. It searches back up the tree and returns a tuple
+ containing:
+
+ - an opaque registry handle
+
+ - list of registry path elements (in reverse order)
+
+ Don't use this on files and directories. Use {!get_pathname}
+ instead. *)
+
+ method get_registry_value : Gtk.tree_iter -> Hivex.hive_type * string
+ (** [get_registry_value row] returns the type and value of the
+ registry value at [row]. *)
+
+ method get_registry_file : ?fail:exn Slave.callback ->
+ Gtk.tree_path -> registry_t -> string Slave.callback -> unit
+ (** [get_registry_file ?fail path registry_t cb] forces the
+ registry to be downloaded (if not already).
+
+ [cb cachefile] is called when it is downloaded, where
+ [cachefile] is the local hive containing the registry.
+
+ Optional argument [?fail] is called if the download fails. *)
+
+ method set_visited : Gtk.tree_iter -> unit
+ (** Mark row has visited. *)
+
+ method has_child_info_node : Gtk.tree_path -> string -> bool
+ (** [has_child_info_node path info_text] returns [true] iff there is
+ an info node under path which exactly matches [info_text].
+
+ Info nodes are used for "Calculating ..." messages, and for
+ the final result of those calculations. *)
+
+ method set_child_info_node : Gtk.tree_path -> string -> string -> unit
+ (** [set_child_info_node path info_text text] replaces the
+ displayed [text] in the info node [info_text] under [path].
+ If the info node doesn't exist, then one is created. *)
+
+ (** Signals emitted by the filetree widget.
+
+ The main point of using signals is to decouple the filetree
+ widget from associated dialogs and operations that can be
+ performed by actions in the context menu. So instead of
+ having a giant filetree object that does everything, we have
+ the code split into small modules, with the filetree widget
+ just emitting signals when some action needs to take place.
+
+ All the components are wired together in the {!Window}
+ module. *)
+
+ method after : 'a
+ method disconnect : GtkSignal.id -> unit
+
+ method clear_tree : callback:(unit -> unit) -> GtkSignal.id
+ (** Register a signal handler which is called when the tree is
+ cleared (ie. when either {!clear} or {!add_os} is called. *)
+
+ (** The following methods register signals that are emitted
+ on user events in the context menu. *)
+ method op_checksum_file :
+ callback:(Gtk.tree_path * string -> unit) -> GtkSignal.id
+ method op_copy_regvalue :
+ callback:(Gtk.tree_path -> unit) -> GtkSignal.id
+ method op_disk_usage :
+ callback:(Gtk.tree_path -> unit) -> GtkSignal.id
+ method op_download_as_reg :
+ callback:(Gtk.tree_path * string -> unit) -> GtkSignal.id
+ method op_download_dir_find0 :
+ callback:(Gtk.tree_path -> unit) -> GtkSignal.id
+ method op_download_dir_tarball :
+ callback:(Slave_types.download_dir_tarball_format * Gtk.tree_path -> unit) ->
+ GtkSignal.id
+ method op_download_file :
+ callback:(Gtk.tree_path -> unit) -> GtkSignal.id
+ method op_file_information :
+ callback:(Gtk.tree_path -> unit) -> GtkSignal.id
+ method op_inspection_dialog :
+ callback:(Slave_types.inspection_os -> unit) -> GtkSignal.id
+ method op_view_file :
+ callback:(Gtk.tree_path * string -> unit) -> GtkSignal.id
+end
open Utils
open Slave_types
-open Filetree_type
open Printf
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.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 _ -> ()
- )
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. *)
+++ /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 Printf
-
-open Utils
-open Slave_types
-
-open Filetree_type
-open Filetree_markup
-
-(* Temporary directory for shared use by any function in this file.
- * It is cleaned up when the program exits.
- *)
-let tmpdir = tmpdir ()
-
-(* Get the basename of a file, using path conventions which are valid
- * for libguestfs. So [Filename.basename] won't necessarily work
- * because it will use host path conventions.
- *)
-let basename pathname =
- let len = String.length pathname in
- try
- let i = String.rindex pathname '/' in
- let r = String.sub pathname (i+1) (len-i-1) in
- if r = "" then "root" else r
- with
- Not_found -> pathname
-
-(* Get the extension of a file using libguestfs path conventions,
- * including the leading point (eg. ".txt"). Might return an empty
- * string if there is no extension.
- *)
-let extension pathname =
- let len = String.length pathname in
- try
- let i = String.rindex pathname '.' in
- let r = String.sub pathname i (len-i) in
- r
- with
- Not_found -> ""
-
-(* Download a single file. *)
-let rec download_file ({ model = model } as t) path () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "download_file %s: showing dialog" pathname;
-
- (* Put up the dialog. *)
- let title = "Download file" in
- let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
- dlg#add_button_stock `CANCEL `CANCEL;
- dlg#add_select_button_stock `SAVE `SAVE;
- dlg#set_current_name (basename pathname);
-
- match dlg#run () with
- | `DELETE_EVENT | `CANCEL ->
- dlg#destroy ()
- | `SAVE ->
- match dlg#filename with
- | None -> ()
- | Some localfile ->
- dlg#destroy ();
-
- (* Download the file. *)
- Slave.download_file src pathname localfile
- (when_downloaded_file t path)
-
-and when_downloaded_file ({ model = model } as t) path () =
- let row = model#get_iter path in
- set_visited t row
-
-(* Download a directory as a tarball. *)
-let rec download_dir_tarball ({ model = model } as t) format path () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "download_dir_tarball %s: showing dialog" pathname;
-
- (* Put up the dialog. *)
- let title = "Download directory to tar file" in
- let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
- dlg#add_button_stock `CANCEL `CANCEL;
- dlg#add_select_button_stock `SAVE `SAVE;
-
- let extension = match format with
- | Tar -> ".tar"
- | TGZ -> ".tar.gz"
- | TXZ -> ".tar.xz"
- in
- dlg#set_current_name (basename pathname ^ extension);
-
- match dlg#run () with
- | `DELETE_EVENT | `CANCEL ->
- dlg#destroy ()
- | `SAVE ->
- match dlg#filename with
- | None -> ()
- | Some localfile ->
- dlg#destroy ();
-
- (* Download the directory. *)
- Slave.download_dir_tarball src pathname format localfile
- (when_downloaded_dir_tarball t path)
-
-and when_downloaded_dir_tarball ({ model = model } as t) path () =
- let row = model#get_iter path in
- set_visited t row
-
-let rec download_dir_find0 ({ model = model } as t) path () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "download_dir_find0 %s: showing dialog" pathname;
-
- (* Put up the dialog. *)
- let title = "Download list of filenames" in
- let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
- dlg#add_button_stock `CANCEL `CANCEL;
- dlg#add_select_button_stock `SAVE `SAVE;
- dlg#set_current_name (basename pathname ^ ".filenames.txt");
-
- (* Notify that the list of strings is \0 separated. *)
- let hbox =
- let hbox = GPack.hbox () in
- ignore (GMisc.image ~stock:`INFO ~packing:hbox#pack ());
- let label = GMisc.label
- ~text:"The list of filenames is saved to a file with zero byte separators, to allow the full range of characters to be used in the names themselves."
- ~packing:hbox#pack () in
- label#set_line_wrap true;
- hbox in
- dlg#set_extra_widget (hbox :> GObj.widget);
-
- match dlg#run () with
- | `DELETE_EVENT | `CANCEL ->
- dlg#destroy ()
- | `SAVE ->
- match dlg#filename with
- | None -> ()
- | Some localfile ->
- dlg#destroy ();
-
- (* Download the directory. *)
- Slave.download_dir_find0 src pathname localfile
- (when_downloaded_dir_find0 t path)
-
-and when_downloaded_dir_find0 ({ model = model } as t) path () =
- let row = model#get_iter path in
- set_visited t row
-
-let has_child_node_equals t row content =
- try ignore (find_child_node_by_content t row content); true
- with Not_found -> false
-
-(* Calculate disk space used by a directory. *)
-let rec disk_usage ({ model = model } as t) path () =
- t.view#expand_row path;
-
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "disk_usage %s" pathname;
-
- (* See if this node already has an Info "disk_usage" child node. If
- * so they don't recreate it.
- *)
- let content = Info "disk_usage" in
- if not (has_child_node_equals t row content) then (
- (* Create the child node first. *)
- let row = model#insert ~parent:row 0 in
- 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)
- )
-
-and when_disk_usage ({ model = model } as t) path pathname kbytes =
- let row = model#get_iter path in
-
- (* Find the Info "disk_usage" child node added above, and replace the
- * text in it with the final size.
- *)
- try
- let content = Info "disk_usage" in
- let row = find_child_node_by_content t row content in
- let msg =
- sprintf "<b>%s</b>\n<small>Disk usage of %s (%Ld KB)</small>"
- (human_size_1k kbytes) pathname kbytes in
- model#set ~row ~column:t.name_col msg
- with
- Not_found -> ()
-
-(* Display operating system inspection information. *)
-let display_inspection_data ({ model = model } as t) path () =
- t.view#expand_row path;
-
- let row = model#get_iter path in
- let src, _ = get_pathname t row in
- debug "display_inspection_data";
-
- (* Should be an OS source, if not ignore. *)
- match src with
- | Volume _ -> ()
- | OS os ->
- (* See if this node already has an Info "inspection_data" child
- * node. If so they don't recreate it.
- *)
- let content = Info "inspection_data" in
- if not (has_child_node_equals t row content) then (
- let row = model#insert ~parent:row 0 in
- let hdata =
- { state=IsLeaf; content=content; visited=false; hiveh=None } in
- store_hdata t row hdata;
-
- (* XXX UGHLEE *)
- let data =
- sprintf "Type: <b>%s</b>\nDistro: <b>%s</b>\nVersion: <b>%d.%d</b>\nArch.: <b>%s</b>\nPackaging: <b>%s</b>/<b>%s</b>\n%sMountpoints:\n%s"
- os.insp_type os.insp_distro
- os.insp_major_version os.insp_minor_version
- os.insp_arch
- os.insp_package_management os.insp_package_format
- (match os.insp_windows_systemroot with
- | None -> ""
- | Some path ->
- sprintf "Systemroot: <b>%s</b>\n" (markup_escape path))
- (String.concat "\n"
- (List.map (
- fun (mp, dev) ->
- sprintf "<b>%s</b> on <b>%s</b>"
- (markup_escape dev) (markup_escape mp))
- os.insp_mountpoints)
- ) 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 *)
-
-(* View a single file. *)
-let rec view_file ({ model = model } as t) path opener () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "view_file %s" pathname;
-
- (* Download the file into a temporary directory. *)
- let ext = extension pathname in
- let localfile = tmpdir // string_of_int (unique ()) ^ ext in
- Slave.download_file src pathname localfile
- (when_downloaded_file_for_view t path opener localfile)
-
-and when_downloaded_file_for_view ({ model = model } as t) path
- opener localfile () =
- let row = model#get_iter path in
- set_visited t row;
-
- let cmd =
- sprintf "%s %s" (Filename.quote opener) (Filename.quote localfile) in
- Slave.run_command cmd Slave.no_callback
-
-(* Compute the checksum of a file. *)
-let rec checksum_file ({ model = model } as t) path csumtype () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "checksum_file %s" pathname;
-
- (* See if this node already has an Info "checksum" child
- * node. If so they don't recreate it.
- *)
- let content = Info ("checksum:" ^ csumtype) in
- if not (has_child_node_equals t row content) then (
- let row = model#insert ~parent:row 0 in
- let hdata =
- { state=IsLeaf; content=content; visited=false; hiveh=None } in
- store_hdata t row hdata;
- model#set ~row ~column:t.name_col
- (sprintf "<i>Calculating %s ...</i>" csumtype);
-
- t.view#expand_row path;
-
- Slave.checksum_file src pathname csumtype
- (when_checksum_file t path pathname csumtype)
- )
-
-and when_checksum_file ({ model = model } as t) path pathname csumtype checksum=
- let row = model#get_iter path in
- set_visited t row;
-
- (* Find the child node added above, and replace the text. *)
- try
- let content = Info ("checksum:" ^ csumtype) in
- let row = find_child_node_by_content t row content in
- let msg = sprintf "%s: %s" csumtype checksum in
- model#set ~row ~column:t.name_col msg
- with
- Not_found -> ()
-
-(* Compute the file information of a file. *)
-let rec file_information ({ model = model } as t) path () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "file_information %s" pathname;
-
- (* See if this node already has an Info "file_information" child
- * node. If so they don't recreate it.
- *)
- let content = Info "file_information" in
- if not (has_child_node_equals t row content) then (
- let row = model#insert ~parent:row 0 in
- 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 file information ...</i>";
-
- t.view#expand_row path;
-
- Slave.file_information src pathname (when_file_information t path pathname)
- )
-
-and when_file_information ({ model = model } as t) path pathname info =
- let row = model#get_iter path in
- set_visited t row;
-
- (* Find the child node added above, and replace the text. *)
- try
- let content = Info "file_information" in
- let row = find_child_node_by_content t row content in
- model#set ~row ~column:t.name_col (markup_escape info)
- with
- Not_found -> ()
-
-(* Export a registry key/subkey tree as a reg file. This is pretty
- * effortless with hivexregedit.
- *)
-let download_as_reg ({ model = model } as t) path hivexregedit () =
- let row = model#get_iter path in
- let hdata = get_hdata t row in
-
- (* Get path to the top of the registry tree. *)
- let (_, rootkey, _, cachefile), nodes = get_registry_path t row in
- let regpath = String.concat "\\" (List.rev nodes) in
- debug "download_as_reg: %s %s %s" cachefile rootkey regpath;
-
- let do_dialog () =
- (* Put up the dialog. *)
- let title = "Download as .reg file" in
- let dlg = GWindow.file_chooser_dialog
- ~action:`SAVE ~title ~modal:true () in
- dlg#add_button_stock `CANCEL `CANCEL;
- dlg#add_select_button_stock `SAVE `SAVE;
- let name = match nodes with [] -> rootkey | (name::_) -> name in
- dlg#set_current_name (name ^ ".reg");
-
- match dlg#run () with
- | `DELETE_EVENT | `CANCEL ->
- dlg#destroy ()
- | `SAVE ->
- match dlg#filename with
- | None -> ()
- | Some localfile ->
- dlg#destroy ();
-
- (* Use hivexregedit to save it. *)
- let cmd =
- sprintf "%s --export --prefix %s %s %s > %s"
- (Filename.quote hivexregedit)
- (Filename.quote rootkey) (Filename.quote cachefile)
- (Filename.quote regpath) (Filename.quote localfile) in
- Slave.run_command cmd Slave.no_callback
- in
-
- match hdata with
- | { content=RegKey _ } ->
- do_dialog ()
-
- | { content=TopWinReg (src, _, remotefile, cachefile) } ->
- (* There's a subtle problem here: If the top node has not been
- * opened, the registry cachefile won't have been downloaded. If
- * the top node has been opened, the registry might still be
- * being downloaded as we are running here. Either way we can't
- * trust the cachefile. Tell the slave thread to download the
- * file if it's not downloaded already (since the slave thread
- * runs in a serial loop, this is always race free).
- *)
- cache_registry_file t path src remotefile cachefile do_dialog
-
- | _ -> () (* not a registry key, ignore *)
+++ /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.
- *)
-
-(** Operations on a file tree.
-
- This module contains operations performed by menu items or
- from the context menu.
-
- 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 checksum_file : Filetree_type.t -> Gtk.tree_path -> string -> unit -> unit
-
-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
-
-val download_as_reg : Filetree_type.t -> Gtk.tree_path -> string -> unit -> unit
-
-val download_dir_tarball : Filetree_type.t -> Slave_types.download_dir_tarball_format -> Gtk.tree_path -> unit -> unit
-
-val download_dir_find0 : Filetree_type.t -> Gtk.tree_path -> unit -> unit
-
-val download_file : Filetree_type.t -> Gtk.tree_path -> unit -> unit
-
-val file_information : Filetree_type.t -> Gtk.tree_path -> unit -> unit
-
-val view_file : Filetree_type.t -> Gtk.tree_path -> string -> unit -> unit
+++ /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 Utils
-
-open Slave_types
-
-(* See struct/field description in .mli file. *)
-type t = {
- view : GTree.view;
- model : GTree.tree_store;
- hash : (int, hdata) Hashtbl.t;
- index_col : int GTree.column;
- mode_col : string GTree.column;
- name_col : string GTree.column;
- size_col : string GTree.column;
- date_col : string GTree.column;
-}
-
-and hdata = {
- mutable state : state_t;
- content : content_t;
- mutable visited : bool;
- mutable hiveh : Hivex.t option;
-}
-
-and state_t =
- | IsLeaf
- | NodeNotStarted
- | NodeLoading
- | IsNode
-
-and content_t =
- | Loading
- | ErrorMessage of string
- | Info of string
- | Top of source
- | TopWinReg of source * string * string * string
- | Directory of direntry
- | File of 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 =
- let index = unique () in
- Hashtbl.add hash index hdata;
- model#set ~row ~column:index_col index
-
-(* Retrieve previously stored hdata from a row. *)
-let get_hdata { model = model; hash = hash; index_col = index_col } row =
- let index = model#get ~row ~column:index_col in
- try Hashtbl.find hash index
- with Not_found -> assert false
-
-(* Iterate over children of node, looking for matching hdata. *)
-let find_child_node_by_content ({ model = model } as t) row c =
- let rec loop row =
- if (get_hdata t row).content = c then
- row
- else if model#iter_next row then
- loop row
- else
- raise Not_found
- in
-
- if not (model#iter_has_child row) then
- raise Not_found;
-
- let first_child = model#iter_children (Some row) in
- loop first_child
-
-(* Search up to the top of the tree so we know if this directory
- * comes from an OS or a volume, and the full path to here.
- *
- * The path up the tree will always look something like:
- * Top
- * \_ Directory
- * \_ Directory
- * \_ Loading <--- you are here
- *
- * Note this function cannot be called on registry keys. See
- * {!get_registry_path} for that.
- *)
-let rec get_pathname ({ model = model } as t) row =
- let hdata = get_hdata t row in
- let parent = model#iter_parent row in
-
- match hdata, parent with
- | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
- get_pathname t parent
- | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
- assert false
- | { content=Directory { dent_name = name }}, Some parent
- | { content=File { dent_name = name }}, Some parent ->
- let src, parent_name = get_pathname t parent in
- let path =
- if parent_name = "/" then "/" ^ name
- else parent_name ^ "/" ^ name in
- src, path
- | { content=Top src }, _ -> src, "/"
- | { content=Directory _ }, None -> assert false
- | { content=File _ }, None -> assert false
- | { content=Loading }, _ -> assert false
- | { content=ErrorMessage _ }, _ -> assert false
- | { content=Info _ }, _ -> assert false
- | { content=TopWinReg _ }, _ -> assert false
- | { content=RegKey _ }, _ -> assert false
- | { content=RegValue _ }, _ -> assert false
-
-(* Search up to the top of the tree from a registry key.
- *
- * The path up the tree will always look something like:
- * TopWinReg
- * \_ RegKey
- * \_ RegKey <--- you are here
- * \_ Loading <--- or here
- *
- * Note this function cannot be called on ordinary paths. Use
- * {!get_pathname} for that.
- *)
-let rec get_registry_path ({ model = model } as t) row =
- let hdata = get_hdata t row in
- let parent = model#iter_parent row in
-
- match hdata, parent with
- | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
- get_registry_path t parent
- | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
- assert false
- | { content=RegKey node; hiveh = Some h }, Some parent ->
- let top, path = get_registry_path t parent in
- let path = Hivex.node_name h node :: path in
- top, path
- | { content=TopWinReg (a,b,c,d) }, None -> (a,b,c,d), []
- | { content=TopWinReg _ }, _ -> assert false
- | { content=RegKey _}, _ -> assert false
- | { content=Top _ }, _ -> assert false
- | { content=Directory _ }, _ -> assert false
- | { content=File _ }, _ -> assert false
- | { content=Loading }, _ -> assert false
- | { content=ErrorMessage _ }, _ -> assert false
- | { content=Info _ }, _ -> assert false
- | { content=RegValue _ }, _ -> assert false
-
-let rec cache_registry_file ?fail t path src remotefile cachefile cb =
- Slave.download_file_if_not_exist ?fail src remotefile cachefile
- (when_cached_registry ?fail t path cb)
-
-and when_cached_registry ?fail ({ model = model } as t) path cb () =
- debug "when_cached_registry";
- let row = model#get_iter path in
- let hdata = get_hdata t row in
-
- match hdata with
- | { hiveh=Some _; content=TopWinReg _ } ->
- (* Hive handle already opened. *)
- cb ()
-
- | { hiveh=None; content=TopWinReg (src, rootkey, remotefile, cachefile) } ->
- (* Hive handle not opened, open it and save it in the handle. *)
- (try
- let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
- let h = Hivex.open_file cachefile flags in
- hdata.hiveh <- Some h;
- cb ()
- with
- Hivex.Error _ as exn ->
- match fail with
- | Some fail -> fail exn
- | None -> raise exn
- )
- | _ -> assert false
+++ /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.
- *)
-
-(** 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.
-
- See {!Filetree} for the full description and public interface. *)
-
-(**/**)
-
-type t = {
- view : GTree.view;
- model : GTree.tree_store;
- hash : (int, hdata) Hashtbl.t; (* hash from index_col -> hdata *)
- index_col : int GTree.column;
- mode_col : string GTree.column;
- name_col : string GTree.column;
- size_col : string GTree.column;
- date_col : string GTree.column;
-}
-
-(* The internal data we store attached to each row, telling us about
- * the state of the row and what is in it.
- *)
-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.
- * All rows are classified as either nodes or leafs (eg. a "node" might
- * be a directory, or a top-level operating system, or anything else
- * which the user could open and look inside).
- *)
-and state_t =
- | IsLeaf (* there are no children *)
- | NodeNotStarted (* user has not tried to open this *)
- | NodeLoading (* user tried to open it, still loading *)
- | IsNode (* we've loaded the children of this directory *)
-
-(* The actual content of a row. *)
-and content_t =
- | Loading (* special "loading ..." node *)
- | ErrorMessage of string (* error message node *)
- | Info of string (* information node (eg. disk usage) *)
- | Top of Slave_types.source (* top level OS or volume node *)
- (* top level Windows Registry node *)
- | TopWinReg of Slave_types.source * string * string * string
- | Directory of Slave_types.direntry(* a directory *)
- | File of Slave_types.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
- (* Store/retrieve hdata structure in a model row. *)
-
-val find_child_node_by_content : t -> Gtk.tree_iter -> content_t -> Gtk.tree_iter
- (* [find_child_node_by_content t row content] searches the direct
- children of [row] looking for one which exactly matches
- [hdata.content] and returns that child. If no child found,
- raises [Not_found]. *)
-
-val get_pathname : t -> Gtk.tree_iter -> Slave_types.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 get_registry_path : t -> Gtk.tree_iter -> (Slave_types.source * string * string * string) * string list
- (* Get the path to the top from a registry key. This returns the
- pair [(TopWinReg_data, path)] where [TopWinReg_data] is the data
- inside a {!TopWinReg} node, and [path] is the path (list of node
- names) up to the top. You normally need to call {!List.rev} on
- [path]. *)
-
-val cache_registry_file : ?fail:exn Slave.callback -> t -> Gtk.tree_path -> Slave_types.source -> string -> string -> unit Slave.callback -> unit
- (* This is called whenever we need the registry cache file and we
- can't be sure that it has already been downloaded. *)
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+open Printf
+
+let rec checksum_file tree (path, csumtype) =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let src, pathname = tree#get_pathname row in
+ debug "checksum_file %s" pathname;
+
+ (* See if this node already has an Info "checksum" child
+ * node. If so they don't recreate it.
+ *)
+ let info_text = "checksum:" ^ csumtype in
+ if not (tree#has_child_info_node path info_text) then (
+ tree#set_child_info_node path info_text
+ (sprintf "<i>Calculating %s ...</i>" csumtype);
+
+ Slave.checksum_file src pathname csumtype
+ (when_checksum_file tree path pathname csumtype)
+ )
+
+and when_checksum_file tree path pathname csumtype checksum =
+ let model = tree#model in
+ let row = model#get_iter path in
+ tree#set_visited row;
+
+ (* Find the child node added above, and replace the text. *)
+ let info_text = "checksum:" ^ csumtype in
+ let msg = sprintf "%s: %s" csumtype checksum in
+ tree#set_child_info_node path info_text msg
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Compute the checksum of a file. *)
+
+val checksum_file : Filetree.tree -> (Gtk.tree_path * string) -> unit
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+let rec copy_regvalue tree path =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let t, v = tree#get_registry_value row in
+ let v = printable_hivex_value t v in
+ let cb = GData.clipboard Gdk.Atom.clipboard in
+ cb#set_text v
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Copy registry key value to clipboard. *)
+
+val copy_regvalue : Filetree.tree -> Gtk.tree_path -> unit
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+open Printf
+
+let rec disk_usage tree path =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let src, pathname = tree#get_pathname row in
+ debug "disk_usage %s" pathname;
+
+ (* See if this node already has an Info "disk_usage" child node. If
+ * so they don't recreate it.
+ *)
+ let info_text = "disk_usage" in
+ if not (tree#has_child_info_node path info_text) then (
+ tree#set_child_info_node path info_text "<i>Calculating disk usage ...</i>";
+
+ Slave.disk_usage src pathname (when_disk_usage tree path pathname)
+ )
+
+and when_disk_usage tree path pathname kbytes =
+ let model = tree#model in
+ let row = model#get_iter path in
+ tree#set_visited row;
+
+ (* Find the Info "disk_usage" child node added above, and replace the
+ * text in it with the final size.
+ *)
+ let info_text = "disk_usage" in
+ let msg =
+ sprintf "<b>%s</b>\n<small>Disk usage of %s (%Ld KB)</small>"
+ (human_size_1k kbytes) pathname kbytes in
+ tree#set_child_info_node path info_text msg
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Calculate disk space used by a directory. *)
+
+val disk_usage : Filetree.tree -> Gtk.tree_path -> unit
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+open Printf
+
+let rec download_as_reg (tree : Filetree.tree) (path, hivexregedit) =
+ let model = tree#model in
+ let row = model#get_iter path in
+
+ (* Get path to the top of the registry tree. *)
+ let registry, nodes = tree#get_registry_path row in
+ let regpath = String.concat "\\" (List.rev nodes) in
+ let rootkey = Filetree.root_key_of_registry_t registry in
+ debug "download_as_reg: %s %s" rootkey regpath;
+
+ (* Force the registry to be downloaded, if not already. *)
+ tree#get_registry_file path registry
+ (when_downloaded tree path hivexregedit rootkey nodes regpath)
+
+and when_downloaded tree path hivexregedit rootkey nodes regpath cachefile =
+ (* Put up the dialog. *)
+ let title = "Download as .reg file" in
+ let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
+ dlg#add_button_stock `CANCEL `CANCEL;
+ dlg#add_select_button_stock `SAVE `SAVE;
+ let name = match nodes with [] -> rootkey | (name::_) -> name in
+ dlg#set_current_name (name ^ ".reg");
+
+ match dlg#run () with
+ | `DELETE_EVENT | `CANCEL ->
+ dlg#destroy ()
+ | `SAVE ->
+ match dlg#filename with
+ | None -> ()
+ | Some localfile ->
+ dlg#destroy ();
+
+ (* Use hivexregedit to save it. *)
+ let cmd =
+ sprintf "%s --export --prefix %s %s %s > %s"
+ (Filename.quote hivexregedit)
+ (Filename.quote rootkey) (Filename.quote cachefile)
+ (Filename.quote regpath) (Filename.quote localfile) in
+ Slave.run_command cmd Slave.no_callback
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Export a registry key/subkey tree as a reg file.
+
+ This is pretty effortless with hivexregedit. *)
+
+val download_as_reg : Filetree.tree -> (Gtk.tree_path * string) -> unit
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+let rec download_dir_find0 tree path =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let src, pathname = tree#get_pathname row in
+ debug "download_dir_find0 %s: showing dialog" pathname;
+
+ (* Put up the dialog. *)
+ let title = "Download list of filenames" in
+ let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
+ dlg#add_button_stock `CANCEL `CANCEL;
+ dlg#add_select_button_stock `SAVE `SAVE;
+ dlg#set_current_name (basename pathname ^ ".filenames.txt");
+
+ (* Notify that the list of strings is \0 separated. *)
+ let hbox =
+ let hbox = GPack.hbox () in
+ ignore (GMisc.image ~stock:`INFO ~packing:hbox#pack ());
+ let label = GMisc.label
+ ~text:"The list of filenames is saved to a file with zero byte separators, to allow the full range of characters to be used in the names themselves."
+ ~packing:hbox#pack () in
+ label#set_line_wrap true;
+ hbox in
+ dlg#set_extra_widget (hbox :> GObj.widget);
+
+ match dlg#run () with
+ | `DELETE_EVENT | `CANCEL ->
+ dlg#destroy ()
+ | `SAVE ->
+ match dlg#filename with
+ | None -> ()
+ | Some localfile ->
+ dlg#destroy ();
+
+ (* Download the directory. *)
+ Slave.download_dir_find0 src pathname localfile
+ (when_downloaded_dir_find0 tree path)
+
+and when_downloaded_dir_find0 tree path () =
+ let model = tree#model in
+ let row = model#get_iter path in
+ tree#set_visited row
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Download the list of filenames in a directory. *)
+
+val download_dir_find0 : Filetree.tree -> Gtk.tree_path -> unit
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+let rec download_dir_tarball tree (format, path) =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let src, pathname = tree#get_pathname row in
+ debug "download_dir_tarball %s: showing dialog" pathname;
+
+ (* Put up the dialog. *)
+ let title = "Download directory to tar file" in
+ let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
+ dlg#add_button_stock `CANCEL `CANCEL;
+ dlg#add_select_button_stock `SAVE `SAVE;
+
+ let extension = match format with
+ | Slave_types.Tar -> ".tar"
+ | Slave_types.TGZ -> ".tar.gz"
+ | Slave_types.TXZ -> ".tar.xz"
+ in
+ dlg#set_current_name (basename pathname ^ extension);
+
+ match dlg#run () with
+ | `DELETE_EVENT | `CANCEL ->
+ dlg#destroy ()
+ | `SAVE ->
+ match dlg#filename with
+ | None -> ()
+ | Some localfile ->
+ dlg#destroy ();
+
+ (* Download the directory. *)
+ Slave.download_dir_tarball src pathname format localfile
+ (when_downloaded_dir_tarball tree path)
+
+and when_downloaded_dir_tarball tree path () =
+ let model = tree#model in
+ let row = model#get_iter path in
+ tree#set_visited row
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Download a directory as a tarball. *)
+
+val download_dir_tarball : Filetree.tree -> (Slave_types.download_dir_tarball_format * Gtk.tree_path) -> unit
+ (** [download_dir_tarball] displays a download dialog to download
+ a directory as a tarball. *)
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+let rec download_file tree path =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let src, pathname = tree#get_pathname row in
+ debug "download_file %s: showing dialog" pathname;
+
+ (* Put up the dialog. *)
+ let title = "Download file" in
+ let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
+ dlg#add_button_stock `CANCEL `CANCEL;
+ dlg#add_select_button_stock `SAVE `SAVE;
+ dlg#set_current_name (basename pathname);
+
+ match dlg#run () with
+ | `DELETE_EVENT | `CANCEL ->
+ dlg#destroy ()
+ | `SAVE ->
+ match dlg#filename with
+ | None -> ()
+ | Some localfile ->
+ dlg#destroy ();
+
+ (* Download the file. *)
+ Slave.download_file src pathname localfile
+ (when_downloaded_file tree path)
+
+and when_downloaded_file tree path () =
+ let model = tree#model in
+ let row = model#get_iter path in
+ tree#set_visited row
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Download a single file. *)
+
+val download_file : Filetree.tree -> Gtk.tree_path -> unit
+ (** [download_file] displays a download dialog for a single regular
+ file, then downloads it. *)
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+let rec file_information tree path =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let src, pathname = tree#get_pathname row in
+ debug "file_information %s" pathname;
+
+ (* See if this node already has an Info "file_information" child
+ * node. If so they don't recreate it.
+ *)
+ let info_text = "file_information" in
+ if not (tree#has_child_info_node path info_text) then (
+ tree#set_child_info_node path info_text
+ "<i>Calculating file information ...</i>";
+
+ Slave.file_information src pathname
+ (when_file_information tree path pathname)
+ )
+
+and when_file_information tree path pathname fileinfo =
+ let model = tree#model in
+ let row = model#get_iter path in
+ tree#set_visited row;
+
+ (* Find the child node added above, and replace the text. *)
+ let info_text = "file_information" in
+ let msg = markup_escape fileinfo in
+ tree#set_child_info_node path info_text msg
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Compute the file information of a file. *)
+
+val file_information : Filetree.tree -> Gtk.tree_path -> unit
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Printf
+
+open Utils
+
+let inspection_dialog (tree : Filetree.tree) os =
+ debug "inspection dialog";
+ let title = "Inspection data" in
+ let dlg = GWindow.dialog ~title () in
+
+ dlg#show ();
+
+ (* Make sure dialog is destroyed when the tree is cleared. *)
+ ignore (
+ tree#clear_tree ~callback:(
+ fun () ->
+ debug "inspection clear_tree -> destroy dialog";
+ dlg#destroy ()
+ )
+ )
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** Operating system inspection data dialog. *)
+
+val inspection_dialog : Filetree.tree -> Slave_types.inspection_os -> unit
+ (** [dialog tree os] creates a operating system inspection
+ dialog, displaying the inspection data from [os].
+
+ [tree] is passed here just so that we can register a
+ signal to destroy the dialog when the tree is cleared. *)
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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 Utils
+
+open Printf
+
+let tmpdir = tmpdir ()
+
+let rec view_file tree (path, opener) =
+ let model = tree#model in
+ let row = model#get_iter path in
+ let src, pathname = tree#get_pathname row in
+ debug "view_file %s" pathname;
+
+ (* Download the file into a temporary directory. *)
+ let ext = extension pathname in
+ let localfile = tmpdir // string_of_int (unique ()) ^ ext in
+ Slave.download_file src pathname localfile
+ (when_downloaded_file_for_view tree path opener localfile)
+
+and when_downloaded_file_for_view tree path opener localfile () =
+ let model = tree#model in
+ let row = model#get_iter path in
+ tree#set_visited row;
+
+ let cmd =
+ sprintf "%s %s" (Filename.quote opener) (Filename.quote localfile) in
+ Slave.run_command cmd Slave.no_callback
--- /dev/null
+(* Guestfs Browser.
+ * Copyright (C) 2011 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.
+ *)
+
+(** View a single file. *)
+
+val view_file : Filetree.tree -> (Gtk.tree_path * string) -> unit
let local_file_exists filename =
try Unix.access filename [Unix.F_OK]; true
with Unix.Unix_error _ -> false
+
+let basename pathname =
+ let len = String.length pathname in
+ try
+ let i = String.rindex pathname '/' in
+ let r = String.sub pathname (i+1) (len-i-1) in
+ if r = "" then "root" else r
+ with
+ Not_found -> pathname
+
+let extension pathname =
+ let len = String.length pathname in
+ try
+ let i = String.rindex pathname '.' in
+ let r = String.sub pathname i (len-i) in
+ r
+ with
+ Not_found -> ""
val local_file_exists : string -> bool
(** Returns true if the (local) file exists. *)
+
+val basename : string -> string
+ (** Get the basename of a file, using path conventions which are valid
+ for libguestfs. So {!Filename.basename} won't necessarily work
+ because it will use host path conventions. *)
+
+val extension : string -> string
+ (** Get the extension of a file using libguestfs path conventions,
+ including the leading point (eg. [.txt]). Might return an empty
+ string if there is no extension. *)
(* Main window state. *)
type window_state = {
window : GWindow.window;
- view : Filetree.t;
+ view : Filetree.tree;
vmcombo : GEdit.combo_box GEdit.text_combo;
refresh_button : GButton.button;
throbber : GMisc.image;
(* Clear the filetree. *)
let clear_view ws =
- Filetree.clear ws.view
+ ws.view#clear ()
(* Callback from Connect -> ... menu items. *)
let rec connect_to ws uri =
debug "root device %s contains %s %s %d.%d" root typ distro major minor;
) data.insp_oses;
- Filetree.add ws.view name data
+ ws.view#add_os name data
let throbber_busy ws () =
(*throbber#set_pixbuf animation*)
vmcombo, refresh_button, throbber, static
and make_filetree ~packing () =
+ (* Create the filetree inside a scrolled window. *)
let sw =
GBin.scrolled_window ~packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
- Filetree.create ~packing:sw#add ()
+ let tree = new Filetree.tree ~packing:sw#add () in
+
+ (* Wire up the loosely-coupled external components of the filetree.
+ * See the note about signals in {!Filetree.tree} documentation.
+ *)
+ ignore (tree#op_checksum_file
+ ~callback:(Op_checksum_file.checksum_file tree));
+ ignore (tree#op_copy_regvalue
+ ~callback:(Op_copy_regvalue.copy_regvalue tree));
+ ignore (tree#op_disk_usage
+ ~callback:(Op_disk_usage.disk_usage tree));
+ ignore (tree#op_download_as_reg
+ ~callback:(Op_download_as_reg.download_as_reg tree));
+ ignore (tree#op_download_dir_find0
+ ~callback:(Op_download_dir_find0.download_dir_find0 tree));
+ ignore (tree#op_download_dir_tarball
+ ~callback:(Op_download_dir_tarball.download_dir_tarball tree));
+ ignore (tree#op_download_file
+ ~callback:(Op_download_file.download_file tree));
+ ignore (tree#op_file_information
+ ~callback:(Op_file_information.file_information tree));
+ ignore (tree#op_inspection_dialog
+ ~callback:(Op_inspection_dialog.inspection_dialog tree));
+ ignore (tree#op_view_file
+ ~callback:(Op_view_file.view_file tree));
+
+ tree
(* Do what the user asked on the command line. *)
let rec run_cli_request ws = function
git.annexia.org / guestfs-browser.git / commitdiff