X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=filetree.ml;h=a007d975c0492a43d222ff57164007f15b559b47;hb=3ab788383673a8300925a7de6113ef3962378a15;hp=1969cc76939db8fd76a99269754a4e407193f9bb;hpb=b07102fda0034da5840a9f33bd6d404a195b8cc9;p=guestfs-browser.git

diff --git a/filetree.ml b/filetree.ml
index 1969cc7..a007d97 100644
--- a/filetree.ml
+++ b/filetree.ml
@@ -16,293 +16,96 @@
  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  *)
 
-open ExtList
 open ExtString
+open ExtList
+open Unix
 open Printf
 
 open Utils
+open DeviceSet
+
+open Filetree_type
+open Filetree_markup
+open Filetree_ops
 
 module G = Guestfs
 
-let unique = let i = ref 0 in fun () -> incr i; !i
+type t = Filetree_type.t
 
-(* The type of the hidden column used to implement on-demand loading.
- * We are going to store these in the model as simple ints because that
- * is easier on the GC.  Don't change these numbers!
+(* Temporary directory for shared use by all instances of this widget,
+ * cleaned up when the program exits.
  *)
-let isFile = 0           (* it's not a directory, there are no children *)
-let dirNotStarted = 1    (* user has not tried to open this *)
-let dirLoading = 2       (* user tried to open it, still loading *)
-let isDir = 3            (* we've loaded the children of this directory *)
-let loading = 4          (* this row contains the "Loading ..." message *)
-
-let rec filetree dev rw =
-  let view = GTree.view () in
+let tmpdir = tmpdir ()
+
+let rec create ~packing () =
+  let view = GTree.view ~packing () in
   (*view#set_rules_hint true;*)
-  view#selection#set_mode `MULTIPLE;
+  (*view#selection#set_mode `MULTIPLE; -- add this later *)
 
-  (* Hash of index numbers -> other data.  We do this because it's
-   * more efficient for the GC compared to storing OCaml objects
-   * directly in the rows.
+  (* 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 [state_col] column
-   * stores the current state of the row, and is used to implement
-   * on-demand loading.  The hidden [index_col] column is an index into
-   * the hash table that records everything else about this row
-   * (filename, file stat, etc).  The other display columns, eg.
+  (* 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 state_col = cols#add Gobject.Data.int in
   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.int64 in
+  let size_col = cols#add Gobject.Data.string in
   let date_col = cols#add Gobject.Data.string in
-  let link_col = cols#add Gobject.Data.string in
 
+  (* Create the model. *)
   let model = GTree.tree_store cols in
+
+  (* Create the view. *)
   view#set_model (Some (model :> GTree.model));
 
   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 [], ["text", size_col] in
+  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 [], ["markup", date_col] in
+  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);
 
-  let renderer = GTree.cell_renderer_text [], ["markup", link_col] in
-  let link_view = GTree.view_column ~title:"Link" ~renderer () in
-  ignore (view#append_column link_view);
-
-  let tree =
-    model, view, hash, dev, rw,
-    (state_col, index_col, mode_col, name_col, size_col, date_col,
-     link_col) in
-
-  (* Create the root directory entry, then expand it which will force
-   * it to be loaded (asynchronously).
-   * XXX Should stat "/"
-   *)
-  let root = model#append () in
-  add_directory_row tree root "/" None;
-  view#expand_row (model#get_path root);
-
-  ignore (view#event#connect#button_press ~callback:(button_press tree));
-  (*ignore (view#event#connect#popup_menu ~callback);*)
+  let t = {
+    view = view; model = model; hash = hash;
+    index_col = index_col;
+    mode_col = mode_col; name_col = name_col; size_col = size_col;
+    date_col = date_col;
+  } in
 
-  view
+  (* Open a context menu when a button is pressed. *)
+  ignore (view#event#connect#button_press ~callback:(button_press t));
 
-(* Add an "embryonic" directory to the tree store.  This contains a
- * dummy entry (as explained
- * http://mail.gnome.org/archives/gtk-app-devel-list/2003-May/msg00241.html)
- * and when the user opens it, it triggers the real directory to be
- * read.
- *)
-and add_directory_row tree row filename direntry =
-  let model, view, hash, _, _,
-    (state_col, index_col, mode_col, name_col, size_col, date_col,
-     link_col)
-    = tree in
-
-  model#set ~row ~column:state_col dirNotStarted;
-  model#set ~row ~column:index_col (-1);
-  model#set ~row ~column:name_col (markup_of_name filename);
-  (match direntry with
-   | None -> ()
-   | Some direntry ->
-       let index = unique () in
-       Hashtbl.add hash index direntry;
-       model#set ~row ~column:index_col index;
-       let stat = direntry.Slave.dent_stat in
-       model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
-       model#set ~row ~column:size_col stat.G.size;
-       model#set ~row ~column:date_col (markup_of_date stat.G.mtime));
-
-  let placeholder = model#append ~parent:row () in
-  model#set ~row:placeholder ~column:state_col loading;
-  model#set ~row:placeholder ~column:index_col (-1);
-  model#set ~row:placeholder ~column:name_col "<i>Loading ...</i>";
-  ignore (view#connect#row_expanded ~callback:(expand_row tree))
-
-(* This is called when the user expands the [directory] row. *)
-and expand_row tree row _ =
-  let model, _, _, dev, _, (state_col, _, _, _, _, _, _) = tree in
-
-  match model#get ~row ~column:state_col with
-  | 1 (* dirNotStarted *) -> (* Kick off a directory read. *)
-      (* Get a stable path for this row so we can use it inside
-       * the callback, which may happen a lot later.
-       *)
-      let path = model#get_path row in
-
-      (* Now invoke libguestfs in the slave thread. *)
-      Slave.read_directory
-        dev (get_pathname tree row) (read_directory_cb tree path);
-
-      (* Mark this row as now loading, so we don't start another
-       * directory read if the user expands it again.
-       *)
-      model#set ~row ~column:state_col dirLoading
-
-  | 0 (* isFile *) | 2 (* dirLoading *) | 3 (* isDir *) -> ()
-  | 4 (* loading *) -> assert false
-  | _ -> assert false
-
-and read_directory_cb tree path entries =
-  let model, _, hash, _, _,
-    (state_col, index_col, mode_col, name_col, size_col, date_col,
-     link_col)
-    = tree in
-
-  let row = model#get_iter path in
-
-  (* Add the entries. *)
-  List.iter (
-    fun direntry ->
-      let { Slave.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
-        add_directory_row tree row name (Some direntry)
-      else (
-        let index = unique () in
-        Hashtbl.add hash index direntry;
-        model#set ~row ~column:state_col isFile;
-        model#set ~row ~column:index_col index;
-        model#set ~row ~column:name_col (markup_of_name name);
-        model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
-        model#set ~row ~column:size_col stat.G.size;
-        model#set ~row ~column:date_col (markup_of_date stat.G.mtime);
-        model#set ~row ~column:link_col (markup_of_link link)
-      )
-  ) entries;
-
-  (* Remove the placeholder entry.  NB. Must be done AFTER adding
-   * the other entries, or else Gtk will unexpand the row.
-   *)
-  (try
-     let placeholder = model#iter_children ~nth:0 (Some row) in
-     ignore (model#remove placeholder)
-   with Invalid_argument _ -> ());
-
-  (* The original directory entry has now been loaded, so
-   * update its state.
-   *)
-  model#set ~row ~column:state_col isDir
-
-(* Get the actual full pathname of a row. *)
-and get_pathname tree row =
-  let model, _, _, _, _, _ = tree in
-
-  match model#iter_parent row with
-  | None -> "/"
-  | Some parent ->
-      match get_direntry_of_row tree row with
-      | Some { Slave.dent_name = name } ->
-          let pname = get_pathname tree parent in
-          if pname = "/" then "/" ^ name else pname ^ "/" ^ name
-      | None ->
-          assert false
-
-(* Get the directory entry from a row (contains the stat(2) results etc).
- * Some rows don't have the required information (eg. placeholder rows
- * and currently the root directory) and for them we return [None].
- *)
-and get_direntry_of_row tree row =
-  let model, _, hash, _, _, (_, index_col, _, _, _, _, _) = tree in
-  let index = model#get ~row ~column:index_col in
-  try Some (Hashtbl.find hash index)
-  with Not_found -> None
-
-(* XXX No binding for g_markup_escape in lablgtk2. *)
-and markup_escape name =
-  let f = function
-    | '&' -> "&amp;" | '<' -> "&lt;" | '>' -> "&gt;"
-    | c -> String.make 1 c
-  in
-  String.replace_chars f name
-
-(* Mark up a filename for the name_col column. *)
-and markup_of_name name =
-  (* First, protect against any markup in the name. *)
-  let name = markup_escape name in
-  name
-
-(* Mark up symbolic links. *)
-and markup_of_link link =
-  let link = markup_escape link in
-  if link <> "" then utf8_rarrow ^ " " ^ link else ""
-
-(* Mark up mode. *)
-and markup_of_mode mode =
-  let c =
-    if is_socket mode then 's'
-    else if is_symlink mode then 'l'
-    else if is_regular_file mode then '-'
-    else if is_block mode then 'b'
-    else if is_directory mode then 'd'
-    else if is_char mode then 'c'
-    else if is_fifo mode then 'p' else '?' in
-  let ru = if test_bit 0o400L mode then 'r' else '-' in
-  let wu = if test_bit 0o200L mode then 'w' else '-' in
-  let xu = if test_bit 0o100L mode then 'x' else '-' in
-  let rg = if test_bit 0o40L mode then 'r' else '-' in
-  let wg = if test_bit 0o20L mode then 'w' else '-' in
-  let xg = if test_bit 0o10L mode then 'x' else '-' in
-  let ro = if test_bit 0o4L mode then 'r' else '-' in
-  let wo = if test_bit 0o2L mode then 'w' else '-' in
-  let xo = if test_bit 0o1L mode then 'x' else '-' in
-  let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in
-
-  let suid = test_bit 0o4000L mode in
-  let sgid = test_bit 0o2000L mode in
-  let svtx = test_bit 0o1000L mode in
-  if suid then str.[3] <- 's';
-  if sgid then str.[6] <- 's';
-  if svtx then str.[9] <- 't';
-
-  "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
-
-(* File type tests. *)
-and file_type mask mode = Int64.logand mode 0o170000L = mask
-
-and is_socket mode =       file_type 0o140000L mode
-and is_symlink mode =      file_type 0o120000L mode
-and is_regular_file mode = file_type 0o100000L mode
-and is_block mode =        file_type 0o060000L mode
-and is_directory mode =    file_type 0o040000L mode
-and is_char mode =         file_type 0o020000L mode
-and is_fifo mode =         file_type 0o010000L mode
-
-and test_bit mask mode = Int64.logand mode mask = mask
-
-(* Mark up dates. *)
-and markup_of_date time =
-  let time = Int64.to_float time in
-  let tm = Unix.localtime time in
-  sprintf "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
-    (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
-    tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
+  t
 
 (* Handle mouse button press on the selected row.  This opens the
  * pop-up context menu.
  * http://scentric.net/tutorial/sec-selections-context-menus.html
  *)
-and button_press tree ev =
+and button_press ({ model = model; view = view } as t) 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
@@ -310,8 +113,7 @@ and button_press tree ev =
 
   (* Right button for opening the context menu. *)
   if button = 3 then (
-    let model, view, hash, _, _, (_, index_col, _, _, _, _, _) = tree in
-
+(*
     (* If no row is selected, select the row under the mouse. *)
     let paths =
       let sel = view#selection in
@@ -324,119 +126,453 @@ and button_press tree ev =
             [path]
       ) else
         sel#get_selected_rows (* actually returns paths *) in
-
-    (* Ignore paths that don't contain index fields, and get the
-     * direntry for the others.  Currently this causes the root
-     * directory to be ignored because we don't have stat information
-     * for it (XXX).
+*)
+    (* 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
-          match get_direntry_of_row tree row with
-          | None -> None
-          | Some direntry -> Some (path, direntry)
+          let hdata = get_hdata t row in
+          match hdata with
+          | { content=(Loading | ErrorMessage _ | Info _) } -> None
+          | { content=(Top _ | Directory _ | File _ |
+                           TopWinReg _ | RegKey _ | RegValue _ ) } ->
+              Some (path, hdata)
       ) paths in
 
-    (* Choose the menu and menu options according to the number of
-     * selected rows and what is selected.
+    (* Based on number of selected rows and what is selected, construct
+     * the context menu.
      *)
-    let menu =
-      try
-        (match paths with
-         | [] -> None
-         | [path, direntry] ->          (* Single selection. *)
-             (* What object is selected? *)
-             let stat = direntry.Slave.dent_stat in
-             let mode = stat.G.mode in
-             if is_directory mode then
-               Some (make_context_menu tree ~dir:true ~file:false paths)
-             else if is_regular_file mode then
-               Some (make_context_menu tree ~dir:false ~file:true paths)
-             else (* not directory, not regular file *)
-               Some (make_context_menu tree ~dir:false ~file:false paths)
-         | paths ->                        (* Multiple selection. *)
-             let dir = List.for_all (
-               fun (_, { Slave.dent_stat = stat }) ->
-                 is_directory stat.G.mode
-             ) paths in
-             let file = List.for_all (
-               fun (_, { Slave.dent_stat = stat }) ->
-                 is_regular_file stat.G.mode
-             ) paths in
-             Some (make_context_menu tree ~dir ~file paths)
-        )
-      with Not_found -> None
-    in
-    (match menu with
-     | None -> ()
-     | Some menu ->
-         menu#popup ~button ~time;
+    if paths <> [] then (
+      let menu = make_context_menu t paths in
+      menu#popup ~button ~time
     );
 
     (* Return true so no other handler will run. *)
     true
-  ) else
-    (* Defer to other handlers. *)
-    false
-
-(* Make a context menu for file(s) and directory(s).  ~file is true is
- * they are all regular files, ~dir is true if they are all
- * directories.  If neither is set, then it can be a single selection
- * of a non-file non-directory, or it can be a mixed multiple
- * selection.
- *)
-and make_context_menu tree ~dir ~file paths =
-  let _, _, _, _, rw, _ = tree in
-  let n = List.length paths in
-
-  debug "make_context_menu dir %b file %b n %d" dir file n;
+  )
+  (* We didn't handle this, defer to other handlers. *)
+  else false
 
+and make_context_menu t paths =
   let menu = GMenu.menu () in
   let factory = new GMenu.factory menu in
 
-  (* Open appears first, and unconditionally.  This is just to catch
-   * the case where nothing below matches, and we want to display
-   * _something_.  Open is not necessarily useful ...
+  let item = factory#add_item "Open" in
+  item#misc#set_sensitive false;
+
+  let rec add_file_items path =
+    let item = factory#add_item "File information" in
+    item#misc#set_sensitive false;
+    let item = factory#add_item "Checksum" in
+    item#misc#set_sensitive false;
+    ignore (factory#add_separator ());
+    let item = factory#add_item "Download ..." in
+    ignore (item#connect#activate ~callback:(download_file t 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:(disk_usage t 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:(download_dir_tarball t Slave.Tar path));
+    let item = factory#add_item "Download as .tar.gz ..." in
+    ignore (item#connect#activate
+              ~callback:(download_dir_tarball t Slave.TGZ path));
+    let item = factory#add_item "Download as .tar.xz ..." in
+    ignore (item#connect#activate
+              ~callback:(download_dir_tarball t Slave.TXZ path));
+    let item = factory#add_item "Download list of filenames ..." in
+    ignore (item#connect#activate ~callback:(download_dir_find0 t path));
+
+  and add_os_items path =
+    let item = factory#add_item "Operating system information" in
+    ignore (item#connect#activate ~callback:(display_inspection_data t path));
+    ignore (factory#add_separator ());
+    add_volume_items path
+
+  and add_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
+  in
+
+  (match paths with
+   (* single selection *)
+   | [path, { content=Top (Slave.OS os)} ] ->  (* top level operating system *)
+       add_os_items path
+
+   | [path, { content=Top (Slave.Volume dev) }] -> (* top level volume *)
+       add_volume_items path
+
+   | [path, { content=Directory direntry }] ->     (* directory *)
+       add_directory_items path
+
+   | [path, { content=File direntry }] ->          (* file *)
+       add_file_items path
+
+   | [_, { content=Loading }]
+   | [_, { content=ErrorMessage _ }] -> ()
+
+   | _ ->
+       (* At the moment multiple selection is disabled.  When/if we
+        * enable it we should do something intelligent here. XXX
+        *)
+       ()
+  );
+
+  menu
+
+let clear { model = model; hash = hash } =
+  model#clear ();
+  Hashtbl.clear hash
+
+let rec add ({ model = model } as t) name data =
+  clear t;
+
+  (* 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.Slave.insp_all_filesystems) in
+  let other_filesystems =
+    List.fold_left (fun set { Slave.insp_filesystems = fses } ->
+                      DeviceSet.subtract set (DeviceSet.of_array fses))
+      other_filesystems data.Slave.insp_oses in
+
+  (* Add top level operating systems. *)
+  List.iter (add_top_level_os t name) data.Slave.insp_oses;
+
+  (* Add top level left-over filesystems. *)
+  DeviceSet.iter (add_top_level_vol t name) other_filesystems;
+
+  (* If it's Windows and registry files exist, create a node for
+   * each file.
+   *)
+  List.iter (
+    fun os ->
+      (match os.Slave.insp_winreg_SAM with
+       | Some filename ->
+           add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SAM" filename
+       | None -> ()
+      );
+      (match os.Slave.insp_winreg_SECURITY with
+       | Some filename ->
+           add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SECURITY"
+             filename
+       | None -> ()
+      );
+      (match os.Slave.insp_winreg_SOFTWARE with
+       | Some filename ->
+           add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
+             filename
+       | None -> ()
+      );
+      (match os.Slave.insp_winreg_SYSTEM with
+       | Some filename ->
+           add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SYSTEM"
+             filename
+       | None -> ()
+      );
+      (match os.Slave.insp_winreg_DEFAULT with
+       | Some filename ->
+           add_top_level_winreg t name os "HKEY_USERS\\.DEFAULT" filename
+       | None -> ()
+      );
+  ) data.Slave.insp_oses;
+
+  (* Expand the first top level node. *)
+  match model#get_iter_first with
+  | None -> ()
+  | Some row ->
+      t.view#expand_row (model#get_path row)
+
+(* Add a top level operating system node. *)
+and add_top_level_os ({ model = model } as t) name os =
+  let markup =
+    sprintf "<b>%s</b>\n<small>%s</small>\n<small>%s</small>"
+      (markup_escape name) (markup_escape os.Slave.insp_hostname)
+      (markup_escape os.Slave.insp_product_name) in
+
+  let row = model#append () in
+  make_node t row (Top (Slave.OS os)) None;
+  model#set ~row ~column:t.name_col markup
+
+(* Add a top level volume (left over filesystem) node. *)
+and add_top_level_vol ({ model = model } as t) 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
+  make_node t row (Top (Slave.Volume dev)) None;
+  model#set ~row ~column:t.name_col markup
+
+(* Add a top level Windows Registry node. *)
+and add_top_level_winreg ({ model = model } as t) 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
+  make_node t row
+    (TopWinReg (Slave.OS os, rootkey, remotefile, cachefile)) None;
+  model#set ~row ~column:t.name_col markup
+
+(* Generic function to make an openable node to the tree. *)
+and make_node ({ model = model } as t) row content hiveh =
+  let hdata =
+    { state=NodeNotStarted; content=content; visited=false; hiveh=hiveh } in
+  store_hdata t 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
+  store_hdata t placeholder hdata;
+  model#set ~row:placeholder ~column:t.name_col "<i>Loading ...</i>";
+  ignore (t.view#connect#row_expanded ~callback:(expand_row t))
+
+and make_leaf ({ model = model } as t) row content hiveh =
+  let hdata = { state=IsLeaf; content=content; visited=false; hiveh=hiveh } in
+  store_hdata t row hdata
+
+(* This is called when the user expands a row. *)
+and expand_row ({ model = model } as t) row _ =
+  match get_hdata t 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:(when_read_directory_fail t path)
+        src "/" (when_read_directory t 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 = get_pathname t row in
+
+      Slave.read_directory ~fail:(when_read_directory_fail t path)
+        src pathname (when_read_directory t path)
+
+  | { state=NodeNotStarted;
+      content=TopWinReg (src, rootkey, remotefile, cachefile) } 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.
+       *)
+      Slave.download_file ~fail:(when_downloaded_registry_fail t path)
+        src remotefile cachefile (when_downloaded_registry t 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;
+
+      expand_hive_node t row node
+
+  (* Ignore when a user opens a node which is loading or has been loaded. *)
+  | { state=(NodeLoading|IsNode) } -> ()
+
+  (* These are not nodes so it should never be possible to open them. *)
+  | { content=(File _ | RegValue _) } | { state=IsLeaf } -> assert false
+
+  (* 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. *)
+and when_read_directory ({ model = model } as t) path entries =
+  debug "when_read_directory";
+
+  let row = model#get_iter path in
+
+  (* Add the entries. *)
+  List.iter (
+    fun direntry ->
+      let { Slave.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
+        make_node t row (Directory direntry) None
+      else
+        make_leaf t row (File direntry) None;
+      model#set ~row ~column:t.name_col (markup_of_name direntry);
+      model#set ~row ~column:t.mode_col (markup_of_mode stat.G.mode);
+      model#set ~row ~column:t.size_col (markup_of_size stat.G.size);
+      model#set ~row ~column:t.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.
    *)
-  ignore (factory#add_item "Open");
-  ignore (factory#add_separator ());
-
-  if dir && n = 1 then (
-    ignore (factory#add_item "Disk usage ...");
-    ignore (factory#add_item "Export as an archive (tar etc) ...");
-    ignore (factory#add_item "Export checksums ...");
-    ignore (factory#add_item "Export as a list of files ...");
+  (try
+     let row = find_child_node_by_content t row Loading in
+     ignore (model#remove row)
+   with Invalid_argument _ | Not_found -> ()
   );
 
-  if file then
-    ignore (factory#add_item "Determine file type ...");
+  (* The original directory entry has now been loaded, so
+   * update its state.
+   *)
+  let hdata = get_hdata t row in
+  hdata.state <- IsNode;
+  set_visited t 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.
+ *)
+and when_read_directory_fail ({ model = model } as t) 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
+      store_hdata t row hdata;
 
-  if n = 1 then
-    ignore (factory#add_item "View permissions ...");
+      model#set ~row ~column:t.name_col (markup_escape msg)
 
-  (* Write operations go below the separator. *)
-  (match rw with
-   | Slave.RO -> ()
-   | Slave.RW ->
-       ignore (factory#add_separator ());
+  | exn ->
+      (* unexpected exception: re-raise it *)
+      raise exn
 
-       if dir && n = 1 then (
-         ignore (factory#add_item "New file ...");
-         ignore (factory#add_item "New subdirectory ...");
-         ignore (factory#add_item "Import an archive here ...");
-       );
+(* Called when the top level registry node has been opened and the
+ * hive file was downloaded to the cache file successfully.
+ *)
+and when_downloaded_registry ({ model = model } as t) path () =
+  debug "when_downloaded_registry";
+  let row = model#get_iter path in
+
+  let hdata = get_hdata t row in
+  match hdata.content with
+  | TopWinReg (src, rootkey, remotefile, cachefile) ->
+      (try
+         (* Open the hive and save the hive handle in the row hdata. *)
+         let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
+         let h = Hivex.open_file cachefile flags in
+         hdata.hiveh <- Some h;
+
+         (* Continue as if expanding any other hive node. *)
+         let root = Hivex.root h in
+         expand_hive_node t row root
+       with
+         Hivex.Error _ as exn -> when_downloaded_registry_fail t path exn
+      )
+  | _ -> assert false
+
+(* Called instead of {!when_downloaded_registry} if the download failed. *)
+and when_downloaded_registry_fail ({ model = model } as t) 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
+      store_hdata t row hdata;
 
-       if file then (
-         ignore (factory#add_item "Touch file");
-         ignore (factory#add_item "Edit file");
-       );
+      model#set ~row ~column:t.name_col (markup_escape msg)
 
-       if n = 1 then
-         ignore (factory#add_item "Edit permissions ...");
+  | exn ->
+      (* unexpected exception: re-raise it *)
+      raise exn
 
-       ignore (factory#add_item "Delete")
+(* Expand a hive node. *)
+and expand_hive_node ({ model = model } as t) row node =
+  debug "expand_hive_node";
+  let hdata = get_hdata t 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 = 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
+      make_leaf t row (RegValue value) (Some h);
+      model#set ~row ~column:t.name_col (markup_of_regvalue h value);
+      model#set ~row ~column:t.size_col (markup_of_regvaluesize h value);
+      model#set ~row ~column:t.date_col (markup_of_regvaluetype h value);
+  ) values;
+
+  let children = Hivex.node_children h node in
+  let cmp n1 n2 = 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
+      make_node t row (RegKey node) (Some h);
+      model#set ~row ~column:t.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 = find_child_node_by_content t row Loading in
+     ignore (model#remove row)
+   with Invalid_argument _ | Not_found -> ()
   );
 
-  menu
+  (* The original entry has now been loaded, so update its state. *)
+  hdata.state <- IsNode;
+  set_visited t row