(* 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 open Filetree_markup (* 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 let hdata = { state=IsLeaf; content=content; visited=false; hiveh=None } in store_hdata t row hdata; 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 let hdata = { state=IsLeaf; content=content; visited=false; hiveh=None } in store_hdata t row hdata; (* 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 )