filetree.ml

   1 (* Guestfs Browser.
   2  * Copyright (C) 2010 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  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.
  17  *)
  18
  19 open ExtString
  20 open ExtList
  21 open Unix
  22 open Printf
  23
  24 open Utils
  25 open DeviceSet
  26 open Slave_types
  27
  28 open Filetree_markup
  29
  30 module G = Guestfs
  31 module UTF8 = CamomileLibraryDefault.Camomile.UTF8
  32
  33 (* Temporary directory for shared use by any function in this file.
  34  * It is cleaned up when the program exits.
  35  *)
  36 let tmpdir = tmpdir ()
  37
  38 (* The internal data we store attached to each row, telling us about
  39  * the state of the row and what is in it.
  40  *)
  41 type hdata = {
  42   mutable state : state_t;
  43   content : content_t;
  44   mutable visited : bool;
  45   mutable hiveh : Hivex.t option;
  46 }
  47
  48 (* The type of the hidden column used to implement on-demand loading.
  49  * All rows are classified as either nodes or leafs (eg. a "node" might
  50  * be a directory, or a top-level operating system, or anything else
  51  * which the user could open and look inside).
  52  *)
  53 and state_t =
  54   | IsLeaf           (* there are no children *)
  55   | NodeNotStarted   (* user has not tried to open this *)
  56   | NodeLoading      (* user tried to open it, still loading *)
  57   | IsNode           (* we've loaded the children of this directory *)
  58
  59 (* The actual content of a row. *)
  60 and content_t =
  61   | Loading                          (* special "loading ..." node *)
  62   | ErrorMessage of string           (* error message node *)
  63   | Info of string                   (* information node (eg. disk usage) *)
  64   | Top of Slave_types.source        (* top level OS or volume node *)
  65   | TopWinReg of registry_t          (* top level Windows Registry node *)
  66   | Directory of Slave_types.direntry(* a directory *)
  67   | File of Slave_types.direntry     (* a file inc. special files *)
  68   | RegKey of Hivex.node             (* a registry key (like a dir) *)
  69   | RegValue of Hivex.value          (* a registry value (like a file) *)
  70
  71 (* Source, root key, remote filename, cache filename *)
  72 and registry_t = Slave_types.source * string * string * string
  73
  74 let source_of_registry_t (src, _, _, _) = src
  75 let root_key_of_registry_t (_, root_key, _, _) = root_key
  76
  77 (* This is the Filetree.tree class, derived from GTree.view
  78  * (ie. GtkTreeView).
  79  *)
  80 class tree ?packing () =
  81   let clear_tree = new GUtil.signal () in
  82   let op_checksum_file = new GUtil.signal () in
  83   let op_copy_regvalue = new GUtil.signal () in
  84   let op_disk_usage = new GUtil.signal () in
  85   let op_download_as_reg = new GUtil.signal () in
  86   let op_download_dir_find0 = new GUtil.signal () in
  87   let op_download_dir_tarball = new GUtil.signal () in
  88   let op_download_file = new GUtil.signal () in
  89   let op_file_information = new GUtil.signal () in
  90   let op_inspection_dialog = new GUtil.signal () in
  91   let op_view_file = new GUtil.signal () in
  92
  93   let view = GTree.view ?packing () in
  94   (*view#set_rules_hint true;*)
  95   (*view#selection#set_mode `MULTIPLE; -- add this later *)
  96
  97   (* Hash of index numbers -> hdata.  We do this because it's more
  98    * efficient for the GC compared to storing OCaml objects directly in
  99    * the rows.
 100    *)
 101   let hash = Hashtbl.create 1023 in
 102
 103   (* The columns stored in each row.  The hidden [index_col] column is
 104    * an index into the hash table that records everything else about
 105    * this row (see hdata above).  The other display columns, eg.
 106    * [name_col] contain Pango markup and thus have to be escaped.
 107    *)
 108   let cols = new GTree.column_list in
 109   (* Hidden: *)
 110   let index_col = cols#add Gobject.Data.int in
 111   (* Displayed: *)
 112   let mode_col = cols#add Gobject.Data.string in
 113   let name_col = cols#add Gobject.Data.string in
 114   let size_col = cols#add Gobject.Data.string in
 115   let date_col = cols#add Gobject.Data.string in
 116
 117   (* Create the model. *)
 118   let model = GTree.tree_store cols in
 119
 120 object (self)
 121   inherit GTree.view view#as_tree_view
 122   inherit GUtil.ml_signals [clear_tree#disconnect;
 123                             op_checksum_file#disconnect;
 124                             op_copy_regvalue#disconnect;
 125                             op_disk_usage#disconnect;
 126                             op_download_as_reg#disconnect;
 127                             op_download_dir_find0#disconnect;
 128                             op_download_dir_tarball#disconnect;
 129                             op_download_file#disconnect;
 130                             op_file_information#disconnect;
 131                             op_inspection_dialog#disconnect;
 132                             op_view_file#disconnect]
 133
 134   initializer
 135     (* Open a context menu when a button is pressed. *)
 136     ignore (view#event#connect#button_press ~callback:self#button_press);
 137
 138     (* Create the view. *)
 139     view#set_model (Some (model :> GTree.model));
 140
 141     (* Cell renderers. *)
 142     let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
 143     let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
 144     mode_view#set_resizable true;
 145     ignore (view#append_column mode_view);
 146
 147     let renderer = GTree.cell_renderer_text [], ["markup", name_col] in
 148     let name_view = GTree.view_column ~title:"Filename" ~renderer () in
 149     name_view#set_resizable true;
 150     name_view#set_sizing `AUTOSIZE;
 151     ignore (view#append_column name_view);
 152
 153     let renderer =
 154       GTree.cell_renderer_text [`XALIGN 1.], ["markup", size_col] in
 155     let size_view = GTree.view_column ~title:"Size" ~renderer () in
 156     size_view#set_resizable true;
 157     ignore (view#append_column size_view);
 158
 159     let renderer =
 160       GTree.cell_renderer_text [`XALIGN 1.], ["markup", date_col] in
 161     let date_view = GTree.view_column ~title:"Date" ~renderer () in
 162     date_view#set_resizable true;
 163     ignore (view#append_column date_view)
 164
 165   method clear () : unit =
 166     model#clear ();
 167     Hashtbl.clear hash;
 168     clear_tree#call ()
 169
 170   method add_os name data : unit =
 171     self#clear ();
 172
 173     (* Populate the top level of the filetree.  If there are operating
 174      * systems from inspection, these have their own top level entries
 175      * followed by only unreferenced filesystems.  If we didn't get
 176      * anything from inspection, then at the top level we just show
 177      * filesystems.
 178      *)
 179     let other_filesystems =
 180       DeviceSet.of_list (List.map fst data.insp_all_filesystems) in
 181     let other_filesystems =
 182       List.fold_left (fun set { insp_filesystems = fses } ->
 183                         DeviceSet.subtract set (DeviceSet.of_array fses))
 184         other_filesystems data.insp_oses in
 185
 186     (* Add top level operating systems. *)
 187     List.iter (self#add_top_level_os name) data.insp_oses;
 188
 189     (* Add top level left-over filesystems. *)
 190     DeviceSet.iter (self#add_top_level_vol name) other_filesystems;
 191
 192     (* If it's Windows and registry files exist, create a node for
 193      * each file.
 194      *)
 195     List.iter (
 196       fun os ->
 197         (match os.insp_winreg_SAM with
 198          | Some filename ->
 199              self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SAM"
 200                filename
 201          | None -> ()
 202         );
 203         (match os.insp_winreg_SECURITY with
 204          | Some filename ->
 205              self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SECURITY"
 206                filename
 207          | None -> ()
 208         );
 209         (match os.insp_winreg_SOFTWARE with
 210          | Some filename ->
 211              self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
 212                filename
 213          | None -> ()
 214         );
 215         (match os.insp_winreg_SYSTEM with
 216          | Some filename ->
 217              self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SYSTEM"
 218                filename
 219          | None -> ()
 220         );
 221         (match os.insp_winreg_DEFAULT with
 222          | Some filename ->
 223              self#add_top_level_winreg name os "HKEY_USERS\\.DEFAULT" filename
 224          | None -> ()
 225         );
 226     ) data.insp_oses;
 227
 228     (* Expand the first top level node. *)
 229     match model#get_iter_first with
 230     | None -> ()
 231     | Some row ->
 232         self#expand_row (model#get_path row)
 233
 234   (* Add a top level operating system node. *)
 235   method private add_top_level_os name os =
 236     let markup =
 237       sprintf "<b>%s</b>\n<small>%s</small>\n<small>%s</small>"
 238         (markup_escape name) (markup_escape os.insp_hostname)
 239         (markup_escape os.insp_product_name) in
 240
 241     let row = model#append () in
 242     self#make_node row (Top (OS os)) None;
 243     model#set ~row ~column:name_col markup
 244
 245   (* Add a top level volume (left over filesystem) node. *)
 246   method private add_top_level_vol name dev =
 247     let markup =
 248       sprintf "<b>%s</b>\n<small>from %s</small>"
 249         (markup_escape dev) (markup_escape name) in
 250
 251     let row = model#append () in
 252     self#make_node row (Top (Volume dev)) None;
 253     model#set ~row ~column:name_col markup
 254
 255   (* Add a top level Windows Registry node. *)
 256   method private add_top_level_winreg name os rootkey remotefile =
 257     let cachefile = tmpdir // string_of_int (unique ()) ^ ".hive" in
 258
 259     let markup =
 260       sprintf "<b>%s</b>\n<small>from %s</small>"
 261         (markup_escape rootkey) (markup_escape name) in
 262
 263     let row = model#append () in
 264     self#make_node row
 265       (TopWinReg (OS os, rootkey, remotefile, cachefile)) None;
 266     model#set ~row ~column:name_col markup
 267
 268   (* Generic function to make an openable node to the tree. *)
 269   method private make_node row content hiveh =
 270     let hdata =
 271       { state=NodeNotStarted; content=content; visited=false; hiveh=hiveh } in
 272     self#store_hdata row hdata;
 273
 274     (* Create a placeholder "loading ..." row underneath this node so
 275      * the user has something to expand.
 276      *)
 277     let placeholder = model#append ~parent:row () in
 278     let hdata = { state=IsLeaf; content=Loading; visited=false; hiveh=None } in
 279     self#store_hdata placeholder hdata;
 280     model#set ~row:placeholder ~column:name_col "<i>Loading ...</i>";
 281     ignore (self#connect#row_expanded ~callback:self#user_expand_row)
 282
 283   method private make_leaf row content hiveh =
 284     let hdata = { state=IsLeaf; content=content; visited=false; hiveh=hiveh } in
 285     self#store_hdata row hdata
 286
 287   (* This is called when the user expands a row. *)
 288   method private user_expand_row row _ =
 289     match self#get_hdata row with
 290     | { state=NodeNotStarted; content=Top src } as hdata ->
 291         (* User has opened a top level node that was not previously opened. *)
 292
 293         (* Mark this row as loading, so we don't try to open it again. *)
 294         hdata.state <- NodeLoading;
 295
 296         (* Get a stable path for this row. *)
 297         let path = model#get_path row in
 298
 299         Slave.read_directory ~fail:(self#when_read_directory_fail path)
 300           src "/" (self#when_read_directory path)
 301
 302     | { state=NodeNotStarted; content=Directory direntry } as hdata ->
 303         (* User has opened a filesystem directory not previously opened. *)
 304
 305         (* Mark this row as loading. *)
 306         hdata.state <- NodeLoading;
 307
 308         (* Get a stable path for this row. *)
 309         let path = model#get_path row in
 310
 311         let src, pathname = self#get_pathname row in
 312
 313         Slave.read_directory ~fail:(self#when_read_directory_fail path)
 314           src pathname (self#when_read_directory path)
 315
 316     | { state=NodeNotStarted;
 317         content=TopWinReg topdata } as hdata ->
 318         (* User has opened a Windows Registry top level node
 319          * not previously opened.
 320          *)
 321
 322         (* Mark this row as loading. *)
 323         hdata.state <- NodeLoading;
 324
 325         (* Get a stable path for this row. *)
 326         let path = model#get_path row in
 327
 328         (* Since the user has opened this top level registry node for the
 329          * first time, we now need to download the hive.
 330          *)
 331         self#get_registry_file ~fail:(self#when_downloaded_registry_fail path)
 332           path topdata (self#when_downloaded_registry path)
 333
 334     | { state=NodeNotStarted; content=RegKey node } as hdata ->
 335         (* User has opened a Windows Registry key node not previously opened. *)
 336
 337         (* Mark this row as loading. *)
 338         hdata.state <- NodeLoading;
 339
 340         self#expand_hive_node row node
 341
 342     (* Ignore when a user opens a node which is loading or has been loaded. *)
 343     | { state=(NodeLoading|IsNode) } -> ()
 344
 345     (* In some circumstances these can be nodes, eg. if we have added Info
 346      * nodes below them.  Just ignore them if opened.
 347      *)
 348     | { content=(File _ | RegValue _) } | { state=IsLeaf } -> ()
 349
 350     (* Node should not exist in the tree. *)
 351     | { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
 352         assert false
 353
 354   (* This is the callback when the slave has read the directory for us. *)
 355   method private when_read_directory path entries =
 356     debug "when_read_directory";
 357
 358     let row = model#get_iter path in
 359
 360     (* Sort the entries by lexicographic ordering. *)
 361     let cmp { dent_name = n1 } { dent_name = n2 } =
 362       UTF8.compare n1 n2
 363     in
 364     let entries = List.sort ~cmp entries in
 365
 366     (* Add the entries. *)
 367     List.iter (
 368       fun direntry ->
 369         let { dent_name = name; dent_stat = stat; dent_link = link } =
 370           direntry in
 371         let row = model#append ~parent:row () in
 372         if is_directory stat.G.mode then
 373           self#make_node row (Directory direntry) None
 374         else
 375           self#make_leaf row (File direntry) None;
 376         model#set ~row ~column:name_col (markup_of_name direntry);
 377         model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
 378         model#set ~row ~column:size_col (markup_of_size stat.G.size);
 379         model#set ~row ~column:date_col (markup_of_date stat.G.mtime);
 380     ) entries;
 381
 382     (* Remove the placeholder "Loading" entry.  NB. Must be done AFTER
 383      * adding the other entries, or else Gtk will unexpand the row.
 384      *)
 385     (try
 386        let row = self#find_child_node_by_content row Loading in
 387        ignore (model#remove row)
 388      with Invalid_argument _ | Not_found -> ()
 389     );
 390
 391     (* The original directory entry has now been loaded, so
 392      * update its state.
 393      *)
 394     let hdata = self#get_hdata row in
 395     hdata.state <- IsNode;
 396     self#set_visited row
 397
 398   (* This is called instead of when_read_directory when the read directory
 399    * (or mount etc) failed.  Convert the "Loading" entry into the
 400    * error message.
 401    *)
 402   method private when_read_directory_fail path exn =
 403     debug "when_read_directory_fail: %s" (Printexc.to_string exn);
 404
 405     match exn with
 406     | G.Error msg ->
 407         let row = model#get_iter path in
 408         let row = model#iter_children ~nth:0 (Some row) in
 409
 410         let hdata =
 411           { state=IsLeaf; content=ErrorMessage msg;
 412             visited=false; hiveh=None } in
 413         self#store_hdata row hdata;
 414
 415         model#set ~row ~column:name_col (markup_escape msg)
 416
 417     | exn ->
 418         (* unexpected exception: re-raise it *)
 419         raise exn
 420
 421   (* Called when the top level registry node has been opened and the
 422    * hive file was downloaded to the cache file successfully.
 423    *)
 424   method private when_downloaded_registry path _ =
 425     debug "when_downloaded_registry";
 426     let row = model#get_iter path in
 427     let hdata = self#get_hdata row in
 428     let h = Option.get hdata.hiveh in
 429
 430     (* Continue as if expanding any other hive node. *)
 431     let root = Hivex.root h in
 432     self#expand_hive_node row root
 433
 434   (* Called instead of {!when_downloaded_registry} if the download failed. *)
 435   method private when_downloaded_registry_fail path exn =
 436     debug "when_downloaded_registry_fail: %s" (Printexc.to_string exn);
 437
 438     match exn with
 439     | G.Error msg
 440     | Hivex.Error (_, _, msg) ->
 441         let row = model#get_iter path in
 442         let row = model#iter_children ~nth:0 (Some row) in
 443
 444         let hdata =
 445           { state=IsLeaf; content=ErrorMessage msg;
 446             visited=false; hiveh=None } in
 447         self#store_hdata row hdata;
 448
 449         model#set ~row ~column:name_col (markup_escape msg)
 450
 451     | exn ->
 452         (* unexpected exception: re-raise it *)
 453         raise exn
 454
 455   (* Expand a hive node. *)
 456   method private expand_hive_node row node =
 457     debug "expand_hive_node";
 458     let hdata = self#get_hdata row in
 459     let h = Option.get hdata.hiveh in
 460
 461     (* Read the hive entries (values, subkeys) at this node and add them
 462      * to the tree.
 463      *)
 464     let values = Hivex.node_values h node in
 465     let cmp v1 v2 =
 466       UTF8.compare (Hivex.value_key h v1) (Hivex.value_key h v2)
 467     in
 468     Array.sort cmp values;
 469     Array.iter (
 470       fun value ->
 471         let row = model#append ~parent:row () in
 472         self#make_leaf row (RegValue value) (Some h);
 473         model#set ~row ~column:name_col (markup_of_regvalue h value);
 474         model#set ~row ~column:size_col (markup_of_regvaluesize h value);
 475         model#set ~row ~column:date_col (markup_of_regvaluetype h value);
 476     ) values;
 477
 478     let children = Hivex.node_children h node in
 479     let cmp n1 n2 =
 480       UTF8.compare (Hivex.node_name h n1) (Hivex.node_name h n2)
 481     in
 482     Array.sort cmp children;
 483     Array.iter (
 484       fun node ->
 485         let row = model#append ~parent:row () in
 486         self#make_node row (RegKey node) (Some h);
 487         model#set ~row ~column:name_col (markup_of_regkey h node);
 488     ) children;
 489
 490     (* Remove the placeholder "Loading" entry.  NB. Must be done AFTER
 491      * adding the other entries, or else Gtk will unexpand the row.
 492      *)
 493     (try
 494        let row = self#find_child_node_by_content row Loading in
 495        ignore (model#remove row)
 496      with Invalid_argument _ | Not_found -> ()
 497     );
 498
 499     (* The original entry has now been loaded, so update its state. *)
 500     hdata.state <- IsNode;
 501     self#set_visited row
 502
 503   (* Signals. *)
 504   method clear_tree : callback:(unit -> unit) -> GtkSignal.id =
 505     clear_tree#connect ~after
 506   method op_checksum_file = op_checksum_file#connect ~after
 507   method op_copy_regvalue = op_copy_regvalue#connect ~after
 508   method op_disk_usage = op_disk_usage#connect ~after
 509   method op_download_as_reg = op_download_as_reg#connect ~after
 510   method op_download_dir_find0 = op_download_dir_find0#connect ~after
 511   method op_download_dir_tarball = op_download_dir_tarball#connect ~after
 512   method op_download_file = op_download_file#connect ~after
 513   method op_file_information = op_file_information#connect ~after
 514   method op_inspection_dialog = op_inspection_dialog#connect ~after
 515   method op_view_file = op_view_file#connect ~after
 516
 517   (* Handle mouse button press on the selected row.  This opens the
 518    * pop-up context menu.
 519    * http://scentric.net/tutorial/sec-selections-context-menus.html
 520    *)
 521   method private button_press ev =
 522     let button = GdkEvent.Button.button ev in
 523     let x = int_of_float (GdkEvent.Button.x ev) in
 524     let y = int_of_float (GdkEvent.Button.y ev) in
 525     let time = GdkEvent.Button.time ev in
 526
 527     (* Right button for opening the context menu. *)
 528     if button = 3 then (
 529 (*
 530     (* If no row is selected, select the row under the mouse. *)
 531     let paths =
 532       let sel = view#selection in
 533       if sel#count_selected_rows < 1 then (
 534         match view#get_path_at_pos ~x ~y with
 535         | None -> []
 536         | Some (path, _, _, _) ->
 537             sel#unselect_all ();
 538             sel#select_path path;
 539             [path]
 540       ) else
 541         sel#get_selected_rows (* actually returns paths *) in
 542 *)
 543       (* Select the row under the mouse. *)
 544       let paths =
 545         let sel = view#selection in
 546         match view#get_path_at_pos ~x ~y with
 547         | None -> []
 548         | Some (path, _, _, _) ->
 549             sel#unselect_all ();
 550             sel#select_path path;
 551             [path] in
 552
 553       (* Get the hdata for all the paths.  Filter out rows that it doesn't
 554        * make sense to select.
 555        *)
 556       let paths =
 557         List.filter_map (
 558           fun path ->
 559             let row = model#get_iter path in
 560             let hdata = self#get_hdata row in
 561             match hdata with
 562             | { content=(Loading | ErrorMessage _ | Info _) } -> None
 563             | { content=(Top _ | Directory _ | File _ |
 564                              TopWinReg _ | RegKey _ | RegValue _ ) } ->
 565                 Some (path, hdata)
 566         ) paths in
 567
 568       (* Based on number of selected rows and what is selected, construct
 569        * the context menu.
 570        *)
 571       (match self#make_context_menu paths with
 572        | Some menu -> menu#popup ~button ~time
 573        | None -> ()
 574       );
 575
 576       (* Return true so no other handler will run. *)
 577       true
 578     )
 579     (* We didn't handle this, defer to other handlers. *)
 580     else false
 581
 582   method private make_context_menu paths =
 583     let menu = GMenu.menu () in
 584     let factory = new GMenu.factory menu in
 585
 586     let rec add_file_items path =
 587       let item = factory#add_item "View ..." in
 588       (match Config.opener with
 589        | Some opener ->
 590            ignore (item#connect#activate
 591                      ~callback:(fun () -> op_view_file#call (path, opener)));
 592        | None ->
 593            item#misc#set_sensitive false
 594       );
 595       let item = factory#add_item "File information" in
 596       ignore (item#connect#activate
 597                 ~callback:(fun () -> op_file_information#call path));
 598       let item = factory#add_item "MD5 checksum" in
 599       ignore (item#connect#activate
 600                 ~callback:(fun () -> op_checksum_file#call (path, "md5")));
 601       let item = factory#add_item "SHA1 checksum" in
 602       ignore (item#connect#activate
 603                 ~callback:(fun () -> op_checksum_file#call (path, "sha1")));
 604       ignore (factory#add_separator ());
 605       let item = factory#add_item "Download ..." in
 606       ignore (item#connect#activate
 607                 ~callback:(fun () -> op_download_file#call path));
 608
 609     and add_directory_items path =
 610       let item = factory#add_item "Directory information" in
 611       item#misc#set_sensitive false;
 612       let item = factory#add_item "Calculate disk usage" in
 613       ignore (item#connect#activate
 614                 ~callback:(fun () -> op_disk_usage#call path));
 615       ignore (factory#add_separator ());
 616       let item = factory#add_item "Download ..." in
 617       item#misc#set_sensitive false;
 618       let item = factory#add_item "Download as .tar ..." in
 619       ignore (item#connect#activate
 620                 ~callback:(fun () -> op_download_dir_tarball#call (Tar, path)));
 621       let item = factory#add_item "Download as .tar.gz ..." in
 622       ignore (item#connect#activate
 623                 ~callback:(fun () -> op_download_dir_tarball#call (TGZ, path)));
 624       let item = factory#add_item "Download as .tar.xz ..." in
 625       ignore (item#connect#activate
 626                 ~callback:(fun () -> op_download_dir_tarball#call (TXZ, path)));
 627       let item = factory#add_item "Download list of filenames ..." in
 628       ignore (item#connect#activate
 629                 ~callback:(fun () -> op_download_dir_find0#call path));
 630
 631     and add_top_os_items os path =
 632       let item = factory#add_item "Operating system information" in
 633       ignore (item#connect#activate
 634                 ~callback:(fun () -> op_inspection_dialog#call os));
 635       ignore (factory#add_separator ());
 636       add_top_volume_items path
 637
 638     and add_top_volume_items path =
 639       let item = factory#add_item "Filesystem used & free" in
 640       item#misc#set_sensitive false;
 641       let item = factory#add_item "Block device information" in
 642       item#misc#set_sensitive false;
 643       ignore (factory#add_separator ());
 644       add_directory_items path
 645
 646     and add_topwinreg_items path =
 647       let item = factory#add_item "Download hive file ..." in
 648       item#misc#set_sensitive false;
 649       ignore (factory#add_separator ());
 650       add_regkey_items path
 651
 652     and add_regkey_items path =
 653       let item = factory#add_item "Download as .reg file ..." in
 654       (match Config.hivexregedit with
 655        | Some hivexregedit ->
 656            ignore (item#connect#activate
 657                      ~callback:(fun () ->
 658                                 op_download_as_reg#call (path, hivexregedit)));
 659        | None ->
 660            item#misc#set_sensitive false
 661       )
 662
 663     and add_regvalue_items path =
 664       let item = factory#add_item "Copy value to clipboard" in
 665       ignore (item#connect#activate
 666                 ~callback:(fun () -> op_copy_regvalue#call path));
 667
 668     in
 669
 670     let has_menu =
 671       match paths with
 672       | [] -> false
 673
 674       (* single selection *)
 675       | [path, { content=Top (OS os)} ] ->  (* top level operating system *)
 676           add_top_os_items os path; true
 677
 678       | [path, { content=Top (Volume dev) }] -> (* top level volume *)
 679           add_top_volume_items path; true
 680
 681       | [path, { content=Directory _ }] -> (* directory *)
 682           add_directory_items path; true
 683
 684       | [path, { content=File _ }] ->      (* file *)
 685           add_file_items path; true
 686
 687       | [path, { content=TopWinReg _ }] -> (* top level registry node *)
 688           add_topwinreg_items path; true
 689
 690       | [path, { content=RegKey _ }] ->    (* registry node *)
 691           add_regkey_items path; true
 692
 693       | [path, { content=RegValue _ }] ->  (* registry key/value pair *)
 694           add_regvalue_items path; true
 695
 696       | [_, { content=(Loading|ErrorMessage _|Info _) }] -> false
 697
 698       | _::_::_ ->
 699           (* At the moment multiple selection is disabled.  When/if we
 700            * enable it we should do something intelligent here. XXX
 701            *)
 702           false in
 703     if has_menu then Some menu else None
 704
 705   (* Store hdata into a row. *)
 706   method private store_hdata row hdata =
 707     let index = unique () in
 708     Hashtbl.add hash index hdata;
 709     model#set ~row ~column:index_col index
 710
 711   (* Retrieve previously stored hdata from a row. *)
 712   method private get_hdata row =
 713     let index = model#get ~row ~column:index_col in
 714     try Hashtbl.find hash index
 715     with Not_found -> assert false
 716
 717   (* [find_child_node_by_content row content] searches the direct
 718      children of [row] looking for one which exactly matches
 719      [hdata.content] and returns that child.  If no child found,
 720      raises [Not_found]. *)
 721   method private find_child_node_by_content row c =
 722     let rec loop row =
 723       if (self#get_hdata row).content = c then
 724         row
 725       else if model#iter_next row then
 726         loop row
 727       else
 728         raise Not_found
 729     in
 730
 731     if not (model#iter_has_child row) then
 732       raise Not_found;
 733
 734     let first_child = model#iter_children (Some row) in
 735     loop first_child
 736
 737   (* Search up to the top of the tree so we know if this directory
 738    * comes from an OS or a volume, and the full path to here.
 739    *
 740    * The path up the tree will always look something like:
 741    *     Top
 742    *       \_ Directory
 743    *            \_ Directory
 744    *                 \_ Loading    <--- you are here
 745    *
 746    * Note this function cannot be called on registry keys.  See
 747    * {!get_registry_path} for that.
 748    *)
 749   method get_pathname row =
 750     let hdata = self#get_hdata row in
 751     let parent = model#iter_parent row in
 752
 753     match hdata, parent with
 754     | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
 755         self#get_pathname parent
 756     | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
 757         assert false
 758     | { content=Directory { dent_name = name }}, Some parent
 759     | { content=File { dent_name = name }}, Some parent ->
 760         let src, parent_name = self#get_pathname parent in
 761         let path =
 762           if parent_name = "/" then "/" ^ name
 763           else parent_name ^ "/" ^ name in
 764         src, path
 765     | { content=Top src }, _ -> src, "/"
 766     | { content=Directory _ }, None -> assert false
 767     | { content=File _ }, None -> assert false
 768     | { content=Loading }, _ -> assert false
 769     | { content=ErrorMessage _ }, _ -> assert false
 770     | { content=Info _ }, _ -> assert false
 771     | { content=TopWinReg _ }, _ -> assert false
 772     | { content=RegKey _ }, _ -> assert false
 773     | { content=RegValue _ }, _ -> assert false
 774
 775   (* Search up to the top of the tree from a registry key.
 776    *
 777    * The path up the tree will always look something like:
 778    *     TopWinReg
 779    *       \_ RegKey
 780    *            \_ RegKey          <--- you are here
 781    *                 \_ Loading    <--- or here
 782    *
 783    * Note this function cannot be called on ordinary paths.  Use
 784    * {!get_pathname} for that.
 785    *)
 786   method get_registry_path row =
 787     let hdata = self#get_hdata row in
 788     let parent = model#iter_parent row in
 789
 790     match hdata, parent with
 791     | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
 792         self#get_registry_path parent
 793     | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
 794         assert false
 795     | { content=RegKey node; hiveh = Some h }, Some parent ->
 796         let top, path = self#get_registry_path parent in
 797         let path = Hivex.node_name h node :: path in
 798         top, path
 799     | { content=TopWinReg (a,b,c,d) }, None -> (a,b,c,d), []
 800     | { content=TopWinReg _ }, _ -> assert false
 801     | { content=RegKey _}, _ -> assert false
 802     | { content=Top _ }, _ -> assert false
 803     | { content=Directory _ }, _ -> assert false
 804     | { content=File _ }, _ -> assert false
 805     | { content=Loading }, _ -> assert false
 806     | { content=ErrorMessage _ }, _ -> assert false
 807     | { content=Info _ }, _ -> assert false
 808     | { content=RegValue _ }, _ -> assert false
 809
 810   method get_registry_value row =
 811     let hdata = self#get_hdata row in
 812     match hdata with
 813     | { content=RegValue value; hiveh = Some h } ->
 814         Hivex.value_value h value
 815     | _ -> assert false (* not a registry value *)
 816
 817   (* This is called whenever we need the registry cache file and we
 818      can't be sure that it has already been downloaded. *)
 819   method get_registry_file ?fail path (src, _, remotefile, cachefile) cb =
 820     let row = model#get_iter path in
 821     let top =
 822       let rec loop row =
 823         match model#iter_parent row with
 824         | None -> row
 825         | Some parent -> loop parent
 826       in
 827       loop row in
 828
 829     Slave.download_file_if_not_exist ?fail src remotefile cachefile
 830       (self#when_got_registry_file ?fail top cb)
 831
 832   method private when_got_registry_file ?fail top cb () =
 833     debug "when_got_registry_file";
 834     let hdata = self#get_hdata top in
 835
 836     match hdata with
 837     | { hiveh=Some _; content=TopWinReg (_, _, _, cachefile) } ->
 838         (* Hive handle already opened. *)
 839         cb cachefile
 840
 841     | { hiveh=None; content=TopWinReg (src, rootkey, remotefile, cachefile) } ->
 842         (* Hive handle not opened, open it and save it in the handle. *)
 843         (try
 844            let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
 845            let h = Hivex.open_file cachefile flags in
 846            hdata.hiveh <- Some h;
 847            cb cachefile
 848          with
 849            Hivex.Error _ as exn ->
 850              match fail with
 851              | Some fail -> fail exn
 852              | None -> raise exn
 853         )
 854
 855     | _ -> assert false
 856
 857   (* This is a bit of a hack.  Ideally just setting 'visited' would
 858    * darken the colour when the cell was re-rendered.  However that would
 859    * mean we couldn't store other stuff in the name column.  Therefore,
 860    * repopulate the name column.
 861    *)
 862   method set_visited row =
 863     let hdata = self#get_hdata row in
 864     if hdata.visited = false then (
 865       hdata.visited <- true;
 866       match hdata.content with
 867       | Directory direntry | File direntry ->
 868           debug "set_visited %s" direntry.dent_name;
 869           model#set ~row ~column:name_col
 870             (markup_of_name ~visited:true direntry)
 871       | RegKey node ->
 872           debug "set_visited RegKey";
 873           let h = Option.get hdata.hiveh in
 874           model#set ~row ~column:name_col
 875             (markup_of_regkey ~visited:true h node)
 876       | RegValue value ->
 877           debug "set_visited RegValue";
 878           let h = Option.get hdata.hiveh in
 879           model#set ~row ~column:name_col
 880             (markup_of_regvalue ~visited:true h value)
 881       | Loading | ErrorMessage _ | Info _ | Top _ | TopWinReg _ -> ()
 882     )
 883
 884   method has_child_info_node path info_text =
 885     let row = model#get_iter path in
 886     let content = Info info_text in
 887     try ignore (self#find_child_node_by_content row content); true
 888     with Not_found -> false
 889
 890   method set_child_info_node path info_text text =
 891     self#expand_row path;
 892     let row = model#get_iter path in
 893     let content = Info info_text in
 894     let row =
 895       try self#find_child_node_by_content row content
 896       with Not_found -> model#insert ~parent:row 0 in
 897     let hdata = { state=IsLeaf; content=content; visited=false; hiveh=None } in
 898     self#store_hdata row hdata;
 899     model#set ~row ~column:name_col text
 900
 901 end