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
  27 open Filetree_type
  28 open Filetree_markup
  29 open Filetree_ops
  30
  31 module G = Guestfs
  32
  33 type t = Filetree_type.t
  34
  35 (* Temporary directory for shared use by all instances of this widget,
  36  * cleaned up when the program exits.
  37  *)
  38 let tmpdir = tmpdir ()
  39
  40 let rec create ~packing () =
  41   let view = GTree.view ~packing () in
  42   (*view#set_rules_hint true;*)
  43   (*view#selection#set_mode `MULTIPLE; -- add this later *)
  44
  45   (* Hash of index numbers -> hdata.  We do this because it's more
  46    * efficient for the GC compared to storing OCaml objects directly in
  47    * the rows.
  48    *)
  49   let hash = Hashtbl.create 1023 in
  50
  51   (* The columns stored in each row.  The hidden [index_col] column is
  52    * an index into the hash table that records everything else about
  53    * this row (see hdata above).  The other display columns, eg.
  54    * [name_col] contain Pango markup and thus have to be escaped.
  55    *)
  56   let cols = new GTree.column_list in
  57   (* Hidden: *)
  58   let index_col = cols#add Gobject.Data.int in
  59   (* Displayed: *)
  60   let mode_col = cols#add Gobject.Data.string in
  61   let name_col = cols#add Gobject.Data.string in
  62   let size_col = cols#add Gobject.Data.string in
  63   let date_col = cols#add Gobject.Data.string in
  64
  65   (* Create the model. *)
  66   let model = GTree.tree_store cols in
  67
  68   (* Create the view. *)
  69   view#set_model (Some (model :> GTree.model));
  70
  71   let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
  72   let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
  73   mode_view#set_resizable true;
  74   ignore (view#append_column mode_view);
  75
  76   let renderer = GTree.cell_renderer_text [], ["markup", name_col] in
  77   let name_view = GTree.view_column ~title:"Filename" ~renderer () in
  78   name_view#set_resizable true;
  79   name_view#set_sizing `AUTOSIZE;
  80   ignore (view#append_column name_view);
  81
  82   let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", size_col] in
  83   let size_view = GTree.view_column ~title:"Size" ~renderer () in
  84   size_view#set_resizable true;
  85   ignore (view#append_column size_view);
  86
  87   let renderer = GTree.cell_renderer_text [`XALIGN 1.], ["markup", date_col] in
  88   let date_view = GTree.view_column ~title:"Date" ~renderer () in
  89   date_view#set_resizable true;
  90   ignore (view#append_column date_view);
  91
  92   let t = {
  93     view = view; model = model; hash = hash;
  94     index_col = index_col;
  95     mode_col = mode_col; name_col = name_col; size_col = size_col;
  96     date_col = date_col;
  97   } in
  98
  99   (* Open a context menu when a button is pressed. *)
 100   ignore (view#event#connect#button_press ~callback:(button_press t));
 101
 102   t
 103
 104 (* Handle mouse button press on the selected row.  This opens the
 105  * pop-up context menu.
 106  * http://scentric.net/tutorial/sec-selections-context-menus.html
 107  *)
 108 and button_press ({ model = model; view = view } as t) ev =
 109   let button = GdkEvent.Button.button ev in
 110   let x = int_of_float (GdkEvent.Button.x ev) in
 111   let y = int_of_float (GdkEvent.Button.y ev) in
 112   let time = GdkEvent.Button.time ev in
 113
 114   (* Right button for opening the context menu. *)
 115   if button = 3 then (
 116 (*
 117     (* If no row is selected, select the row under the mouse. *)
 118     let paths =
 119       let sel = view#selection in
 120       if sel#count_selected_rows < 1 then (
 121         match view#get_path_at_pos ~x ~y with
 122         | None -> []
 123         | Some (path, _, _, _) ->
 124             sel#unselect_all ();
 125             sel#select_path path;
 126             [path]
 127       ) else
 128         sel#get_selected_rows (* actually returns paths *) in
 129 *)
 130     (* Select the row under the mouse. *)
 131     let paths =
 132       let sel = view#selection in
 133       match view#get_path_at_pos ~x ~y with
 134       | None -> []
 135       | Some (path, _, _, _) ->
 136           sel#unselect_all ();
 137           sel#select_path path;
 138           [path] in
 139
 140     (* Get the hdata for all the paths.  Filter out rows that it doesn't
 141      * make sense to select.
 142      *)
 143     let paths =
 144       List.filter_map (
 145         fun path ->
 146           let row = model#get_iter path in
 147           let hdata = get_hdata t row in
 148           match hdata with
 149           | { content=(Loading | ErrorMessage _ | Info _) } -> None
 150           | { content=(Top _ | Directory _ | File _ |
 151                            TopWinReg _ | RegKey _ | RegValue _ ) } ->
 152               Some (path, hdata)
 153       ) paths in
 154
 155     (* Based on number of selected rows and what is selected, construct
 156      * the context menu.
 157      *)
 158     (match make_context_menu t paths with
 159      | Some menu -> menu#popup ~button ~time
 160      | None -> ()
 161     );
 162
 163     (* Return true so no other handler will run. *)
 164     true
 165   )
 166   (* We didn't handle this, defer to other handlers. *)
 167   else false
 168
 169 and make_context_menu t paths =
 170   let menu = GMenu.menu () in
 171   let factory = new GMenu.factory menu in
 172
 173   let rec add_file_items path =
 174     let item = factory#add_item "File information" in
 175     item#misc#set_sensitive false;
 176     let item = factory#add_item "Checksum" in
 177     item#misc#set_sensitive false;
 178     ignore (factory#add_separator ());
 179     let item = factory#add_item "Download ..." in
 180     ignore (item#connect#activate ~callback:(download_file t path));
 181
 182   and add_directory_items path =
 183     let item = factory#add_item "Directory information" in
 184     item#misc#set_sensitive false;
 185     let item = factory#add_item "Calculate disk usage" in
 186     ignore (item#connect#activate ~callback:(disk_usage t path));
 187     ignore (factory#add_separator ());
 188     let item = factory#add_item "Download ..." in
 189     item#misc#set_sensitive false;
 190     let item = factory#add_item "Download as .tar ..." in
 191     ignore (item#connect#activate
 192               ~callback:(download_dir_tarball t Slave.Tar path));
 193     let item = factory#add_item "Download as .tar.gz ..." in
 194     ignore (item#connect#activate
 195               ~callback:(download_dir_tarball t Slave.TGZ path));
 196     let item = factory#add_item "Download as .tar.xz ..." in
 197     ignore (item#connect#activate
 198               ~callback:(download_dir_tarball t Slave.TXZ path));
 199     let item = factory#add_item "Download list of filenames ..." in
 200     ignore (item#connect#activate ~callback:(download_dir_find0 t path));
 201
 202   and add_top_os_items path =
 203     let item = factory#add_item "Operating system information" in
 204     ignore (item#connect#activate ~callback:(display_inspection_data t path));
 205     ignore (factory#add_separator ());
 206     add_top_volume_items path
 207
 208   and add_top_volume_items path =
 209     let item = factory#add_item "Filesystem used & free" in
 210     item#misc#set_sensitive false;
 211     let item = factory#add_item "Block device information" in
 212     item#misc#set_sensitive false;
 213     ignore (factory#add_separator ());
 214     add_directory_items path
 215
 216   and add_topwinreg_items path =
 217     let item = factory#add_item "Download hive file ..." in
 218     item#misc#set_sensitive false;
 219     ignore (factory#add_separator ());
 220     add_regkey_items path
 221
 222   and add_regkey_items path =
 223     let item = factory#add_item "Download as .reg file ..." in
 224     item#misc#set_sensitive false
 225
 226   and add_regvalue_items path =
 227     let item = factory#add_item "Copy value to clipboard" in
 228     ignore (item#connect#activate ~callback:(copy_regvalue t path));
 229
 230   in
 231
 232   let has_menu =
 233     match paths with
 234     | [] -> false
 235
 236     (* single selection *)
 237     | [path, { content=Top (Slave.OS os)} ] ->  (* top level operating system *)
 238         add_top_os_items path; true
 239
 240     | [path, { content=Top (Slave.Volume dev) }] -> (* top level volume *)
 241         add_top_volume_items path; true
 242
 243     | [path, { content=Directory _ }] -> (* directory *)
 244         add_directory_items path; true
 245
 246     | [path, { content=File _ }] ->      (* file *)
 247         add_file_items path; true
 248
 249     | [path, { content=TopWinReg _ }] -> (* top level registry node *)
 250         add_topwinreg_items path; true
 251
 252     | [path, { content=RegKey _ }] ->    (* registry node *)
 253         add_regkey_items path; true
 254
 255     | [path, { content=RegValue _ }] ->  (* registry key/value pair *)
 256         add_regvalue_items path; true
 257
 258     | [_, { content=(Loading|ErrorMessage _|Info _) }] -> false
 259
 260     | _::_::_ ->
 261         (* At the moment multiple selection is disabled.  When/if we
 262          * enable it we should do something intelligent here. XXX
 263          *)
 264         false in
 265   if has_menu then Some menu else None
 266
 267 let clear { model = model; hash = hash } =
 268   model#clear ();
 269   Hashtbl.clear hash
 270
 271 let rec add ({ model = model } as t) name data =
 272   clear t;
 273
 274   (* Populate the top level of the filetree.  If there are operating
 275    * systems from inspection, these have their own top level entries
 276    * followed by only unreferenced filesystems.  If we didn't get
 277    * anything from inspection, then at the top level we just show
 278    * filesystems.
 279    *)
 280   let other_filesystems =
 281     DeviceSet.of_list (List.map fst data.Slave.insp_all_filesystems) in
 282   let other_filesystems =
 283     List.fold_left (fun set { Slave.insp_filesystems = fses } ->
 284                       DeviceSet.subtract set (DeviceSet.of_array fses))
 285       other_filesystems data.Slave.insp_oses in
 286
 287   (* Add top level operating systems. *)
 288   List.iter (add_top_level_os t name) data.Slave.insp_oses;
 289
 290   (* Add top level left-over filesystems. *)
 291   DeviceSet.iter (add_top_level_vol t name) other_filesystems;
 292
 293   (* If it's Windows and registry files exist, create a node for
 294    * each file.
 295    *)
 296   List.iter (
 297     fun os ->
 298       (match os.Slave.insp_winreg_SAM with
 299        | Some filename ->
 300            add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SAM" filename
 301        | None -> ()
 302       );
 303       (match os.Slave.insp_winreg_SECURITY with
 304        | Some filename ->
 305            add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SECURITY"
 306              filename
 307        | None -> ()
 308       );
 309       (match os.Slave.insp_winreg_SOFTWARE with
 310        | Some filename ->
 311            add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SOFTWARE"
 312              filename
 313        | None -> ()
 314       );
 315       (match os.Slave.insp_winreg_SYSTEM with
 316        | Some filename ->
 317            add_top_level_winreg t name os "HKEY_LOCAL_MACHINE\\SYSTEM"
 318              filename
 319        | None -> ()
 320       );
 321       (match os.Slave.insp_winreg_DEFAULT with
 322        | Some filename ->
 323            add_top_level_winreg t name os "HKEY_USERS\\.DEFAULT" filename
 324        | None -> ()
 325       );
 326   ) data.Slave.insp_oses;
 327
 328   (* Expand the first top level node. *)
 329   match model#get_iter_first with
 330   | None -> ()
 331   | Some row ->
 332       t.view#expand_row (model#get_path row)
 333
 334 (* Add a top level operating system node. *)
 335 and add_top_level_os ({ model = model } as t) name os =
 336   let markup =
 337     sprintf "<b>%s</b>\n<small>%s</small>\n<small>%s</small>"
 338       (markup_escape name) (markup_escape os.Slave.insp_hostname)
 339       (markup_escape os.Slave.insp_product_name) in
 340
 341   let row = model#append () in
 342   make_node t row (Top (Slave.OS os)) None;
 343   model#set ~row ~column:t.name_col markup
 344
 345 (* Add a top level volume (left over filesystem) node. *)
 346 and add_top_level_vol ({ model = model } as t) name dev =
 347   let markup =
 348     sprintf "<b>%s</b>\n<small>from %s</small>"
 349       (markup_escape dev) (markup_escape name) in
 350
 351   let row = model#append () in
 352   make_node t row (Top (Slave.Volume dev)) None;
 353   model#set ~row ~column:t.name_col markup
 354
 355 (* Add a top level Windows Registry node. *)
 356 and add_top_level_winreg ({ model = model } as t) name os rootkey
 357     remotefile =
 358   let cachefile = tmpdir // string_of_int (unique ()) ^ ".hive" in
 359
 360   let markup =
 361     sprintf "<b>%s</b>\n<small>from %s</small>"
 362       (markup_escape rootkey) (markup_escape name) in
 363
 364   let row = model#append () in
 365   make_node t row
 366     (TopWinReg (Slave.OS os, rootkey, remotefile, cachefile)) None;
 367   model#set ~row ~column:t.name_col markup
 368
 369 (* Generic function to make an openable node to the tree. *)
 370 and make_node ({ model = model } as t) row content hiveh =
 371   let hdata =
 372     { state=NodeNotStarted; content=content; visited=false; hiveh=hiveh } in
 373   store_hdata t row hdata;
 374
 375   (* Create a placeholder "loading ..." row underneath this node so
 376    * the user has something to expand.
 377    *)
 378   let placeholder = model#append ~parent:row () in
 379   let hdata = { state=IsLeaf; content=Loading; visited=false; hiveh=None } in
 380   store_hdata t placeholder hdata;
 381   model#set ~row:placeholder ~column:t.name_col "<i>Loading ...</i>";
 382   ignore (t.view#connect#row_expanded ~callback:(expand_row t))
 383
 384 and make_leaf ({ model = model } as t) row content hiveh =
 385   let hdata = { state=IsLeaf; content=content; visited=false; hiveh=hiveh } in
 386   store_hdata t row hdata
 387
 388 (* This is called when the user expands a row. *)
 389 and expand_row ({ model = model } as t) row _ =
 390   match get_hdata t row with
 391   | { state=NodeNotStarted; content=Top src } as hdata ->
 392       (* User has opened a top level node that was not previously opened. *)
 393
 394       (* Mark this row as loading, so we don't try to open it again. *)
 395       hdata.state <- NodeLoading;
 396
 397       (* Get a stable path for this row. *)
 398       let path = model#get_path row in
 399
 400       Slave.read_directory ~fail:(when_read_directory_fail t path)
 401         src "/" (when_read_directory t path)
 402
 403   | { state=NodeNotStarted; content=Directory direntry } as hdata ->
 404       (* User has opened a filesystem directory not previously opened. *)
 405
 406       (* Mark this row as loading. *)
 407       hdata.state <- NodeLoading;
 408
 409       (* Get a stable path for this row. *)
 410       let path = model#get_path row in
 411
 412       let src, pathname = get_pathname t row in
 413
 414       Slave.read_directory ~fail:(when_read_directory_fail t path)
 415         src pathname (when_read_directory t path)
 416
 417   | { state=NodeNotStarted;
 418       content=TopWinReg (src, rootkey, remotefile, cachefile) } as hdata ->
 419       (* User has opened a Windows Registry top level node
 420        * not previously opened.
 421        *)
 422
 423       (* Mark this row as loading. *)
 424       hdata.state <- NodeLoading;
 425
 426       (* Get a stable path for this row. *)
 427       let path = model#get_path row in
 428
 429       (* Since the user has opened this top level registry node for the
 430        * first time, we now need to download the hive.
 431        *)
 432       Slave.download_file ~fail:(when_downloaded_registry_fail t path)
 433         src remotefile cachefile (when_downloaded_registry t path)
 434
 435   | { state=NodeNotStarted; content=RegKey node } as hdata ->
 436       (* User has opened a Windows Registry key node not previously opened. *)
 437
 438       (* Mark this row as loading. *)
 439       hdata.state <- NodeLoading;
 440
 441       expand_hive_node t row node
 442
 443   (* Ignore when a user opens a node which is loading or has been loaded. *)
 444   | { state=(NodeLoading|IsNode) } -> ()
 445
 446   (* These are not nodes so it should never be possible to open them. *)
 447   | { content=(File _ | RegValue _) } | { state=IsLeaf } -> assert false
 448
 449   (* Node should not exist in the tree. *)
 450   | { state=NodeNotStarted; content=(Loading | ErrorMessage _ | Info _) } ->
 451       assert false
 452
 453 (* This is the callback when the slave has read the directory for us. *)
 454 and when_read_directory ({ model = model } as t) path entries =
 455   debug "when_read_directory";
 456
 457   let row = model#get_iter path in
 458
 459   (* Sort the entries by lexicographic ordering. *)
 460   let cmp { Slave.dent_name = n1 } { Slave.dent_name = n2 } =
 461     UTF8.compare n1 n2
 462   in
 463   let entries = List.sort ~cmp entries in
 464
 465   (* Add the entries. *)
 466   List.iter (
 467     fun direntry ->
 468       let { Slave.dent_name = name; dent_stat = stat; dent_link = link } =
 469         direntry in
 470       let row = model#append ~parent:row () in
 471       if is_directory stat.G.mode then
 472         make_node t row (Directory direntry) None
 473       else
 474         make_leaf t row (File direntry) None;
 475       model#set ~row ~column:t.name_col (markup_of_name direntry);
 476       model#set ~row ~column:t.mode_col (markup_of_mode stat.G.mode);
 477       model#set ~row ~column:t.size_col (markup_of_size stat.G.size);
 478       model#set ~row ~column:t.date_col (markup_of_date stat.G.mtime);
 479   ) entries;
 480
 481   (* Remove the placeholder "Loading" entry.  NB. Must be done AFTER
 482    * adding the other entries, or else Gtk will unexpand the row.
 483    *)
 484   (try
 485      let row = find_child_node_by_content t row Loading in
 486      ignore (model#remove row)
 487    with Invalid_argument _ | Not_found -> ()
 488   );
 489
 490   (* The original directory entry has now been loaded, so
 491    * update its state.
 492    *)
 493   let hdata = get_hdata t row in
 494   hdata.state <- IsNode;
 495   set_visited t row
 496
 497 (* This is called instead of when_read_directory when the read directory
 498  * (or mount etc) failed.  Convert the "Loading" entry into the
 499  * error message.
 500  *)
 501 and when_read_directory_fail ({ model = model } as t) path exn =
 502   debug "when_read_directory_fail: %s" (Printexc.to_string exn);
 503
 504   match exn with
 505   | G.Error msg ->
 506       let row = model#get_iter path in
 507       let row = model#iter_children ~nth:0 (Some row) in
 508
 509       let hdata =
 510         { state=IsLeaf; content=ErrorMessage msg; visited=false; hiveh=None } in
 511       store_hdata t row hdata;
 512
 513       model#set ~row ~column:t.name_col (markup_escape msg)
 514
 515   | exn ->
 516       (* unexpected exception: re-raise it *)
 517       raise exn
 518
 519 (* Called when the top level registry node has been opened and the
 520  * hive file was downloaded to the cache file successfully.
 521  *)
 522 and when_downloaded_registry ({ model = model } as t) path () =
 523   debug "when_downloaded_registry";
 524   let row = model#get_iter path in
 525
 526   let hdata = get_hdata t row in
 527   match hdata.content with
 528   | TopWinReg (src, rootkey, remotefile, cachefile) ->
 529       (try
 530          (* Open the hive and save the hive handle in the row hdata. *)
 531          let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
 532          let h = Hivex.open_file cachefile flags in
 533          hdata.hiveh <- Some h;
 534
 535          (* Continue as if expanding any other hive node. *)
 536          let root = Hivex.root h in
 537          expand_hive_node t row root
 538        with
 539          Hivex.Error _ as exn -> when_downloaded_registry_fail t path exn
 540       )
 541   | _ -> assert false
 542
 543 (* Called instead of {!when_downloaded_registry} if the download failed. *)
 544 and when_downloaded_registry_fail ({ model = model } as t) path exn =
 545   debug "when_downloaded_registry_fail: %s" (Printexc.to_string exn);
 546
 547   match exn with
 548   | G.Error msg
 549   | Hivex.Error (_, _, msg) ->
 550       let row = model#get_iter path in
 551       let row = model#iter_children ~nth:0 (Some row) in
 552
 553       let hdata =
 554         { state=IsLeaf; content=ErrorMessage msg; visited=false; hiveh=None } in
 555       store_hdata t row hdata;
 556
 557       model#set ~row ~column:t.name_col (markup_escape msg)
 558
 559   | exn ->
 560       (* unexpected exception: re-raise it *)
 561       raise exn
 562
 563 (* Expand a hive node. *)
 564 and expand_hive_node ({ model = model } as t) row node =
 565   debug "expand_hive_node";
 566   let hdata = get_hdata t row in
 567   let h = Option.get hdata.hiveh in
 568
 569   (* Read the hive entries (values, subkeys) at this node and add them
 570    * to the tree.
 571    *)
 572   let values = Hivex.node_values h node in
 573   let cmp v1 v2 = UTF8.compare (Hivex.value_key h v1) (Hivex.value_key h v2) in
 574   Array.sort cmp values;
 575   Array.iter (
 576     fun value ->
 577       let row = model#append ~parent:row () in
 578       make_leaf t row (RegValue value) (Some h);
 579       model#set ~row ~column:t.name_col (markup_of_regvalue h value);
 580       model#set ~row ~column:t.size_col (markup_of_regvaluesize h value);
 581       model#set ~row ~column:t.date_col (markup_of_regvaluetype h value);
 582   ) values;
 583
 584   let children = Hivex.node_children h node in
 585   let cmp n1 n2 = UTF8.compare (Hivex.node_name h n1) (Hivex.node_name h n2) in
 586   Array.sort cmp children;
 587   Array.iter (
 588     fun node ->
 589       let row = model#append ~parent:row () in
 590       make_node t row (RegKey node) (Some h);
 591       model#set ~row ~column:t.name_col (markup_of_regkey h node);
 592   ) children;
 593
 594   (* Remove the placeholder "Loading" entry.  NB. Must be done AFTER
 595    * adding the other entries, or else Gtk will unexpand the row.
 596    *)
 597   (try
 598      let row = find_child_node_by_content t row Loading in
 599      ignore (model#remove row)
 600    with Invalid_argument _ | Not_found -> ()
 601   );
 602
 603   (* The original entry has now been loaded, so update its state. *)
 604   hdata.state <- IsNode;
 605   set_visited t row