+++ /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 Printf
-
-open Utils
-open Slave_types
-
-open Filetree_type
-open Filetree_markup
-
-(* Temporary directory for shared use by any function in this file.
- * It is cleaned up when the program exits.
- *)
-let tmpdir = tmpdir ()
-
-(* Get the basename of a file, using path conventions which are valid
- * for libguestfs. So [Filename.basename] won't necessarily work
- * because it will use host path conventions.
- *)
-let basename pathname =
- let len = String.length pathname in
- try
- let i = String.rindex pathname '/' in
- let r = String.sub pathname (i+1) (len-i-1) in
- if r = "" then "root" else r
- with
- Not_found -> pathname
-
-(* Get the extension of a file using libguestfs path conventions,
- * including the leading point (eg. ".txt"). Might return an empty
- * string if there is no extension.
- *)
-let extension pathname =
- let len = String.length pathname in
- try
- let i = String.rindex pathname '.' in
- let r = String.sub pathname i (len-i) in
- r
- with
- Not_found -> ""
-
-(* Download a single file. *)
-let rec download_file ({ model = model } as t) path () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "download_file %s: showing dialog" pathname;
-
- (* Put up the dialog. *)
- let title = "Download file" in
- let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
- dlg#add_button_stock `CANCEL `CANCEL;
- dlg#add_select_button_stock `SAVE `SAVE;
- dlg#set_current_name (basename pathname);
-
- match dlg#run () with
- | `DELETE_EVENT | `CANCEL ->
- dlg#destroy ()
- | `SAVE ->
- match dlg#filename with
- | None -> ()
- | Some localfile ->
- dlg#destroy ();
-
- (* Download the file. *)
- Slave.download_file src pathname localfile
- (when_downloaded_file t path)
-
-and when_downloaded_file ({ model = model } as t) path () =
- let row = model#get_iter path in
- set_visited t row
-
-(* Download a directory as a tarball. *)
-let rec download_dir_tarball ({ model = model } as t) format path () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "download_dir_tarball %s: showing dialog" pathname;
-
- (* Put up the dialog. *)
- let title = "Download directory to tar file" in
- let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
- dlg#add_button_stock `CANCEL `CANCEL;
- dlg#add_select_button_stock `SAVE `SAVE;
-
- let extension = match format with
- | Tar -> ".tar"
- | TGZ -> ".tar.gz"
- | TXZ -> ".tar.xz"
- in
- dlg#set_current_name (basename pathname ^ extension);
-
- match dlg#run () with
- | `DELETE_EVENT | `CANCEL ->
- dlg#destroy ()
- | `SAVE ->
- match dlg#filename with
- | None -> ()
- | Some localfile ->
- dlg#destroy ();
-
- (* Download the directory. *)
- Slave.download_dir_tarball src pathname format localfile
- (when_downloaded_dir_tarball t path)
-
-and when_downloaded_dir_tarball ({ model = model } as t) path () =
- let row = model#get_iter path in
- set_visited t row
-
-let rec download_dir_find0 ({ model = model } as t) path () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "download_dir_find0 %s: showing dialog" pathname;
-
- (* Put up the dialog. *)
- let title = "Download list of filenames" in
- let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
- dlg#add_button_stock `CANCEL `CANCEL;
- dlg#add_select_button_stock `SAVE `SAVE;
- dlg#set_current_name (basename pathname ^ ".filenames.txt");
-
- (* Notify that the list of strings is \0 separated. *)
- let hbox =
- let hbox = GPack.hbox () in
- ignore (GMisc.image ~stock:`INFO ~packing:hbox#pack ());
- let label = GMisc.label
- ~text:"The list of filenames is saved to a file with zero byte separators, to allow the full range of characters to be used in the names themselves."
- ~packing:hbox#pack () in
- label#set_line_wrap true;
- hbox in
- dlg#set_extra_widget (hbox :> GObj.widget);
-
- match dlg#run () with
- | `DELETE_EVENT | `CANCEL ->
- dlg#destroy ()
- | `SAVE ->
- match dlg#filename with
- | None -> ()
- | Some localfile ->
- dlg#destroy ();
-
- (* Download the directory. *)
- Slave.download_dir_find0 src pathname localfile
- (when_downloaded_dir_find0 t path)
-
-and when_downloaded_dir_find0 ({ model = model } as t) path () =
- let row = model#get_iter path in
- set_visited t row
-
-let has_child_node_equals t row content =
- try ignore (find_child_node_by_content t row content); true
- with Not_found -> false
-
-(* Calculate disk space used by a directory. *)
-let rec disk_usage ({ model = model } as t) path () =
- t.view#expand_row path;
-
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "disk_usage %s" pathname;
-
- (* See if this node already has an Info "disk_usage" child node. If
- * so they don't recreate it.
- *)
- let content = Info "disk_usage" in
- if not (has_child_node_equals t row content) then (
- (* Create the child node first. *)
- let row = model#insert ~parent:row 0 in
- let hdata = { state=IsLeaf; content=content; visited=false; hiveh=None } in
- store_hdata t row hdata;
- model#set ~row ~column:t.name_col "<i>Calculating disk usage ...</i>";
-
- Slave.disk_usage src pathname (when_disk_usage t path pathname)
- )
-
-and when_disk_usage ({ model = model } as t) path pathname kbytes =
- let row = model#get_iter path in
-
- (* Find the Info "disk_usage" child node added above, and replace the
- * text in it with the final size.
- *)
- try
- let content = Info "disk_usage" in
- let row = find_child_node_by_content t row content in
- let msg =
- sprintf "<b>%s</b>\n<small>Disk usage of %s (%Ld KB)</small>"
- (human_size_1k kbytes) pathname kbytes in
- model#set ~row ~column:t.name_col msg
- with
- Not_found -> ()
-
-(* Display operating system inspection information. *)
-let display_inspection_data ({ model = model } as t) path () =
- t.view#expand_row path;
-
- let row = model#get_iter path in
- let src, _ = get_pathname t row in
- debug "display_inspection_data";
-
- (* Should be an OS source, if not ignore. *)
- match src with
- | Volume _ -> ()
- | OS os ->
- (* See if this node already has an Info "inspection_data" child
- * node. If so they don't recreate it.
- *)
- let content = Info "inspection_data" in
- if not (has_child_node_equals t row content) then (
- let row = model#insert ~parent:row 0 in
- let hdata =
- { state=IsLeaf; content=content; visited=false; hiveh=None } in
- store_hdata t row hdata;
-
- (* XXX UGHLEE *)
- let data =
- sprintf "Type: <b>%s</b>\nDistro: <b>%s</b>\nVersion: <b>%d.%d</b>\nArch.: <b>%s</b>\nPackaging: <b>%s</b>/<b>%s</b>\n%sMountpoints:\n%s"
- os.insp_type os.insp_distro
- os.insp_major_version os.insp_minor_version
- os.insp_arch
- os.insp_package_management os.insp_package_format
- (match os.insp_windows_systemroot with
- | None -> ""
- | Some path ->
- sprintf "Systemroot: <b>%s</b>\n" (markup_escape path))
- (String.concat "\n"
- (List.map (
- fun (mp, dev) ->
- sprintf "<b>%s</b> on <b>%s</b>"
- (markup_escape dev) (markup_escape mp))
- os.insp_mountpoints)
- ) in
-
- model#set ~row ~column:t.name_col data
- )
-
-(* Copy registry key value to clipboard. *)
-let copy_regvalue ({ model = model } as t) path () =
- let row = model#get_iter path in
- let hdata = get_hdata t row in
- match hdata with
- | { content=RegValue value; hiveh = Some h } ->
- let t, v = Hivex.value_value h value in
- let v = printable_hivex_value t v in
- let cb = GData.clipboard Gdk.Atom.clipboard in
- cb#set_text v
-
- | _ -> () (* not a registry value row, ignore *)
-
-(* View a single file. *)
-let rec view_file ({ model = model } as t) path opener () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "view_file %s" pathname;
-
- (* Download the file into a temporary directory. *)
- let ext = extension pathname in
- let localfile = tmpdir // string_of_int (unique ()) ^ ext in
- Slave.download_file src pathname localfile
- (when_downloaded_file_for_view t path opener localfile)
-
-and when_downloaded_file_for_view ({ model = model } as t) path
- opener localfile () =
- let row = model#get_iter path in
- set_visited t row;
-
- let cmd =
- sprintf "%s %s" (Filename.quote opener) (Filename.quote localfile) in
- Slave.run_command cmd Slave.no_callback
-
-(* Compute the checksum of a file. *)
-let rec checksum_file ({ model = model } as t) path csumtype () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "checksum_file %s" pathname;
-
- (* See if this node already has an Info "checksum" child
- * node. If so they don't recreate it.
- *)
- let content = Info ("checksum:" ^ csumtype) in
- if not (has_child_node_equals t row content) then (
- let row = model#insert ~parent:row 0 in
- let hdata =
- { state=IsLeaf; content=content; visited=false; hiveh=None } in
- store_hdata t row hdata;
- model#set ~row ~column:t.name_col
- (sprintf "<i>Calculating %s ...</i>" csumtype);
-
- t.view#expand_row path;
-
- Slave.checksum_file src pathname csumtype
- (when_checksum_file t path pathname csumtype)
- )
-
-and when_checksum_file ({ model = model } as t) path pathname csumtype checksum=
- let row = model#get_iter path in
- set_visited t row;
-
- (* Find the child node added above, and replace the text. *)
- try
- let content = Info ("checksum:" ^ csumtype) in
- let row = find_child_node_by_content t row content in
- let msg = sprintf "%s: %s" csumtype checksum in
- model#set ~row ~column:t.name_col msg
- with
- Not_found -> ()
-
-(* Compute the file information of a file. *)
-let rec file_information ({ model = model } as t) path () =
- let row = model#get_iter path in
- let src, pathname = get_pathname t row in
- debug "file_information %s" pathname;
-
- (* See if this node already has an Info "file_information" child
- * node. If so they don't recreate it.
- *)
- let content = Info "file_information" in
- if not (has_child_node_equals t row content) then (
- let row = model#insert ~parent:row 0 in
- let hdata =
- { state=IsLeaf; content=content; visited=false; hiveh=None } in
- store_hdata t row hdata;
- model#set ~row ~column:t.name_col "<i>Calculating file information ...</i>";
-
- t.view#expand_row path;
-
- Slave.file_information src pathname (when_file_information t path pathname)
- )
-
-and when_file_information ({ model = model } as t) path pathname info =
- let row = model#get_iter path in
- set_visited t row;
-
- (* Find the child node added above, and replace the text. *)
- try
- let content = Info "file_information" in
- let row = find_child_node_by_content t row content in
- model#set ~row ~column:t.name_col (markup_escape info)
- with
- Not_found -> ()
-
-(* Export a registry key/subkey tree as a reg file. This is pretty
- * effortless with hivexregedit.
- *)
-let download_as_reg ({ model = model } as t) path hivexregedit () =
- let row = model#get_iter path in
- let hdata = get_hdata t row in
-
- (* Get path to the top of the registry tree. *)
- let (_, rootkey, _, cachefile), nodes = get_registry_path t row in
- let regpath = String.concat "\\" (List.rev nodes) in
- debug "download_as_reg: %s %s %s" cachefile rootkey regpath;
-
- let do_dialog () =
- (* Put up the dialog. *)
- let title = "Download as .reg file" in
- let dlg = GWindow.file_chooser_dialog
- ~action:`SAVE ~title ~modal:true () in
- dlg#add_button_stock `CANCEL `CANCEL;
- dlg#add_select_button_stock `SAVE `SAVE;
- let name = match nodes with [] -> rootkey | (name::_) -> name in
- dlg#set_current_name (name ^ ".reg");
-
- match dlg#run () with
- | `DELETE_EVENT | `CANCEL ->
- dlg#destroy ()
- | `SAVE ->
- match dlg#filename with
- | None -> ()
- | Some localfile ->
- dlg#destroy ();
-
- (* Use hivexregedit to save it. *)
- let cmd =
- sprintf "%s --export --prefix %s %s %s > %s"
- (Filename.quote hivexregedit)
- (Filename.quote rootkey) (Filename.quote cachefile)
- (Filename.quote regpath) (Filename.quote localfile) in
- Slave.run_command cmd Slave.no_callback
- in
-
- match hdata with
- | { content=RegKey _ } ->
- do_dialog ()
-
- | { content=TopWinReg (src, _, remotefile, cachefile) } ->
- (* There's a subtle problem here: If the top node has not been
- * opened, the registry cachefile won't have been downloaded. If
- * the top node has been opened, the registry might still be
- * being downloaded as we are running here. Either way we can't
- * trust the cachefile. Tell the slave thread to download the
- * file if it's not downloaded already (since the slave thread
- * runs in a serial loop, this is always race free).
- *)
- cache_registry_file t path src remotefile cachefile do_dialog
-
- | _ -> () (* not a registry key, ignore *)
git.annexia.org / guestfs-browser.git / blobdiff