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
  23 open Filetree_type
  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           update_status t
  62             (sprintf "Downloading %s to %s ..." pathname localfile);
  63           Slave.download_file src pathname localfile
  64             (when_downloaded_file t pathname localfile)
  65
  66 and when_downloaded_file t _ localfile () =
  67   update_status t (sprintf "Finished downloading %s" localfile)
  68
  69 (* Download a directory as a tarball. *)
  70 let rec download_dir_tarball ({ model = model } as t) format path () =
  71   let row = model#get_iter path in
  72   let src, pathname = get_pathname t row in
  73   debug "download_dir_tarball %s: showing dialog" pathname;
  74
  75   (* Put up the dialog. *)
  76   let title = "Download directory to tar file" in
  77   let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
  78   dlg#add_button_stock `CANCEL `CANCEL;
  79   dlg#add_select_button_stock `SAVE `SAVE;
  80
  81   let extension = match format with
  82     | Slave.Tar -> ".tar"
  83     | Slave.TGZ -> ".tar.gz"
  84     | Slave.TXZ -> ".tar.xz"
  85   in
  86   dlg#set_current_name (basename pathname ^ extension);
  87
  88   match dlg#run () with
  89   | `DELETE_EVENT | `CANCEL ->
  90       dlg#destroy ()
  91   | `SAVE ->
  92       match dlg#filename with
  93       | None -> ()
  94       | Some localfile ->
  95           dlg#destroy ();
  96
  97           (* Download the directory. *)
  98           update_status t
  99             (sprintf "Downloading %s to %s ..." pathname localfile);
 100           Slave.download_dir_tarball src pathname format localfile
 101             (when_downloaded_dir_tarball t pathname localfile)
 102
 103 and when_downloaded_dir_tarball t _ localfile () =
 104   update_status t (sprintf "Finished downloading %s" localfile)
 105
 106 let rec download_dir_find0 ({ model = model } as t) path () =
 107   let row = model#get_iter path in
 108   let src, pathname = get_pathname t row in
 109   debug "download_dir_find0 %s: showing dialog" pathname;
 110
 111   (* Put up the dialog. *)
 112   let title = "Download list of filenames" in
 113   let dlg = GWindow.file_chooser_dialog ~action:`SAVE ~title ~modal:true () in
 114   dlg#add_button_stock `CANCEL `CANCEL;
 115   dlg#add_select_button_stock `SAVE `SAVE;
 116   dlg#set_current_name (basename pathname ^ ".filenames.txt");
 117
 118   (* Notify that the list of strings is \0 separated. *)
 119   let hbox =
 120     let hbox = GPack.hbox () in
 121     ignore (GMisc.image ~stock:`INFO ~packing:hbox#pack ());
 122     let label = GMisc.label
 123       ~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."
 124       ~packing:hbox#pack () in
 125     label#set_line_wrap true;
 126     hbox in
 127   dlg#set_extra_widget (hbox :> GObj.widget);
 128
 129   match dlg#run () with
 130   | `DELETE_EVENT | `CANCEL ->
 131       dlg#destroy ()
 132   | `SAVE ->
 133       match dlg#filename with
 134       | None -> ()
 135       | Some localfile ->
 136           dlg#destroy ();
 137
 138           (* Download the directory. *)
 139           update_status t
 140             (sprintf "Downloading filenames in %s to %s ..." pathname localfile);
 141           Slave.download_dir_find0 src pathname localfile
 142             (when_downloaded_dir_find0 t pathname localfile)
 143
 144 and when_downloaded_dir_find0 t _ localfile () =
 145   update_status t (sprintf "Finished downloading %s" localfile)