filetree_ops.ml

   1 (* Guestfs Browser.
   2  * Copyright (C) 2010 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  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.
  17  *)
  18
  19 open Printf
  20
  21 open Utils
  22 open Filetree_type
  23 open Filetree_markup
  24
  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.
  28  *)
  29 let basename pathname =
  30   let len = String.length pathname in
  31   try
  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
  35   with
  36     Not_found -> pathname
  37
  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;
  43
  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);
  50
  51   match dlg#run () with
  52   | `DELETE_EVENT | `CANCEL ->
  53       dlg#destroy ()
  54   | `SAVE ->
  55       match dlg#filename with
  56       | None -> ()
  57       | Some localfile ->
  58           dlg#destroy ();
  59
  60           (* Download the file. *)
  61           Slave.download_file src pathname localfile
  62             (when_downloaded_file t path)
  63
  64 and when_downloaded_file ({ model = model } as t) path () =
  65   let row = model#get_iter path in
  66   set_visited t row
  67
  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;
  73
  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;
  79
  80   let extension = match format with
  81     | Slave.Tar -> ".tar"
  82     | Slave.TGZ -> ".tar.gz"
  83     | Slave.TXZ -> ".tar.xz"
  84   in
  85   dlg#set_current_name (basename pathname ^ extension);
  86
  87   match dlg#run () with
  88   | `DELETE_EVENT | `CANCEL ->
  89       dlg#destroy ()
  90   | `SAVE ->
  91       match dlg#filename with
  92       | None -> ()
  93       | Some localfile ->
  94           dlg#destroy ();
  95
  96           (* Download the directory. *)
  97           Slave.download_dir_tarball src pathname format localfile
  98             (when_downloaded_dir_tarball t path)
  99
 100 and when_downloaded_dir_tarball ({ model = model } as t) path () =
 101   let row = model#get_iter path in
 102   set_visited t row
 103
 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;
 108
 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");
 115
 116   (* Notify that the list of strings is \0 separated. *)
 117   let hbox =
 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;
 124     hbox in
 125   dlg#set_extra_widget (hbox :> GObj.widget);
 126
 127   match dlg#run () with
 128   | `DELETE_EVENT | `CANCEL ->
 129       dlg#destroy ()
 130   | `SAVE ->
 131       match dlg#filename with
 132       | None -> ()
 133       | Some localfile ->
 134           dlg#destroy ();
 135
 136           (* Download the directory. *)
 137           Slave.download_dir_find0 src pathname localfile
 138             (when_downloaded_dir_find0 t path)
 139
 140 and when_downloaded_dir_find0 ({ model = model } as t) path () =
 141   let row = model#get_iter path in
 142   set_visited t row
 143
 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
 147
 148 (* Calculate disk space used by a directory. *)
 149 let rec disk_usage ({ model = model } as t) path () =
 150   t.view#expand_row path;
 151
 152   let row = model#get_iter path in
 153   let src, pathname = get_pathname t row in
 154   debug "disk_usage %s" pathname;
 155
 156   (* See if this node already has an Info "disk_usage" child node.  If
 157    * so they don't recreate it.
 158    *)
 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>";
 166
 167     Slave.disk_usage src pathname (when_disk_usage t path pathname)
 168   )
 169
 170 and when_disk_usage ({ model = model } as t) path pathname kbytes =
 171   let row = model#get_iter path in
 172
 173   (* Find the Info "disk_usage" child node add above, and replace the
 174    * text in it with the final size.
 175    *)
 176   try
 177     let content = Info "disk_usage" in
 178     let row = find_child_node_by_content t row content in
 179     let msg =
 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
 183   with
 184     Not_found -> ()
 185
 186 (* Display operating system inspection information. *)
 187 let display_inspection_data ({ model = model } as t) path () =
 188   t.view#expand_row path;
 189
 190   let row = model#get_iter path in
 191   let src, _ = get_pathname t row in
 192   debug "display_inspection_data";
 193
 194   (* Should be an OS source, if not ignore. *)
 195   match src with
 196   | Slave.Volume _ -> ()
 197   | Slave.OS os ->
 198       (* See if this node already has an Info "inspection_data" child
 199        * node.  If so they don't recreate it.
 200        *)
 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
 204         let hdata =
 205           { state=IsLeaf; content=content; visited=false; hiveh=None } in
 206         store_hdata t row hdata;
 207
 208         (* XXX UGHLEE *)
 209         let data =
 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
 213             os.Slave.insp_arch
 214             os.Slave.insp_package_management os.Slave.insp_package_format
 215             (match os.Slave.insp_windows_systemroot with
 216              | None -> ""
 217              | Some path ->
 218                  sprintf "%%systemroot%%: <b>%s</b>\n" (markup_escape path))
 219             (String.concat "\n"
 220                (List.map (
 221                   fun (mp, dev) ->
 222                     sprintf "<b>%s</b> on <b>%s</b>"
 223                       (markup_escape dev) (markup_escape mp))
 224                   os.Slave.insp_mountpoints)
 225             ) in
 226
 227         model#set ~row ~column:t.name_col data
 228       )