2 * Copyright (C) 2010 Red Hat Inc.
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.
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.
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.
25 (* Get the basename of a file, using path conventions which are valid
26 * for libguestfs. So [Filename.basename] won't necessarily work
27 * because it will use host path conventions.
29 let basename pathname =
30 let len = String.length pathname in
32 let i = String.rindex pathname '/' in
33 let r = String.sub pathname (i+1) (len-i-1) in
34 if r = "" then "root" else r
38 (* Download a single file. *)
39 let rec download_file ({ model = model } as t) path () =
40 let row = model#get_iter path in
41 let src, pathname = get_pathname t row in
42 debug "download_file %s: showing dialog" pathname;
44 (* Put up the dialog. *)
45 let title = "Download file" in
46 let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
47 dlg#add_button_stock `CANCEL `CANCEL;
48 dlg#add_select_button_stock `SAVE `SAVE;
49 dlg#set_current_name (basename pathname);
52 | `DELETE_EVENT | `CANCEL ->
55 match dlg#filename with
60 (* Download the file. *)
61 Slave.download_file src pathname localfile
62 (when_downloaded_file t path)
64 and when_downloaded_file ({ model = model } as t) path () =
65 let row = model#get_iter path in
68 (* Download a directory as a tarball. *)
69 let rec download_dir_tarball ({ model = model } as t) format path () =
70 let row = model#get_iter path in
71 let src, pathname = get_pathname t row in
72 debug "download_dir_tarball %s: showing dialog" pathname;
74 (* Put up the dialog. *)
75 let title = "Download directory to tar file" in
76 let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
77 dlg#add_button_stock `CANCEL `CANCEL;
78 dlg#add_select_button_stock `SAVE `SAVE;
80 let extension = match format with
82 | Slave.TGZ -> ".tar.gz"
83 | Slave.TXZ -> ".tar.xz"
85 dlg#set_current_name (basename pathname ^ extension);
88 | `DELETE_EVENT | `CANCEL ->
91 match dlg#filename with
96 (* Download the directory. *)
97 Slave.download_dir_tarball src pathname format localfile
98 (when_downloaded_dir_tarball t path)
100 and when_downloaded_dir_tarball ({ model = model } as t) path () =
101 let row = model#get_iter path in
104 let rec download_dir_find0 ({ model = model } as t) path () =
105 let row = model#get_iter path in
106 let src, pathname = get_pathname t row in
107 debug "download_dir_find0 %s: showing dialog" pathname;
109 (* Put up the dialog. *)
110 let title = "Download list of filenames" in
111 let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
112 dlg#add_button_stock `CANCEL `CANCEL;
113 dlg#add_select_button_stock `SAVE `SAVE;
114 dlg#set_current_name (basename pathname ^ ".filenames.txt");
116 (* Notify that the list of strings is \0 separated. *)
118 let hbox = GPack.hbox () in
119 ignore (GMisc.image ~stock:`INFO ~packing:hbox#pack ());
120 let label = GMisc.label
121 ~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."
122 ~packing:hbox#pack () in
123 label#set_line_wrap true;
125 dlg#set_extra_widget (hbox :> GObj.widget);
127 match dlg#run () with
128 | `DELETE_EVENT | `CANCEL ->
131 match dlg#filename with
136 (* Download the directory. *)
137 Slave.download_dir_find0 src pathname localfile
138 (when_downloaded_dir_find0 t path)
140 and when_downloaded_dir_find0 ({ model = model } as t) path () =
141 let row = model#get_iter path in
144 let has_child_node_equals t row content =
145 try ignore (find_child_node_by_content t row content); true
146 with Not_found -> false
148 (* Calculate disk space used by a directory. *)
149 let rec disk_usage ({ model = model } as t) path () =
150 t.view#expand_row path;
152 let row = model#get_iter path in
153 let src, pathname = get_pathname t row in
154 debug "disk_usage %s" pathname;
156 (* See if this node already has an Info "disk_usage" child node. If
157 * so they don't recreate it.
159 let content = Info "disk_usage" in
160 if not (has_child_node_equals t row content) then (
161 (* Create the child node first. *)
162 let row = model#insert ~parent:row 0 in
163 let hdata = { state=IsLeaf; content=content; visited=false; hiveh=None } in
164 store_hdata t row hdata;
165 model#set ~row ~column:t.name_col "<i>Calculating disk usage ...</i>";
167 Slave.disk_usage src pathname (when_disk_usage t path pathname)
170 and when_disk_usage ({ model = model } as t) path pathname kbytes =
171 let row = model#get_iter path in
173 (* Find the Info "disk_usage" child node add above, and replace the
174 * text in it with the final size.
177 let content = Info "disk_usage" in
178 let row = find_child_node_by_content t row content in
180 sprintf "<b>%s</b>\n<small>Disk usage of %s (%Ld KB)</small>"
181 (human_size_1k kbytes) pathname kbytes in
182 model#set ~row ~column:t.name_col msg
186 (* Display operating system inspection information. *)
187 let display_inspection_data ({ model = model } as t) path () =
188 t.view#expand_row path;
190 let row = model#get_iter path in
191 let src, _ = get_pathname t row in
192 debug "display_inspection_data";
194 (* Should be an OS source, if not ignore. *)
196 | Slave.Volume _ -> ()
198 (* See if this node already has an Info "inspection_data" child
199 * node. If so they don't recreate it.
201 let content = Info "inspection_data" in
202 if not (has_child_node_equals t row content) then (
203 let row = model#insert ~parent:row 0 in
205 { state=IsLeaf; content=content; visited=false; hiveh=None } in
206 store_hdata t row hdata;
210 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"
211 os.Slave.insp_type os.Slave.insp_distro
212 os.Slave.insp_major_version os.Slave.insp_minor_version
214 os.Slave.insp_package_management os.Slave.insp_package_format
215 (match os.Slave.insp_windows_systemroot with
218 sprintf "%%systemroot%%: <b>%s</b>\n" (markup_escape path))
222 sprintf "<b>%s</b> on <b>%s</b>"
223 (markup_escape dev) (markup_escape mp))
224 os.Slave.insp_mountpoints)
227 model#set ~row ~column:t.name_col data