(* Guestfs Browser.
 * Copyright (C) 2010 Red Hat Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this program; if not, write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)

open ExtString
open ExtList
open Unix
open Printf

open Utils
open DeviceSet
open Slave_types

open Filetree_markup

module G = Guestfs
module UTF8 = CamomileLibraryDefault.Camomile.UTF8

(* Temporary directory for shared use by any function in this file.
 * It is cleaned up when the program exits.
 *)
let tmpdir = tmpdir ()

(* The internal data we store attached to each row, telling us about
 * the state of the row and what is in it.
 *)
type hdata = {
  mutable state : state_t;
  content : content_t;
  mutable visited : bool;
  mutable hiveh : Hivex.t option;
}

(* The type of the hidden column used to implement on-demand loading.
 * All rows are classified as either nodes or leafs (eg. a "node" might
 * be a directory, or a top-level operating system, or anything else
 * which the user could open and look inside).
 *)
and state_t =
  | IsLeaf           (* there are no children *)
  | NodeNotStarted   (* user has not tried to open this *)
  | NodeLoading      (* user tried to open it, still loading *)
  | IsNode           (* we've loaded the children of this directory *)

(* The actual content of a row. *)
and content_t =
  | Loading                          (* special "loading ..." node *)
  | ErrorMessage of string           (* error message node *)
  | Info of string                   (* information node (eg. disk usage) *)
  | Top of Slave_types.source        (* top level OS or volume node *)
  | TopWinReg of registry_t          (* top level Windows Registry node *)
  | Directory of Slave_types.direntry(* a directory *)
  | File of Slave_types.direntry     (* a file inc. special files *)
  | RegKey of Hivex.node             (* a registry key (like a dir) *)
  | RegValue of Hivex.value          (* a registry value (like a file) *)

(* Source, root key, remote filename, cache filename *)
and registry_t = Slave_types.source * string * string * string

let source_of_registry_t (src, _, _, _) = src
let root_key_of_registry_t (_, root_key, _, _) = root_key

(* This is the Filetree.tree class, derived from GTree.view
 * (ie. GtkTreeView).
 *)
class tree ?packing () =
  let view = GTree.view ?packing () in
  (*view#set_rules_hint true;*)
  (*view#selection#set_mode `MULTIPLE; -- add this later *)

  (* Hash of index numbers -> hdata.  We do this because it's more
   * efficient for the GC compared to storing OCaml objects directly in
   * the rows.
   *)
  let hash = Hashtbl.create 1023 in

  (* The columns stored in each row.  The hidden [index_col] column is
   * an index into the hash table that records everything else about
   * this row (see hdata above).  The other display columns, eg.
   * [name_col] contain Pango markup and thus have to be escaped.
   *)
  let cols = new GTree.column_list in
  (* Hidden: *)
  let index_col = cols#add Gobject.Data.int in
  (* Displayed: *)
  let mode_col = cols#add Gobject.Data.string in
  let name_col = cols#add Gobject.Data.string in
  let size_col = cols#add Gobject.Data.string in
  let date_col = cols#add Gobject.Data.string in

  (* Create the model. *)
  let model = GTree.tree_store cols in

  (* Signals. *)
  let clear_tree = new GUtil.signal () in
  let op_checksum_file = new GUtil.signal () in
  let op_copy_regvalue = new GUtil.signal () in
  let op_disk_usage = new GUtil.signal () in
  let op_download_as_reg = new GUtil.signal () in
  let op_download_dir_find0 = new GUtil.signal () in
  let op_download_dir_tarball = new GUtil.signal () in
  let op_download_file = new GUtil.signal () in
  let op_file_information = new GUtil.signal () in
  let op_file_properties = new GUtil.signal () in
  let op_inspection_dialog = new GUtil.signal () in
  let op_view_file = new GUtil.signal () in

object (self)
  inherit GTree.view view#as_tree_view
  inherit GUtil.ml_signals [clear_tree#disconnect;
                            op_checksum_file#disconnect;
                            op_copy_regvalue#disconnect;
                            op_disk_usage#disconnect;
                            op_download_as_reg#disconnect;
                            op_download_dir_find0#disconnect;
                            op_download_dir_tarball#disconnect;
                            op_download_file#disconnect;
                            op_file_information#disconnect;
                            op_file_properties#disconnect;
                            op_inspection_dialog#disconnect;
                            op_view_file#disconnect]

  (* Signals. *)
  method clear_tree : callback:(unit -> unit) -> GtkSignal.id =
    clear_tree#connect ~after
  method op_checksum_file = op_checksum_file#connect ~after
  method op_copy_regvalue = op_copy_regvalue#connect ~after
  method op_disk_usage = op_disk_usage#connect ~after
  method op_download_as_reg = op_download_as_reg#connect ~after
  method op_download_dir_find0 = op_download_dir_find0#connect ~after
  method op_download_dir_tarball = op_download_dir_tarball#connect ~after
  method op_download_file = op_download_file#connect ~after
  method op_file_information = op_file_information#connect ~after
  method op_file_properties = op_file_properties#connect ~after
  method op_inspection_dialog = op_inspection_dialog#connect ~after
  method op_view_file = op_view_file#connect ~after

  initializer
    (* Open a context menu when a button is pressed. *)
    ignore (view#event#connect#button_press ~callback:self#button_press);

    (* Create the view. *)
    view#set_model (Some (model :> GTree.model));

    (* Cell renderers. *)
    let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
    let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
    mode_view#set_resizable true;
    ignore (view#append_column mode_view);

    let renderer = GTree.cell_renderer_text [], ["markup", name_col] in
    let name_view = GTree.view_column ~title:"Filename" ~renderer () in
    name_view#set_resizable true;
    name_view#set_sizing `AUTOSIZE;
    ignore (view#append_column name_view);

    let renderer =
      GTree.cell_renderer_text [`XALIGN 1.], ["markup", size_col] in
    let size_view = GTree.view_column ~title:"Size" ~renderer () in
    size_view#set_resizable true;
    ignore (view#append_column size_view);

    let renderer =
      GTree.cell_renderer_text [`XALIGN 1.], ["markup", date_col] in
    let date_view = GTree.view_column ~title:"Date" ~renderer () in
    date_view#set_resizable true;
    ignore (view#append_column date_view)

  method clear () : unit =
    model#clear ();
    Hashtbl.clear hash;
    clear_tree#call ()

  method add_os name data : unit =
    self#clear ();

    (* Populate the top level of the filetree.  If there are operating
     * systems from inspection, these have their own top level entries
     * followed by only unreferenced filesystems.  If we didn't get
     * anything from inspection, then at the top level we just show
     * filesystems.
     *)
    let other_filesystems =
      DeviceSet.of_list (List.map fst data.insp_all_filesystems) in
    let other_filesystems =
      List.fold_left (fun set { insp_filesystems = fses } ->
                        DeviceSet.subtract set (DeviceSet.of_array fses))
        other_filesystems data.insp_oses in

    (* Add top level operating systems. *)
    List.iter (self#add_top_level_os name) data.insp_oses;

    (* Add top level left-over filesystems. *)
    DeviceSet.iter (self#add_top_level_vol name) other_filesystems;

    (* If it's Windows and registry files exist, create a node for
     * each file.
     *)
    List.iter (
      fun os ->
        (match os.insp_winreg_SAM with
         | Some filename ->
             self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SAM"
               filename
         | None -> ()
        );
        (match os.insp_winreg_SECURITY with
         | Some filename ->
             self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SECURITY"
               filename
         | None -> ()
        );
        (match os.insp_winreg_SOFTWARE with
         | Some filename ->
             self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
               filename
         | None -> ()
        );
        (match os.insp_winreg_SYSTEM with
         | Some filename ->
             self#add_top_level_winreg name os "HKEY_LOCAL_MACHINE\\SYSTEM"
               filename
         | None -> ()
        );
        (match os.insp_winreg_DEFAULT with
         | Some filename ->
             self#add_top_level_winreg name os "HKEY_USERS\\.DEFAULT" filename
         | None -> ()
        );
    ) data.insp_oses;

    (* Expand the first top level node. *)
    match model#get_iter_first with
    | None -> ()
    | Some row ->
        self#expand_row (model#get_path row)

  (* Add a top level operating system node. *)
  method private add_top_level_os name os =
    let markup =
      sprintf "<b>%s</b>\n<small>%s</small>\n<small>%s</small>"
        (markup_escape name) (markup_escape os.insp_hostname)
        (markup_escape os.insp_product_name) in

    let row = model#append () in
    self#make_node row (Top (OS os)) None;
    model#set ~row ~column:name_col markup

  (* Add a top level volume (left over filesystem) node. *)
  method private add_top_level_vol name dev =
    let markup =
      sprintf "<b>%s</b>\n<small>from %s</small>"
        (markup_escape dev) (markup_escape name) in

    let row = model#append () in
    self#make_node row (Top (Volume dev)) None;
    model#set ~row ~column:name_col markup

  (* Add a top level Windows Registry node. *)
  method private add_top_level_winreg name os rootkey remotefile =
    let cachefile = tmpdir // string_of_int (unique ()) ^ ".hive" in

    let markup =
      sprintf "<b>%s</b>\n<small>from %s</small>"
        (markup_escape rootkey) (markup_escape name) in

    let row = model#append () in
    self#make_node row
      (TopWinReg (OS os, rootkey, remotefile, cachefile)) None;
    model#set ~row ~column:name_col markup

  (* Generic function to make an openable node to the tree. *)
  method private make_node row content hiveh =
    let hdata =
      { state=NodeNotStarted; content=content; visited=false; hiveh=hiveh } in
    self#store_hdata row hdata;

    (* Create a placeholder "loading ..." row underneath this node so
     * the user has something to expand.
     *)
    let placeholder = model#append ~parent:row () in
    let hdata = { state=IsLeaf; content=Loading; visited=false; hiveh=None } in
    self#store_hdata placeholder hdata;
    model#set ~row:placeholder ~column:name_col "<i>Loading ...</i>";
    ignore (self#connect#row_expanded ~callback:self#user_expand_row)

  method private make_leaf row content hiveh =
    let hdata = { state=IsLeaf; content=content; visited=false; hiveh=hiveh } in
    self#store_hdata row hdata

  (* This is called when the user expands a row. *)
  method private user_expand_row row _ =
    match self#get_hdata row with
    | { state=NodeNotStarted; content=Top src } as hdata ->
        (* User has opened a top level node that was not previously opened. *)

        (* Mark this row as loading, so we don't try to open it again. *)
        hdata.state <- NodeLoading;

        (* Get a stable path for this row. *)
        let path = model#get_path row in

        Slave.read_directory ~fail:(self#when_read_directory_fail path)
          src "/" (self#when_read_directory path)

    | { state=NodeNotStarted; content=Directory direntry } as hdata ->
        (* User has opened a filesystem directory not previously opened. *)

        (* Mark this row as loading. *)
        hdata.state <- NodeLoading;

        (* Get a stable path for this row. *)
        let path = model#get_path row in

        let src, pathname = self#get_pathname row in

        Slave.read_directory ~fail:(self#when_read_directory_fail path)
          src pathname (self#when_read_directory path)

    | { state=NodeNotStarted;
        content=TopWinReg topdata } as hdata ->
        (* User has opened a Windows Registry top level node
         * not previously opened.
         *)

        (* Mark this row as loading. *)
        hdata.state <- NodeLoading;

        (* Get a stable path for this row. *)
        let path = model#get_path row in

        (* Since the user has opened this top level registry node for the
         * first time, we now need to download the hive.
         *)
        self#get_registry_file ~fail:(self#when_downloaded_registry_fail path)
          path topdata (self#when_downloaded_registry path)

    | { state=NodeNotStarted; content=RegKey node } as hdata ->
        (* User has opened a Windows Registry key node not previously opened. *)

        (* Mark this row as loading. *)
        hdata.state <- NodeLoading;

        self#expand_hive_node row node

    (* Ignore when a user opens a node which is loading or has been loaded. *)
    | { state=(NodeLoading|IsNode) } -> ()

    (* In some circumstances these can be nodes, eg. if we have added Info
     * nodes below them.  Just ignore them if opened.
     *)
    | { content=(File _ | RegValue _) } | { state=IsLeaf } -> ()

    (* Node should not exist in the tree. *)
    | { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
        assert false

  (* This is the callback when the slave has read the directory for us. *)
  method private when_read_directory path entries =
    debug "when_read_directory";

    let row = model#get_iter path in

    (* Sort the entries by lexicographic ordering. *)
    let cmp { dent_name = n1 } { dent_name = n2 } =
      UTF8.compare n1 n2
    in
    let entries = List.sort ~cmp entries in

    (* Add the entries. *)
    List.iter (
      fun direntry ->
        let { dent_name = name; dent_stat = stat; dent_link = link } =
          direntry in
        let row = model#append ~parent:row () in
        if is_directory stat.G.mode then
          self#make_node row (Directory direntry) None
        else
          self#make_leaf row (File direntry) None;
        model#set ~row ~column:name_col (markup_of_name direntry);
        model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
        model#set ~row ~column:size_col (markup_of_size stat.G.size);
        model#set ~row ~column:date_col (markup_of_date stat.G.mtime);
    ) entries;

    (* Remove the placeholder "Loading" entry.  NB. Must be done AFTER
     * adding the other entries, or else Gtk will unexpand the row.
     *)
    (try
       let row = self#find_child_node_by_content row Loading in
       ignore (model#remove row)
     with Invalid_argument _ | Not_found -> ()
    );

    (* The original directory entry has now been loaded, so
     * update its state.
     *)
    let hdata = self#get_hdata row in
    hdata.state <- IsNode;
    self#set_visited row

  (* This is called instead of when_read_directory when the read directory
   * (or mount etc) failed.  Convert the "Loading" entry into the
   * error message.
   *)
  method private when_read_directory_fail path exn =
    debug "when_read_directory_fail: %s" (Printexc.to_string exn);

    match exn with
    | G.Error msg ->
        let row = model#get_iter path in
        let row = model#iter_children ~nth:0 (Some row) in

        let hdata =
          { state=IsLeaf; content=ErrorMessage msg;
            visited=false; hiveh=None } in
        self#store_hdata row hdata;

        model#set ~row ~column:name_col (markup_escape msg)

    | exn ->
        (* unexpected exception: re-raise it *)
        raise exn

  (* Called when the top level registry node has been opened and the
   * hive file was downloaded to the cache file successfully.
   *)
  method private when_downloaded_registry path _ =
    debug "when_downloaded_registry";
    let row = model#get_iter path in
    let hdata = self#get_hdata row in
    let h = Option.get hdata.hiveh in

    (* Continue as if expanding any other hive node. *)
    let root = Hivex.root h in
    self#expand_hive_node row root

  (* Called instead of {!when_downloaded_registry} if the download failed. *)
  method private when_downloaded_registry_fail path exn =
    debug "when_downloaded_registry_fail: %s" (Printexc.to_string exn);

    match exn with
    | G.Error msg
    | Hivex.Error (_, _, msg) ->
        let row = model#get_iter path in
        let row = model#iter_children ~nth:0 (Some row) in

        let hdata =
          { state=IsLeaf; content=ErrorMessage msg;
            visited=false; hiveh=None } in
        self#store_hdata row hdata;

        model#set ~row ~column:name_col (markup_escape msg)

    | exn ->
        (* unexpected exception: re-raise it *)
        raise exn

  (* Expand a hive node. *)
  method private expand_hive_node row node =
    debug "expand_hive_node";
    let hdata = self#get_hdata row in
    let h = Option.get hdata.hiveh in

    (* Read the hive entries (values, subkeys) at this node and add them
     * to the tree.
     *)
    let values = Hivex.node_values h node in
    let cmp v1 v2 =
      UTF8.compare (Hivex.value_key h v1) (Hivex.value_key h v2)
    in
    Array.sort cmp values;
    Array.iter (
      fun value ->
        let row = model#append ~parent:row () in
        self#make_leaf row (RegValue value) (Some h);
        model#set ~row ~column:name_col (markup_of_regvalue h value);
        model#set ~row ~column:size_col (markup_of_regvaluesize h value);
        model#set ~row ~column:date_col (markup_of_regvaluetype h value);
    ) values;

    let children = Hivex.node_children h node in
    let cmp n1 n2 =
      UTF8.compare (Hivex.node_name h n1) (Hivex.node_name h n2)
    in
    Array.sort cmp children;
    Array.iter (
      fun node ->
        let row = model#append ~parent:row () in
        self#make_node row (RegKey node) (Some h);
        model#set ~row ~column:name_col (markup_of_regkey h node);
    ) children;

    (* Remove the placeholder "Loading" entry.  NB. Must be done AFTER
     * adding the other entries, or else Gtk will unexpand the row.
     *)
    (try
       let row = self#find_child_node_by_content row Loading in
       ignore (model#remove row)
     with Invalid_argument _ | Not_found -> ()
    );

    (* The original entry has now been loaded, so update its state. *)
    hdata.state <- IsNode;
    self#set_visited row

  (* Return os(es) in the tree, if any.  The root directory of the
   * tree looks like this:
   *
   *  \ Top (OS ...)   # usually only one, but there can be zero or > 1
   *  \ Top (OS ...)
   *  \ Top (Volume ...)
   *  \ TopWinReg
   *  \ TopWinReg
   *
   * This returns only the Top (OS ...) entries.  See also #add_top_level_os
   * method.
   *)
  method oses =
    match model#get_iter_first with
    | None -> []
    | Some row ->
        let rec loop acc =
          let acc =
            match (self#get_hdata row).content with
            | Top (OS os) -> os :: acc
            | _ -> acc in
          if model#iter_next row then
            loop acc
          else
            List.rev acc
        in
        loop []

  (* Handle mouse button press on the selected row.  This opens the
   * pop-up context menu.
   * http://scentric.net/tutorial/sec-selections-context-menus.html
   *)
  method private button_press ev =
    let button = GdkEvent.Button.button ev in
    let x = int_of_float (GdkEvent.Button.x ev) in
    let y = int_of_float (GdkEvent.Button.y ev) in
    let time = GdkEvent.Button.time ev in

    (* Right button for opening the context menu. *)
    if button = 3 then (
(*
    (* If no row is selected, select the row under the mouse. *)
    let paths =
      let sel = view#selection in
      if sel#count_selected_rows < 1 then (
        match view#get_path_at_pos ~x ~y with
        | None -> []
        | Some (path, _, _, _) ->
            sel#unselect_all ();
            sel#select_path path;
            [path]
      ) else
        sel#get_selected_rows (* actually returns paths *) in
*)
      (* Select the row under the mouse. *)
      let paths =
        let sel = view#selection in
        match view#get_path_at_pos ~x ~y with
        | None -> []
        | Some (path, _, _, _) ->
            sel#unselect_all ();
            sel#select_path path;
            [path] in

      (* Get the hdata for all the paths.  Filter out rows that it doesn't
       * make sense to select.
       *)
      let paths =
        List.filter_map (
          fun path ->
            let row = model#get_iter path in
            let hdata = self#get_hdata row in
            match hdata with
            | { content=(Loading | ErrorMessage _ | Info _) } -> None
            | { content=(Top _ | Directory _ | File _ |
                             TopWinReg _ | RegKey _ | RegValue _ ) } ->
                Some (path, hdata)
        ) paths in

      (* Based on number of selected rows and what is selected, construct
       * the context menu.
       *)
      (match self#make_context_menu paths with
       | Some menu -> menu#popup ~button ~time
       | None -> ()
      );

      (* Return true so no other handler will run. *)
      true
    )
    (* We didn't handle this, defer to other handlers. *)
    else false

  method private make_context_menu paths =
    let menu = GMenu.menu () in
    let factory = new GMenu.factory menu in

    let rec add_file_items path =
      let item = factory#add_item "View ..." in
      (match Config.opener with
       | Some opener ->
           ignore (item#connect#activate
                     ~callback:(fun () -> op_view_file#call (path, opener)));
       | None ->
           item#misc#set_sensitive false
      );
      let item = factory#add_item "File information" in
      ignore (item#connect#activate
                ~callback:(fun () -> op_file_information#call path));
      let item = factory#add_item "MD5 checksum" in
      ignore (item#connect#activate
                ~callback:(fun () -> op_checksum_file#call (path, "md5")));
      let item = factory#add_item "SHA1 checksum" in
      ignore (item#connect#activate
                ~callback:(fun () -> op_checksum_file#call (path, "sha1")));
      ignore (factory#add_separator ());
      let item = factory#add_item "Download ..." in
      ignore (item#connect#activate
                ~callback:(fun () -> op_download_file#call path));
      ignore (factory#add_separator ());
      let item = factory#add_item "Properties ..." in
      ignore (item#connect#activate
                ~callback:(fun () -> op_file_properties#call path))

    and add_directory_items path =
      let item = factory#add_item "Directory information" in
      item#misc#set_sensitive false;
      let item = factory#add_item "Calculate disk usage" in
      ignore (item#connect#activate
                ~callback:(fun () -> op_disk_usage#call path));
      ignore (factory#add_separator ());
      let item = factory#add_item "Download ..." in
      item#misc#set_sensitive false;
      let item = factory#add_item "Download as .tar ..." in
      ignore (item#connect#activate
                ~callback:(fun () -> op_download_dir_tarball#call (Tar, path)));
      let item = factory#add_item "Download as .tar.gz ..." in
      ignore (item#connect#activate
                ~callback:(fun () -> op_download_dir_tarball#call (TGZ, path)));
      let item = factory#add_item "Download as .tar.xz ..." in
      ignore (item#connect#activate
                ~callback:(fun () -> op_download_dir_tarball#call (TXZ, path)));
      let item = factory#add_item "Download list of filenames ..." in
      ignore (item#connect#activate
                ~callback:(fun () -> op_download_dir_find0#call path));
      ignore (factory#add_separator ());
      let item = factory#add_item "Properties ..." in
      ignore (item#connect#activate
                ~callback:(fun () -> op_file_properties#call path))

    and add_top_os_items os path =
      let item = factory#add_item "Operating system information ..." in
      ignore (item#connect#activate
                ~callback:(fun () -> op_inspection_dialog#call os));
      ignore (factory#add_separator ());
      add_top_volume_items path

    and add_top_volume_items path =
      let item = factory#add_item "Filesystem used & free" in
      item#misc#set_sensitive false;
      let item = factory#add_item "Block device information" in
      item#misc#set_sensitive false;
      ignore (factory#add_separator ());
      add_directory_items path

    and add_topwinreg_items path =
      let item = factory#add_item "Download hive file ..." in
      item#misc#set_sensitive false;
      ignore (factory#add_separator ());
      add_regkey_items path

    and add_regkey_items path =
      let item = factory#add_item "Download as .reg file ..." in
      (match Config.hivexregedit with
       | Some hivexregedit ->
           ignore (item#connect#activate
                     ~callback:(fun () ->
                                op_download_as_reg#call (path, hivexregedit)));
       | None ->
           item#misc#set_sensitive false
      )

    and add_regvalue_items path =
      let item = factory#add_item "Copy value to clipboard" in
      ignore (item#connect#activate
                ~callback:(fun () -> op_copy_regvalue#call path));

    in

    let has_menu =
      match paths with
      | [] -> false

      (* single selection *)
      | [path, { content=Top (OS os)} ] ->  (* top level operating system *)
          add_top_os_items os path; true

      | [path, { content=Top (Volume dev) }] -> (* top level volume *)
          add_top_volume_items path; true

      | [path, { content=Directory _ }] -> (* directory *)
          add_directory_items path; true

      | [path, { content=File _ }] ->      (* file *)
          add_file_items path; true

      | [path, { content=TopWinReg _ }] -> (* top level registry node *)
          add_topwinreg_items path; true

      | [path, { content=RegKey _ }] ->    (* registry node *)
          add_regkey_items path; true

      | [path, { content=RegValue _ }] ->  (* registry key/value pair *)
          add_regvalue_items path; true

      | [_, { content=(Loading|ErrorMessage _|Info _) }] -> false

      | _::_::_ ->
          (* At the moment multiple selection is disabled.  When/if we
           * enable it we should do something intelligent here. XXX
           *)
          false in
    if has_menu then Some menu else None

  (* Store hdata into a row. *)
  method private store_hdata row hdata =
    let index = unique () in
    Hashtbl.add hash index hdata;
    model#set ~row ~column:index_col index

  (* Retrieve previously stored hdata from a row. *)
  method private get_hdata row =
    let index = model#get ~row ~column:index_col in
    try Hashtbl.find hash index
    with Not_found -> assert false

  (* [find_child_node_by_content row content] searches the direct
     children of [row] looking for one which exactly matches
     [hdata.content] and returns that child.  If no child found,
     raises [Not_found]. *)
  method private find_child_node_by_content row c =
    let rec loop row =
      if (self#get_hdata row).content = c then
        row
      else if model#iter_next row then
        loop row
      else
        raise Not_found
    in

    if not (model#iter_has_child row) then
      raise Not_found;

    let first_child = model#iter_children (Some row) in
    loop first_child

  (* Search up to the top of the tree so we know if this directory
   * comes from an OS or a volume, and the full path to here.
   *
   * The path up the tree will always look something like:
   *     Top
   *       \_ Directory
   *            \_ Directory
   *                 \_ Loading    <--- you are here
   *
   * Note this function cannot be called on registry keys.  See
   * {!get_registry_path} for that.
   *)
  method get_pathname row =
    let hdata = self#get_hdata row in
    let parent = model#iter_parent row in

    match hdata, parent with
    | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
        self#get_pathname parent
    | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
        assert false
    | { content=Directory { dent_name = name }}, Some parent
    | { content=File { dent_name = name }}, Some parent ->
        let src, parent_name = self#get_pathname parent in
        let path =
          if parent_name = "/" then "/" ^ name
          else parent_name ^ "/" ^ name in
        src, path
    | { content=Top src }, _ -> src, "/"
    | { content=Directory _ }, None -> assert false
    | { content=File _ }, None -> assert false
    | { content=Loading }, _ -> assert false
    | { content=ErrorMessage _ }, _ -> assert false
    | { content=Info _ }, _ -> assert false
    | { content=TopWinReg _ }, _ -> assert false
    | { content=RegKey _ }, _ -> assert false
    | { content=RegValue _ }, _ -> assert false

  method get_direntry row =
    let hdata = self#get_hdata row in
    match hdata with
    | { content=Directory direntry}
    | { content=File direntry}      -> direntry
    | _ -> assert false

  (* Search up to the top of the tree from a registry key.
   *
   * The path up the tree will always look something like:
   *     TopWinReg
   *       \_ RegKey
   *            \_ RegKey          <--- you are here
   *                 \_ Loading    <--- or here
   *
   * Note this function cannot be called on ordinary paths.  Use
   * {!get_pathname} for that.
   *)
  method get_registry_path row =
    let hdata = self#get_hdata row in
    let parent = model#iter_parent row in

    match hdata, parent with
    | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
        self#get_registry_path parent
    | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
        assert false
    | { content=RegKey node; hiveh = Some h }, Some parent ->
        let top, path = self#get_registry_path parent in
        let path = Hivex.node_name h node :: path in
        top, path
    | { content=TopWinReg (a,b,c,d) }, None -> (a,b,c,d), []
    | { content=TopWinReg _ }, _ -> assert false
    | { content=RegKey _}, _ -> assert false
    | { content=Top _ }, _ -> assert false
    | { content=Directory _ }, _ -> assert false
    | { content=File _ }, _ -> assert false
    | { content=Loading }, _ -> assert false
    | { content=ErrorMessage _ }, _ -> assert false
    | { content=Info _ }, _ -> assert false
    | { content=RegValue _ }, _ -> assert false

  method get_registry_value row =
    let hdata = self#get_hdata row in
    match hdata with
    | { content=RegValue value; hiveh = Some h } ->
        Hivex.value_value h value
    | _ -> assert false (* not a registry value *)

  (* This is called whenever we need the registry cache file and we
     can't be sure that it has already been downloaded. *)
  method get_registry_file ?fail path (src, _, remotefile, cachefile) cb =
    let row = model#get_iter path in
    let top =
      let rec loop row =
        match model#iter_parent row with
        | None -> row
        | Some parent -> loop parent
      in
      loop row in

    Slave.download_file_if_not_exist ?fail src remotefile cachefile
      (self#when_got_registry_file ?fail top cb)

  method private when_got_registry_file ?fail top cb () =
    debug "when_got_registry_file";
    let hdata = self#get_hdata top in

    match hdata with
    | { hiveh=Some _; content=TopWinReg (_, _, _, cachefile) } ->
        (* Hive handle already opened. *)
        cb cachefile

    | { hiveh=None; content=TopWinReg (src, rootkey, remotefile, cachefile) } ->
        (* Hive handle not opened, open it and save it in the handle. *)
        (try
           let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
           let h = Hivex.open_file cachefile flags in
           hdata.hiveh <- Some h;
           cb cachefile
         with
           Hivex.Error _ as exn ->
             match fail with
             | Some fail -> fail exn
             | None -> raise exn
        )

    | _ -> assert false

  (* This is a bit of a hack.  Ideally just setting 'visited' would
   * darken the colour when the cell was re-rendered.  However that would
   * mean we couldn't store other stuff in the name column.  Therefore,
   * repopulate the name column.
   *)
  method set_visited row =
    let hdata = self#get_hdata row in
    if hdata.visited = false then (
      hdata.visited <- true;
      match hdata.content with
      | Directory direntry | File direntry ->
          debug "set_visited %s" direntry.dent_name;
          model#set ~row ~column:name_col
            (markup_of_name ~visited:true direntry)
      | RegKey node ->
          debug "set_visited RegKey";
          let h = Option.get hdata.hiveh in
          model#set ~row ~column:name_col
            (markup_of_regkey ~visited:true h node)
      | RegValue value ->
          debug "set_visited RegValue";
          let h = Option.get hdata.hiveh in
          model#set ~row ~column:name_col
            (markup_of_regvalue ~visited:true h value)
      | Loading | ErrorMessage _ | Info _ | Top _ | TopWinReg _ -> ()
    )

  method has_child_info_node path info_text =
    let row = model#get_iter path in
    let content = Info info_text in
    try ignore (self#find_child_node_by_content row content); true
    with Not_found -> false

  method set_child_info_node path info_text text =
    self#expand_row path;
    let row = model#get_iter path in
    let content = Info info_text in
    let row =
      try self#find_child_node_by_content row content
      with Not_found -> model#insert ~parent:row 0 in
    let hdata = { state=IsLeaf; content=content; visited=false; hiveh=None } in
    self#store_hdata row hdata;
    model#set ~row ~column:name_col text

end