+++ /dev/null
-(* 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 Utils
-
-open Slave_types
-
-(* See struct/field description in .mli file. *)
-type t = {
- view : GTree.view;
- model : GTree.tree_store;
- hash : (int, hdata) Hashtbl.t;
- index_col : int GTree.column;
- mode_col : string GTree.column;
- name_col : string GTree.column;
- size_col : string GTree.column;
- date_col : string GTree.column;
-}
-
-and hdata = {
- mutable state : state_t;
- content : content_t;
- mutable visited : bool;
- mutable hiveh : Hivex.t option;
-}
-
-and state_t =
- | IsLeaf
- | NodeNotStarted
- | NodeLoading
- | IsNode
-
-and content_t =
- | Loading
- | ErrorMessage of string
- | Info of string
- | Top of source
- | TopWinReg of source * string * string * string
- | Directory of direntry
- | File of direntry
- | RegKey of Hivex.node
- | RegValue of Hivex.value
-
-(* Store hdata into a row. *)
-let store_hdata {model = model; hash = hash; index_col = index_col} 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. *)
-let get_hdata { model = model; hash = hash; index_col = index_col } row =
- let index = model#get ~row ~column:index_col in
- try Hashtbl.find hash index
- with Not_found -> assert false
-
-(* Iterate over children of node, looking for matching hdata. *)
-let find_child_node_by_content ({ model = model } as t) row c =
- let rec loop row =
- if (get_hdata t 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.
- *)
-let rec get_pathname ({ model = model } as t) row =
- let hdata = get_hdata t row in
- let parent = model#iter_parent row in
-
- match hdata, parent with
- | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
- get_pathname t 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 = get_pathname t 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
-
-(* 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.
- *)
-let rec get_registry_path ({ model = model } as t) row =
- let hdata = get_hdata t row in
- let parent = model#iter_parent row in
-
- match hdata, parent with
- | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
- get_registry_path t parent
- | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
- assert false
- | { content=RegKey node; hiveh = Some h }, Some parent ->
- let top, path = get_registry_path t 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
-
-let rec cache_registry_file ?fail t path src remotefile cachefile cb =
- Slave.download_file_if_not_exist ?fail src remotefile cachefile
- (when_cached_registry ?fail t path cb)
-
-and when_cached_registry ?fail ({ model = model } as t) path cb () =
- debug "when_cached_registry";
- let row = model#get_iter path in
- let hdata = get_hdata t row in
-
- match hdata with
- | { hiveh=Some _; content=TopWinReg _ } ->
- (* Hive handle already opened. *)
- cb ()
-
- | { 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 ()
- with
- Hivex.Error _ as exn ->
- match fail with
- | Some fail -> fail exn
- | None -> raise exn
- )
- | _ -> assert false
git.annexia.org / guestfs-browser.git / blobdiff