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.
33 type t = Filetree_type.t
35 (* Temporary directory for shared use by all instances of this widget,
36 * cleaned up when the program exits.
38 let tmpdir = tmpdir ()
40 let rec create ~packing () =
41 let view = GTree.view ~packing () in
42 (*view#set_rules_hint true;*)
43 (*view#selection#set_mode `MULTIPLE; -- add this later *)
45 (* Hash of index numbers -> hdata. We do this because it's more
46 * efficient for the GC compared to storing OCaml objects directly in
49 let hash = Hashtbl.create 1023 in
51 (* The columns stored in each row. The hidden [index_col] column is
52 * an index into the hash table that records everything else about
53 * this row (see hdata above). The other display columns, eg.
54 * [name_col] contain Pango markup and thus have to be escaped.
56 let cols = new GTree.column_list in
58 let index_col = cols#add Gobject.Data.int in
60 let mode_col = cols#add Gobject.Data.string in
61 let name_col = cols#add Gobject.Data.string in
62 let size_col = cols#add Gobject.Data.string in
63 let date_col = cols#add Gobject.Data.string in
65 (* Create the model. *)
66 let model = GTree.tree_store cols in
68 (* Create the view. *)
69 view#set_model (Some (model :> GTree.model));
71 let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
72 let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
73 mode_view#set_resizable true;
74 ignore (view#append_column mode_view);
76 let renderer = GTree.cell_renderer_text [], ["markup", name_col] in
77 let name_view = GTree.view_column ~title:"Filename" ~renderer () in
78 name_view#set_resizable true;
79 name_view#set_sizing `AUTOSIZE;
80 ignore (view#append_column name_view);
82 let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", size_col] in
83 let size_view = GTree.view_column ~title:"Size" ~renderer () in
84 size_view#set_resizable true;
85 ignore (view#append_column size_view);
87 let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", date_col] in
88 let date_view = GTree.view_column ~title:"Date" ~renderer () in
89 date_view#set_resizable true;
90 ignore (view#append_column date_view);
93 view = view; model = model; hash = hash;
94 index_col = index_col;
95 mode_col = mode_col; name_col = name_col; size_col = size_col;
99 (* Open a context menu when a button is pressed. *)
100 ignore (view#event#connect#button_press ~callback:(button_press t));
104 (* Handle mouse button press on the selected row. This opens the
105 * pop-up context menu.
106 * http://scentric.net/tutorial/sec-selections-context-menus.html
108 and button_press ({ model = model; view = view } as t) ev =
109 let button = GdkEvent.Button.button ev in
110 let x = int_of_float (GdkEvent.Button.x ev) in
111 let y = int_of_float (GdkEvent.Button.y ev) in
112 let time = GdkEvent.Button.time ev in
114 (* Right button for opening the context menu. *)
117 (* If no row is selected, select the row under the mouse. *)
119 let sel = view#selection in
120 if sel#count_selected_rows < 1 then (
121 match view#get_path_at_pos ~x ~y with
123 | Some (path, _, _, _) ->
125 sel#select_path path;
128 sel#get_selected_rows (* actually returns paths *) in
130 (* Select the row under the mouse. *)
132 let sel = view#selection in
133 match view#get_path_at_pos ~x ~y with
135 | Some (path, _, _, _) ->
137 sel#select_path path;
140 (* Get the hdata for all the paths. Filter out rows that it doesn't
141 * make sense to select.
146 let row = model#get_iter path in
147 let hdata = get_hdata t row in
149 | { content=(Loading | ErrorMessage _ | Info _) } -> None
150 | { content=(Top _ | Directory _ | File _ |
151 TopWinReg _ | RegKey _ | RegValue _ ) } ->
155 (* Based on number of selected rows and what is selected, construct
158 if paths <> [] then (
159 let menu = make_context_menu t paths in
160 menu#popup ~button ~time
163 (* Return true so no other handler will run. *)
166 (* We didn't handle this, defer to other handlers. *)
169 and make_context_menu t paths =
170 let menu = GMenu.menu () in
171 let factory = new GMenu.factory menu in
173 let item = factory#add_item "Open" in
174 item#misc#set_sensitive false;
176 let rec add_file_items path =
177 let item = factory#add_item "File information" in
178 item#misc#set_sensitive false;
179 let item = factory#add_item "Checksum" in
180 item#misc#set_sensitive false;
181 ignore (factory#add_separator ());
182 let item = factory#add_item "Download ..." in
183 ignore (item#connect#activate ~callback:(download_file t path));
185 and add_directory_items path =
186 let item = factory#add_item "Directory information" in
187 item#misc#set_sensitive false;
188 let item = factory#add_item "Calculate disk usage" in
189 ignore (item#connect#activate ~callback:(disk_usage t path));
190 ignore (factory#add_separator ());
191 let item = factory#add_item "Download ..." in
192 item#misc#set_sensitive false;
193 let item = factory#add_item "Download as .tar ..." in
194 ignore (item#connect#activate
195 ~callback:(download_dir_tarball t Slave.Tar path));
196 let item = factory#add_item "Download as .tar.gz ..." in
197 ignore (item#connect#activate
198 ~callback:(download_dir_tarball t Slave.TGZ path));
199 let item = factory#add_item "Download as .tar.xz ..." in
200 ignore (item#connect#activate
201 ~callback:(download_dir_tarball t Slave.TXZ path));
202 let item = factory#add_item "Download list of filenames ..." in
203 ignore (item#connect#activate ~callback:(download_dir_find0 t path));
205 and add_os_items path =
206 let item = factory#add_item "Operating system information" in
207 ignore (item#connect#activate ~callback:(display_inspection_data t path));
208 ignore (factory#add_separator ());
209 add_volume_items path
211 and add_volume_items path =
212 let item = factory#add_item "Filesystem used & free" in
213 item#misc#set_sensitive false;
214 let item = factory#add_item "Block device information" in
215 item#misc#set_sensitive false;
216 ignore (factory#add_separator ());
217 add_directory_items path
221 (* single selection *)
222 | [path, { content=Top (Slave.OS os)} ] -> (* top level operating system *)
225 | [path, { content=Top (Slave.Volume dev) }] -> (* top level volume *)
226 add_volume_items path
228 | [path, { content=Directory direntry }] -> (* directory *)
229 add_directory_items path
231 | [path, { content=File direntry }] -> (* file *)
234 | [_, { content=Loading }]
235 | [_, { content=ErrorMessage _ }] -> ()
238 (* At the moment multiple selection is disabled. When/if we
239 * enable it we should do something intelligent here. XXX
246 let clear { model = model; hash = hash } =
250 let rec add ({ model = model } as t) name data =
253 (* Populate the top level of the filetree. If there are operating
254 * systems from inspection, these have their own top level entries
255 * followed by only unreferenced filesystems. If we didn't get
256 * anything from inspection, then at the top level we just show
259 let other_filesystems =
260 DeviceSet.of_list (List.map fst data.Slave.insp_all_filesystems) in
261 let other_filesystems =
262 List.fold_left (fun set { Slave.insp_filesystems = fses } ->
263 DeviceSet.subtract set (DeviceSet.of_array fses))
264 other_filesystems data.Slave.insp_oses in
266 (* Add top level operating systems. *)
267 List.iter (add_top_level_os t name) data.Slave.insp_oses;
269 (* Add top level left-over filesystems. *)
270 DeviceSet.iter (add_top_level_vol t name) other_filesystems;
272 (* If it's Windows and registry files exist, create a node for
277 (match os.Slave.insp_winreg_SAM with
279 add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SAM" filename
282 (match os.Slave.insp_winreg_SECURITY with
284 add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SECURITY"
288 (match os.Slave.insp_winreg_SOFTWARE with
290 add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
294 (match os.Slave.insp_winreg_SYSTEM with
296 add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SYSTEM"
300 (match os.Slave.insp_winreg_DEFAULT with
302 add_top_level_winreg t name os "HKEY_USERS\\.DEFAULT" filename
305 ) data.Slave.insp_oses;
307 (* Expand the first top level node. *)
308 match model#get_iter_first with
311 t.view#expand_row (model#get_path row)
313 (* Add a top level operating system node. *)
314 and add_top_level_os ({ model = model } as t) name os =
316 sprintf "<b>%s</b>\n<small>%s</small>\n<small>%s</small>"
317 (markup_escape name) (markup_escape os.Slave.insp_hostname)
318 (markup_escape os.Slave.insp_product_name) in
320 let row = model#append () in
321 make_node t row (Top (Slave.OS os)) None;
322 model#set ~row ~column:t.name_col markup
324 (* Add a top level volume (left over filesystem) node. *)
325 and add_top_level_vol ({ model = model } as t) name dev =
327 sprintf "<b>%s</b>\n<small>from %s</small>"
328 (markup_escape dev) (markup_escape name) in
330 let row = model#append () in
331 make_node t row (Top (Slave.Volume dev)) None;
332 model#set ~row ~column:t.name_col markup
334 (* Add a top level Windows Registry node. *)
335 and add_top_level_winreg ({ model = model } as t) name os rootkey
337 let cachefile = tmpdir // string_of_int (unique ()) ^ ".hive" in
340 sprintf "<b>%s</b>\n<small>from %s</small>"
341 (markup_escape rootkey) (markup_escape name) in
343 let row = model#append () in
345 (TopWinReg (Slave.OS os, rootkey, remotefile, cachefile)) None;
346 model#set ~row ~column:t.name_col markup
348 (* Generic function to make an openable node to the tree. *)
349 and make_node ({ model = model } as t) row content hiveh =
351 { state=NodeNotStarted; content=content; visited=false; hiveh=hiveh } in
352 store_hdata t row hdata;
354 (* Create a placeholder "loading ..." row underneath this node so
355 * the user has something to expand.
357 let placeholder = model#append ~parent:row () in
358 let hdata = { state=IsLeaf; content=Loading; visited=false; hiveh=None } in
359 store_hdata t placeholder hdata;
360 model#set ~row:placeholder ~column:t.name_col "<i>Loading ...</i>";
361 ignore (t.view#connect#row_expanded ~callback:(expand_row t))
363 and make_leaf ({ model = model } as t) row content hiveh =
364 let hdata = { state=IsLeaf; content=content; visited=false; hiveh=hiveh } in
365 store_hdata t row hdata
367 (* This is called when the user expands a row. *)
368 and expand_row ({ model = model } as t) row _ =
369 match get_hdata t row with
370 | { state=NodeNotStarted; content=Top src } as hdata ->
371 (* User has opened a top level node that was not previously opened. *)
373 (* Mark this row as loading, so we don't try to open it again. *)
374 hdata.state <- NodeLoading;
376 (* Get a stable path for this row. *)
377 let path = model#get_path row in
379 Slave.read_directory ~fail:(when_read_directory_fail t path)
380 src "/" (when_read_directory t path)
382 | { state=NodeNotStarted; content=Directory direntry } as hdata ->
383 (* User has opened a filesystem directory not previously opened. *)
385 (* Mark this row as loading. *)
386 hdata.state <- NodeLoading;
388 (* Get a stable path for this row. *)
389 let path = model#get_path row in
391 let src, pathname = get_pathname t row in
393 Slave.read_directory ~fail:(when_read_directory_fail t path)
394 src pathname (when_read_directory t path)
396 | { state=NodeNotStarted;
397 content=TopWinReg (src, rootkey, remotefile, cachefile) } as hdata ->
398 (* User has opened a Windows Registry top level node
399 * not previously opened.
402 (* Mark this row as loading. *)
403 hdata.state <- NodeLoading;
405 (* Get a stable path for this row. *)
406 let path = model#get_path row in
408 (* Since the user has opened this top level registry node for the
409 * first time, we now need to download the hive.
411 Slave.download_file ~fail:(when_downloaded_registry_fail t path)
412 src remotefile cachefile (when_downloaded_registry t path)
414 | { state=NodeNotStarted; content=RegKey node } as hdata ->
415 (* User has opened a Windows Registry key node not previously opened. *)
417 (* Mark this row as loading. *)
418 hdata.state <- NodeLoading;
420 expand_hive_node t row node
422 (* Ignore when a user opens a node which is loading or has been loaded. *)
423 | { state=(NodeLoading|IsNode) } -> ()
425 (* These are not nodes so it should never be possible to open them. *)
426 | { content=(File _ | RegValue _) } | { state=IsLeaf } -> assert false
428 (* Node should not exist in the tree. *)
429 | { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
432 (* This is the callback when the slave has read the directory for us. *)
433 and when_read_directory ({ model = model } as t) path entries =
434 debug "when_read_directory";
436 let row = model#get_iter path in
438 (* Add the entries. *)
441 let { Slave.dent_name = name; dent_stat = stat; dent_link = link } =
443 let row = model#append ~parent:row () in
444 if is_directory stat.G.mode then
445 make_node t row (Directory direntry) None
447 make_leaf t row (File direntry) None;
448 model#set ~row ~column:t.name_col (markup_of_name direntry);
449 model#set ~row ~column:t.mode_col (markup_of_mode stat.G.mode);
450 model#set ~row ~column:t.size_col (markup_of_size stat.G.size);
451 model#set ~row ~column:t.date_col (markup_of_date stat.G.mtime);
454 (* Remove the placeholder "Loading" entry. NB. Must be done AFTER
455 * adding the other entries, or else Gtk will unexpand the row.
458 let row = find_child_node_by_content t row Loading in
459 ignore (model#remove row)
460 with Invalid_argument _ | Not_found -> ()
463 (* The original directory entry has now been loaded, so
466 let hdata = get_hdata t row in
467 hdata.state <- IsNode;
470 (* This is called instead of when_read_directory when the read directory
471 * (or mount etc) failed. Convert the "Loading" entry into the
474 and when_read_directory_fail ({ model = model } as t) path exn =
475 debug "when_read_directory_fail: %s" (Printexc.to_string exn);
479 let row = model#get_iter path in
480 let row = model#iter_children ~nth:0 (Some row) in
483 { state=IsLeaf; content=ErrorMessage msg; visited=false; hiveh=None } in
484 store_hdata t row hdata;
486 model#set ~row ~column:t.name_col (markup_escape msg)
489 (* unexpected exception: re-raise it *)
492 (* Called when the top level registry node has been opened and the
493 * hive file was downloaded to the cache file successfully.
495 and when_downloaded_registry ({ model = model } as t) path () =
496 debug "when_downloaded_registry";
497 let row = model#get_iter path in
499 let hdata = get_hdata t row in
500 match hdata.content with
501 | TopWinReg (src, rootkey, remotefile, cachefile) ->
503 (* Open the hive and save the hive handle in the row hdata. *)
504 let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
505 let h = Hivex.open_file cachefile flags in
506 hdata.hiveh <- Some h;
508 (* Continue as if expanding any other hive node. *)
509 let root = Hivex.root h in
510 expand_hive_node t row root
512 Hivex.Error _ as exn -> when_downloaded_registry_fail t path exn
516 (* Called instead of {!when_downloaded_registry} if the download failed. *)
517 and when_downloaded_registry_fail ({ model = model } as t) path exn =
518 debug "when_downloaded_registry_fail: %s" (Printexc.to_string exn);
522 | Hivex.Error (_, _, msg) ->
523 let row = model#get_iter path in
524 let row = model#iter_children ~nth:0 (Some row) in
527 { state=IsLeaf; content=ErrorMessage msg; visited=false; hiveh=None } in
528 store_hdata t row hdata;
530 model#set ~row ~column:t.name_col (markup_escape msg)
533 (* unexpected exception: re-raise it *)
536 (* Expand a hive node. *)
537 and expand_hive_node ({ model = model } as t) row node =
538 debug "expand_hive_node";
539 let hdata = get_hdata t row in
540 let h = Option.get hdata.hiveh in
542 (* Read the hive entries (values, subkeys) at this node and add them
545 let values = Hivex.node_values h node in
546 let cmp v1 v2 = compare (Hivex.value_key h v1) (Hivex.value_key h v2) in
547 Array.sort cmp values;
550 let row = model#append ~parent:row () in
551 make_leaf t row (RegValue value) (Some h);
552 model#set ~row ~column:t.name_col (markup_of_regvalue h value);
553 model#set ~row ~column:t.size_col (markup_of_regvaluesize h value);
554 model#set ~row ~column:t.date_col (markup_of_regvaluetype h value);
557 let children = Hivex.node_children h node in
558 let cmp n1 n2 = compare (Hivex.node_name h n1) (Hivex.node_name h n2) in
559 Array.sort cmp children;
562 let row = model#append ~parent:row () in
563 make_node t row (RegKey node) (Some h);
564 model#set ~row ~column:t.name_col (markup_of_regkey h node);
567 (* Remove the placeholder "Loading" entry. NB. Must be done AFTER
568 * adding the other entries, or else Gtk will unexpand the row.
571 let row = find_child_node_by_content t row Loading in
572 ignore (model#remove row)
573 with Invalid_argument _ | Not_found -> ()
576 (* The original entry has now been loaded, so update its state. *)
577 hdata.state <- IsNode;