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