(* 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 Filetree_type
(* 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
(* 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
| Slave.Tar -> ".tar"
| Slave.TGZ -> ".tar.gz"
| Slave.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
store_hdata t row { state=IsLeaf; content=content; visited=false };
model#set ~row ~column:t.name_col "Calculating disk usage ...";
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 add 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 "%s\nDisk usage of %s (%Ld KB)"
(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
| Slave.Volume _ -> ()
| Slave.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
store_hdata t row { state=IsLeaf; content=content; visited=false };
(* XXX UGHLEE *)
let data =
sprintf "Type: %s\nDistro: %s\nVersion: %d.%d\nArch.: %s\nPackaging: %s/%s\n%sMountpoints:\n%s"
os.Slave.insp_type os.Slave.insp_distro
os.Slave.insp_major_version os.Slave.insp_minor_version
os.Slave.insp_arch
os.Slave.insp_package_management os.Slave.insp_package_format
(match os.Slave.insp_windows_systemroot with
| None -> ""
| Some path ->
sprintf "%%systemroot%%: %s\n" (markup_escape path))
(String.concat "\n"
(List.map (
fun (mp, dev) ->
sprintf "%s on %s"
(markup_escape dev) (markup_escape mp))
os.Slave.insp_mountpoints)
) in
model#set ~row ~column:t.name_col data
)