filetree_type.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 Utils
  20
  21 open Slave_types
  22
  23 (* See struct/field description in .mli file. *)
  24 type t = {
  25   view : GTree.view;
  26   model : GTree.tree_store;
  27   hash : (int, hdata) Hashtbl.t;
  28   index_col : int GTree.column;
  29   mode_col : string GTree.column;
  30   name_col : string GTree.column;
  31   size_col : string GTree.column;
  32   date_col : string GTree.column;
  33 }
  34
  35 and hdata = {
  36   mutable state : state_t;
  37   content : content_t;
  38   mutable visited : bool;
  39   mutable hiveh : Hivex.t option;
  40 }
  41
  42 and state_t =
  43   | IsLeaf
  44   | NodeNotStarted
  45   | NodeLoading
  46   | IsNode
  47
  48 and content_t =
  49   | Loading
  50   | ErrorMessage of string
  51   | Info of string
  52   | Top of source
  53   | TopWinReg of source * string * string * string
  54   | Directory of direntry
  55   | File of direntry
  56   | RegKey of Hivex.node
  57   | RegValue of Hivex.value
  58
  59 (* Store hdata into a row. *)
  60 let store_hdata {model = model; hash = hash; index_col = index_col} row hdata =
  61   let index = unique () in
  62   Hashtbl.add hash index hdata;
  63   model#set ~row ~column:index_col index
  64
  65 (* Retrieve previously stored hdata from a row. *)
  66 let get_hdata { model = model; hash = hash; index_col = index_col } row =
  67   let index = model#get ~row ~column:index_col in
  68   try Hashtbl.find hash index
  69   with Not_found -> assert false
  70
  71 (* Iterate over children of node, looking for matching hdata. *)
  72 let find_child_node_by_content ({ model = model } as t) row c =
  73   let rec loop row =
  74     if (get_hdata t row).content = c then
  75       row
  76     else if model#iter_next row then
  77       loop row
  78     else
  79       raise Not_found
  80   in
  81
  82   if not (model#iter_has_child row) then
  83     raise Not_found;
  84
  85   let first_child = model#iter_children (Some row) in
  86   loop first_child
  87
  88 (* Search up to the top of the tree so we know if this directory
  89  * comes from an OS or a volume, and the full path to here.
  90  *
  91  * The path up the tree will always look something like:
  92  *     Top
  93  *       \_ Directory
  94  *            \_ Directory
  95  *                 \_ Loading    <--- you are here
  96  *
  97  * Note this function cannot be called on registry keys.  See
  98  * {!get_registry_path} for that.
  99  *)
 100 let rec get_pathname ({ model = model } as t) row =
 101   let hdata = get_hdata t row in
 102   let parent = model#iter_parent row in
 103
 104   match hdata, parent with
 105   | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
 106       get_pathname t parent
 107   | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
 108       assert false
 109   | { content=Directory { dent_name = name }}, Some parent
 110   | { content=File { dent_name = name }}, Some parent ->
 111       let src, parent_name = get_pathname t parent in
 112       let path =
 113         if parent_name = "/" then "/" ^ name
 114         else parent_name ^ "/" ^ name in
 115       src, path
 116   | { content=Top src }, _ -> src, "/"
 117   | { content=Directory _ }, None -> assert false
 118   | { content=File _ }, None -> assert false
 119   | { content=Loading }, _ -> assert false
 120   | { content=ErrorMessage _ }, _ -> assert false
 121   | { content=Info _ }, _ -> assert false
 122   | { content=TopWinReg _ }, _ -> assert false
 123   | { content=RegKey _ }, _ -> assert false
 124   | { content=RegValue _ }, _ -> assert false
 125
 126 (* Search up to the top of the tree from a registry key.
 127  *
 128  * The path up the tree will always look something like:
 129  *     TopWinReg
 130  *       \_ RegKey
 131  *            \_ RegKey          <--- you are here
 132  *                 \_ Loading    <--- or here
 133  *
 134  * Note this function cannot be called on ordinary paths.  Use
 135  * {!get_pathname} for that.
 136  *)
 137 let rec get_registry_path ({ model = model } as t) row =
 138   let hdata = get_hdata t row in
 139   let parent = model#iter_parent row in
 140
 141   match hdata, parent with
 142   | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
 143       get_registry_path t parent
 144   | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
 145       assert false
 146   | { content=RegKey node; hiveh = Some h }, Some parent ->
 147       let top, path = get_registry_path t parent in
 148       let path = Hivex.node_name h node :: path in
 149       top, path
 150   | { content=TopWinReg (a,b,c,d) }, None -> (a,b,c,d), []
 151   | { content=TopWinReg _ }, _ -> assert false
 152   | { content=RegKey _}, _ -> assert false
 153   | { content=Top _ }, _ -> assert false
 154   | { content=Directory _ }, _ -> assert false
 155   | { content=File _ }, _ -> assert false
 156   | { content=Loading }, _ -> assert false
 157   | { content=ErrorMessage _ }, _ -> assert false
 158   | { content=Info _ }, _ -> assert false
 159   | { content=RegValue _ }, _ -> assert false
 160
 161 let rec cache_registry_file ?fail t path src remotefile cachefile cb =
 162   Slave.download_file_if_not_exist ?fail src remotefile cachefile
 163     (when_cached_registry ?fail t path cb)
 164
 165 and when_cached_registry ?fail ({ model = model } as t) path cb () =
 166   debug "when_cached_registry";
 167   let row = model#get_iter path in
 168   let hdata = get_hdata t row in
 169
 170   match hdata with
 171   | { hiveh=Some _; content=TopWinReg _ } ->
 172       (* Hive handle already opened. *)
 173       cb ()
 174
 175   | { hiveh=None; content=TopWinReg (src, rootkey, remotefile, cachefile) } ->
 176       (* Hive handle not opened, open it and save it in the handle. *)
 177       (try
 178          let flags = if verbose () then [ Hivex.OPEN_VERBOSE ] else [] in
 179          let h = Hivex.open_file cachefile flags in
 180          hdata.hiveh <- Some h;
 181          cb ()
 182        with
 183          Hivex.Error _ as exn ->
 184            match fail with
 185            | Some fail -> fail exn
 186            | None -> raise exn
 187       )
 188   | _ -> assert false