2 * Copyright (C) 2010 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
34 type t = Filetree_type.t
36 (* Temporary directory for shared use by any function in this file.
37 * It is cleaned up when the program exits.
39 let tmpdir = tmpdir ()
41 let rec create ~packing () =
42 let view = GTree.view ~packing () in
43 (*view#set_rules_hint true;*)
44 (*view#selection#set_mode `MULTIPLE; -- add this later *)
46 (* Hash of index numbers -> hdata. We do this because it's more
47 * efficient for the GC compared to storing OCaml objects directly in
50 let hash = Hashtbl.create 1023 in
52 (* The columns stored in each row. The hidden [index_col] column is
53 * an index into the hash table that records everything else about
54 * this row (see hdata above). The other display columns, eg.
55 * [name_col] contain Pango markup and thus have to be escaped.
57 let cols = new GTree.column_list in
59 let index_col = cols#add Gobject.Data.int in
61 let mode_col = cols#add Gobject.Data.string in
62 let name_col = cols#add Gobject.Data.string in
63 let size_col = cols#add Gobject.Data.string in
64 let date_col = cols#add Gobject.Data.string in
66 (* Create the model. *)
67 let model = GTree.tree_store cols in
69 (* Create the view. *)
70 view#set_model (Some (model :> GTree.model));
72 let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
73 let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
74 mode_view#set_resizable true;
75 ignore (view#append_column mode_view);
77 let renderer = GTree.cell_renderer_text [], ["markup", name_col] in
78 let name_view = GTree.view_column ~title:"Filename" ~renderer () in
79 name_view#set_resizable true;
80 name_view#set_sizing `AUTOSIZE;
81 ignore (view#append_column name_view);
83 let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", size_col] in
84 let size_view = GTree.view_column ~title:"Size" ~renderer () in
85 size_view#set_resizable true;
86 ignore (view#append_column size_view);
88 let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", date_col] in
89 let date_view = GTree.view_column ~title:"Date" ~renderer () in
90 date_view#set_resizable true;
91 ignore (view#append_column date_view);
94 view = view; model = model; hash = hash;
95 index_col = index_col;
96 mode_col = mode_col; name_col = name_col; size_col = size_col;
100 (* Open a context menu when a button is pressed. *)
101 ignore (view#event#connect#button_press ~callback:(button_press t));
105 (* Handle mouse button press on the selected row. This opens the
106 * pop-up context menu.
107 * http://scentric.net/tutorial/sec-selections-context-menus.html
109 and button_press ({ model = model; view = view } as t) ev =
110 let button = GdkEvent.Button.button ev in
111 let x = int_of_float (GdkEvent.Button.x ev) in
112 let y = int_of_float (GdkEvent.Button.y ev) in
113 let time = GdkEvent.Button.time ev in
115 (* Right button for opening the context menu. *)
118 (* If no row is selected, select the row under the mouse. *)
120 let sel = view#selection in
121 if sel#count_selected_rows < 1 then (
122 match view#get_path_at_pos ~x ~y with
124 | Some (path, _, _, _) ->
126 sel#select_path path;
129 sel#get_selected_rows (* actually returns paths *) in
131 (* Select the row under the mouse. *)
133 let sel = view#selection in
134 match view#get_path_at_pos ~x ~y with
136 | Some (path, _, _, _) ->
138 sel#select_path path;
141 (* Get the hdata for all the paths. Filter out rows that it doesn't
142 * make sense to select.
147 let row = model#get_iter path in
148 let hdata = get_hdata t row in
150 | { content=(Loading | ErrorMessage _ | Info _) } -> None
151 | { content=(Top _ | Directory _ | File _ |
152 TopWinReg _ | RegKey _ | RegValue _ ) } ->
156 (* Based on number of selected rows and what is selected, construct
159 (match make_context_menu t paths with
160 | Some menu -> menu#popup ~button ~time
164 (* Return true so no other handler will run. *)
167 (* We didn't handle this, defer to other handlers. *)
170 and make_context_menu t paths =
171 let menu = GMenu.menu () in
172 let factory = new GMenu.factory menu in
174 let rec add_file_items path =
175 let item = factory#add_item "View ..." in
176 (match Config.opener with
178 ignore (item#connect#activate ~callback:(view_file t path opener));
180 item#misc#set_sensitive false
182 let item = factory#add_item "File information" in
183 ignore (item#connect#activate ~callback:(file_information t path));
184 let item = factory#add_item "MD5 checksum" in
185 ignore (item#connect#activate ~callback:(checksum_file t path "md5"));
186 let item = factory#add_item "SHA1 checksum" in
187 ignore (item#connect#activate ~callback:(checksum_file t path "sha1"));
188 ignore (factory#add_separator ());
189 let item = factory#add_item "Download ..." in
190 ignore (item#connect#activate ~callback:(download_file t path));
192 and add_directory_items path =
193 let item = factory#add_item "Directory information" in
194 item#misc#set_sensitive false;
195 let item = factory#add_item "Calculate disk usage" in
196 ignore (item#connect#activate ~callback:(disk_usage t path));
197 ignore (factory#add_separator ());
198 let item = factory#add_item "Download ..." in
199 item#misc#set_sensitive false;
200 let item = factory#add_item "Download as .tar ..." in
201 ignore (item#connect#activate
202 ~callback:(download_dir_tarball t Tar path));
203 let item = factory#add_item "Download as .tar.gz ..." in
204 ignore (item#connect#activate
205 ~callback:(download_dir_tarball t TGZ path));
206 let item = factory#add_item "Download as .tar.xz ..." in
207 ignore (item#connect#activate
208 ~callback:(download_dir_tarball t TXZ path));
209 let item = factory#add_item "Download list of filenames ..." in
210 ignore (item#connect#activate ~callback:(download_dir_find0 t path));
212 and add_top_os_items path =
213 let item = factory#add_item "Operating system information" in
214 ignore (item#connect#activate ~callback:(display_inspection_data t path));
215 ignore (factory#add_separator ());
216 add_top_volume_items path
218 and add_top_volume_items path =
219 let item = factory#add_item "Filesystem used & free" in
220 item#misc#set_sensitive false;
221 let item = factory#add_item "Block device information" in
222 item#misc#set_sensitive false;
223 ignore (factory#add_separator ());
224 add_directory_items path
226 and add_topwinreg_items path =
227 let item = factory#add_item "Download hive file ..." in
228 item#misc#set_sensitive false;
229 ignore (factory#add_separator ());
230 add_regkey_items path
232 and add_regkey_items path =
233 let item = factory#add_item "Download as .reg file ..." in
234 (match Config.hivexregedit with
235 | Some hivexregedit ->
236 ignore (item#connect#activate
237 ~callback:(download_as_reg t path hivexregedit));
239 item#misc#set_sensitive false
242 and add_regvalue_items path =
243 let item = factory#add_item "Copy value to clipboard" in
244 ignore (item#connect#activate ~callback:(copy_regvalue t path));
252 (* single selection *)
253 | [path, { content=Top (OS os)} ] -> (* top level operating system *)
254 add_top_os_items path; true
256 | [path, { content=Top (Volume dev) }] -> (* top level volume *)
257 add_top_volume_items path; true
259 | [path, { content=Directory _ }] -> (* directory *)
260 add_directory_items path; true
262 | [path, { content=File _ }] -> (* file *)
263 add_file_items path; true
265 | [path, { content=TopWinReg _ }] -> (* top level registry node *)
266 add_topwinreg_items path; true
268 | [path, { content=RegKey _ }] -> (* registry node *)
269 add_regkey_items path; true
271 | [path, { content=RegValue _ }] -> (* registry key/value pair *)
272 add_regvalue_items path; true
274 | [_, { content=(Loading|ErrorMessage _|Info _) }] -> false
277 (* At the moment multiple selection is disabled. When/if we
278 * enable it we should do something intelligent here. XXX
281 if has_menu then Some menu else None
283 let clear { model = model; hash = hash } =
287 let rec add ({ model = model } as t) name data =
290 (* Populate the top level of the filetree. If there are operating
291 * systems from inspection, these have their own top level entries
292 * followed by only unreferenced filesystems. If we didn't get
293 * anything from inspection, then at the top level we just show
296 let other_filesystems =
297 DeviceSet.of_list (List.map fst data.insp_all_filesystems) in
298 let other_filesystems =
299 List.fold_left (fun set { insp_filesystems = fses } ->
300 DeviceSet.subtract set (DeviceSet.of_array fses))
301 other_filesystems data.insp_oses in
303 (* Add top level operating systems. *)
304 List.iter (add_top_level_os t name) data.insp_oses;
306 (* Add top level left-over filesystems. *)
307 DeviceSet.iter (add_top_level_vol t name) other_filesystems;
309 (* If it's Windows and registry files exist, create a node for
314 (match os.insp_winreg_SAM with
316 add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SAM" filename
319 (match os.insp_winreg_SECURITY with
321 add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SECURITY"
325 (match os.insp_winreg_SOFTWARE with
327 add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
331 (match os.insp_winreg_SYSTEM with
333 add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SYSTEM"
337 (match os.insp_winreg_DEFAULT with
339 add_top_level_winreg t name os "HKEY_USERS\\.DEFAULT" filename
344 (* Expand the first top level node. *)
345 match model#get_iter_first with
348 t.view#expand_row (model#get_path row)
350 (* Add a top level operating system node. *)
351 and add_top_level_os ({ model = model } as t) name os =
353 sprintf "<b>%s</b>\n<small>%s</small>\n<small>%s</small>"
354 (markup_escape name) (markup_escape os.insp_hostname)
355 (markup_escape os.insp_product_name) in
357 let row = model#append () in
358 make_node t row (Top (OS os)) None;
359 model#set ~row ~column:t.name_col markup
361 (* Add a top level volume (left over filesystem) node. *)
362 and add_top_level_vol ({ model = model } as t) name dev =
364 sprintf "<b>%s</b>\n<small>from %s</small>"
365 (markup_escape dev) (markup_escape name) in
367 let row = model#append () in
368 make_node t row (Top (Volume dev)) None;
369 model#set ~row ~column:t.name_col markup
371 (* Add a top level Windows Registry node. *)
372 and add_top_level_winreg ({ model = model } as t) name os rootkey
374 let cachefile = tmpdir // string_of_int (unique ()) ^ ".hive" in
377 sprintf "<b>%s</b>\n<small>from %s</small>"
378 (markup_escape rootkey) (markup_escape name) in
380 let row = model#append () in
382 (TopWinReg (OS os, rootkey, remotefile, cachefile)) None;
383 model#set ~row ~column:t.name_col markup
385 (* Generic function to make an openable node to the tree. *)
386 and make_node ({ model = model } as t) row content hiveh =
388 { state=NodeNotStarted; content=content; visited=false; hiveh=hiveh } in
389 store_hdata t row hdata;
391 (* Create a placeholder "loading ..." row underneath this node so
392 * the user has something to expand.
394 let placeholder = model#append ~parent:row () in
395 let hdata = { state=IsLeaf; content=Loading; visited=false; hiveh=None } in
396 store_hdata t placeholder hdata;
397 model#set ~row:placeholder ~column:t.name_col "<i>Loading ...</i>";
398 ignore (t.view#connect#row_expanded ~callback:(expand_row t))
400 and make_leaf ({ model = model } as t) row content hiveh =
401 let hdata = { state=IsLeaf; content=content; visited=false; hiveh=hiveh } in
402 store_hdata t row hdata
404 (* This is called when the user expands a row. *)
405 and expand_row ({ model = model } as t) row _ =
406 match get_hdata t row with
407 | { state=NodeNotStarted; content=Top src } as hdata ->
408 (* User has opened a top level node that was not previously opened. *)
410 (* Mark this row as loading, so we don't try to open it again. *)
411 hdata.state <- NodeLoading;
413 (* Get a stable path for this row. *)
414 let path = model#get_path row in
416 Slave.read_directory ~fail:(when_read_directory_fail t path)
417 src "/" (when_read_directory t path)
419 | { state=NodeNotStarted; content=Directory direntry } as hdata ->
420 (* User has opened a filesystem directory not previously opened. *)
422 (* Mark this row as loading. *)
423 hdata.state <- NodeLoading;
425 (* Get a stable path for this row. *)
426 let path = model#get_path row in
428 let src, pathname = get_pathname t row in
430 Slave.read_directory ~fail:(when_read_directory_fail t path)
431 src pathname (when_read_directory t path)
433 | { state=NodeNotStarted;
434 content=TopWinReg (src, rootkey, remotefile, cachefile) } as hdata ->
435 (* User has opened a Windows Registry top level node
436 * not previously opened.
439 (* Mark this row as loading. *)
440 hdata.state <- NodeLoading;
442 (* Get a stable path for this row. *)
443 let path = model#get_path row in
445 (* Since the user has opened this top level registry node for the
446 * first time, we now need to download the hive.
448 cache_registry_file ~fail:(when_downloaded_registry_fail t path)
449 t path src remotefile cachefile (when_downloaded_registry t path)
451 | { state=NodeNotStarted; content=RegKey node } as hdata ->
452 (* User has opened a Windows Registry key node not previously opened. *)
454 (* Mark this row as loading. *)
455 hdata.state <- NodeLoading;
457 expand_hive_node t row node
459 (* Ignore when a user opens a node which is loading or has been loaded. *)
460 | { state=(NodeLoading|IsNode) } -> ()
462 (* In some circumstances these can be nodes, eg. if we have added Info
463 * nodes below them. Just ignore them if opened.
465 | { content=(File _ | RegValue _) } | { state=IsLeaf } -> ()
467 (* Node should not exist in the tree. *)
468 | { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
471 (* This is the callback when the slave has read the directory for us. *)
472 and when_read_directory ({ model = model } as t) path entries =
473 debug "when_read_directory";
475 let row = model#get_iter path in
477 (* Sort the entries by lexicographic ordering. *)
478 let cmp { dent_name = n1 } { dent_name = n2 } =
481 let entries = List.sort ~cmp entries in
483 (* Add the entries. *)
486 let { dent_name = name; dent_stat = stat; dent_link = link } =
488 let row = model#append ~parent:row () in
489 if is_directory stat.G.mode then
490 make_node t row (Directory direntry) None
492 make_leaf t row (File direntry) None;
493 model#set ~row ~column:t.name_col (markup_of_name direntry);
494 model#set ~row ~column:t.mode_col (markup_of_mode stat.G.mode);
495 model#set ~row ~column:t.size_col (markup_of_size stat.G.size);
496 model#set ~row ~column:t.date_col (markup_of_date stat.G.mtime);
499 (* Remove the placeholder "Loading" entry. NB. Must be done AFTER
500 * adding the other entries, or else Gtk will unexpand the row.
503 let row = find_child_node_by_content t row Loading in
504 ignore (model#remove row)
505 with Invalid_argument _ | Not_found -> ()
508 (* The original directory entry has now been loaded, so
511 let hdata = get_hdata t row in
512 hdata.state <- IsNode;
515 (* This is called instead of when_read_directory when the read directory
516 * (or mount etc) failed. Convert the "Loading" entry into the
519 and when_read_directory_fail ({ model = model } as t) path exn =
520 debug "when_read_directory_fail: %s" (Printexc.to_string exn);
524 let row = model#get_iter path in
525 let row = model#iter_children ~nth:0 (Some row) in
528 { state=IsLeaf; content=ErrorMessage msg; visited=false; hiveh=None } in
529 store_hdata t row hdata;
531 model#set ~row ~column:t.name_col (markup_escape msg)
534 (* unexpected exception: re-raise it *)
537 (* Called when the top level registry node has been opened and the
538 * hive file was downloaded to the cache file successfully.
540 and when_downloaded_registry ({ model = model } as t) path () =
541 debug "when_downloaded_registry";
542 let row = model#get_iter path in
543 let hdata = get_hdata t row in
544 let h = Option.get hdata.hiveh in
546 (* Continue as if expanding any other hive node. *)
547 let root = Hivex.root h in
548 expand_hive_node t row root
550 (* Called instead of {!when_downloaded_registry} if the download failed. *)
551 and when_downloaded_registry_fail ({ model = model } as t) path exn =
552 debug "when_downloaded_registry_fail: %s" (Printexc.to_string exn);
556 | Hivex.Error (_, _, msg) ->
557 let row = model#get_iter path in
558 let row = model#iter_children ~nth:0 (Some row) in
561 { state=IsLeaf; content=ErrorMessage msg; visited=false; hiveh=None } in
562 store_hdata t row hdata;
564 model#set ~row ~column:t.name_col (markup_escape msg)
567 (* unexpected exception: re-raise it *)
570 (* Expand a hive node. *)
571 and expand_hive_node ({ model = model } as t) row node =
572 debug "expand_hive_node";
573 let hdata = get_hdata t row in
574 let h = Option.get hdata.hiveh in
576 (* Read the hive entries (values, subkeys) at this node and add them
579 let values = Hivex.node_values h node in
580 let cmp v1 v2 = UTF8.compare (Hivex.value_key h v1) (Hivex.value_key h v2) in
581 Array.sort cmp values;
584 let row = model#append ~parent:row () in
585 make_leaf t row (RegValue value) (Some h);
586 model#set ~row ~column:t.name_col (markup_of_regvalue h value);
587 model#set ~row ~column:t.size_col (markup_of_regvaluesize h value);
588 model#set ~row ~column:t.date_col (markup_of_regvaluetype h value);
591 let children = Hivex.node_children h node in
592 let cmp n1 n2 = UTF8.compare (Hivex.node_name h n1) (Hivex.node_name h n2) in
593 Array.sort cmp children;
596 let row = model#append ~parent:row () in
597 make_node t row (RegKey node) (Some h);
598 model#set ~row ~column:t.name_col (markup_of_regkey h node);
601 (* Remove the placeholder "Loading" entry. NB. Must be done AFTER
602 * adding the other entries, or else Gtk will unexpand the row.
605 let row = find_child_node_by_content t row Loading in
606 ignore (model#remove row)
607 with Invalid_argument _ | Not_found -> ()
610 (* The original entry has now been loaded, so update its state. *)
611 hdata.state <- IsNode;