Daily check-in.

[guestfs-browser.git] / slave.ml

diff --git a/slave.ml b/slave.ml
index 1c56538..17f00b7 100644 (file)
--- a/slave.ml
+++ b/slave.ml
@@ -32,6 +32,9 @@ type 'a callback = 'a -> unit
 type command =
   | Exit_thread
   | Connect of string option * domain list callback
+  | Download_dir_find0 of source * string * string * unit callback
+  | Download_dir_tarball of source * string * download_dir_tarball_format * string * unit callback
+  | Download_file of source * string * string * unit callback
   | Open_domain of string * inspection_data callback
   | Open_images of (string * string option) list * inspection_data callback
   | Read_directory of source * string * direntry list callback
@@ -71,17 +74,27 @@ and direntry = {
   dent_link : string;
 }
 
+and download_dir_tarball_format = Tar | TGZ | TXZ
+
 let rec string_of_command = function
   | Exit_thread -> "Exit_thread"
   | Connect (Some name, _) -> sprintf "Connect %s" name
   | Connect (None, _) -> "Connect NULL"
+  | Download_dir_find0 (src, remotedir, localfile, _) ->
+      sprintf "Download_dir_find0 (%s, %s, %s)"
+        (string_of_source src) remotedir localfile
+  | Download_dir_tarball (src, remotedir, format, localfile, _) ->
+      sprintf "Download_dir_tarball (%s, %s, %s, %s)"
+        (string_of_source src) remotedir
+        (string_of_download_dir_tarball_format format) localfile
+  | Download_file (src, remotefile, localfile, _) ->
+      sprintf "Download_file (%s, %s, %s)"
+        (string_of_source src) remotefile localfile
   | Open_domain (name, _) -> sprintf "Open_domain %s" name
   | Open_images (images, _) ->
       sprintf "Open_images %s" (string_of_images images)
-  | Read_directory (OS { insp_root = root }, dir, _) ->
-      sprintf "Read_directory (OS %s, %s)" root dir
-  | Read_directory (Volume dev, dir, _) ->
-      sprintf "Read_directory (Volume %s, %s)" dev dir
+  | Read_directory (src, dir, _) ->
+      sprintf "Read_directory (%s, %s)" (string_of_source src) dir
 
 and string_of_images images =
   "[" ^
@@ -91,6 +104,17 @@ and string_of_images images =
                | fn, Some format -> sprintf "%s (%s)" fn format)
        images) ^ "]"
 
+and string_of_source = function
+  | OS { insp_root = root } ->
+      sprintf "OS %s" root
+  | Volume dev ->
+      sprintf "Volume %s" dev
+
+and string_of_download_dir_tarball_format = function
+  | Tar -> "Tar"
+  | TGZ -> "TGZ"
+  | TXZ -> "TXZ"
+
 let no_callback _ = ()
 
 let failure_hook = ref (fun _ -> ())
@@ -139,6 +163,13 @@ let discard_command_queue () =
   )
 
 let connect ?fail uri cb = send_to_slave ?fail (Connect (uri, cb))
+let download_dir_find0 ?fail src remotedir localfile cb =
+  send_to_slave ?fail (Download_dir_find0 (src, remotedir, localfile, cb))
+let download_dir_tarball ?fail src remotedir format localfile cb =
+  send_to_slave ?fail
+    (Download_dir_tarball (src, remotedir, format, localfile, cb))
+let download_file ?fail src remotefile localfile cb =
+  send_to_slave ?fail (Download_file (src, remotefile, localfile, cb))
 let open_domain ?fail name cb = send_to_slave ?fail (Open_domain (name, cb))
 let open_images ?fail images cb = send_to_slave ?fail (Open_images (images, cb))
 let read_directory ?fail src path cb =
@@ -238,6 +269,35 @@ and execute_command = function
       let doms = List.sort ~cmp doms in
       callback_if_not_discarded cb doms
 
+  | Download_dir_find0 (src, remotedir, localfile, cb) ->
+      let g = get_g () in
+      with_mount_ro g src (
+        fun () ->
+          g#find0 remotedir localfile
+      );
+      callback_if_not_discarded cb ()
+
+  | Download_dir_tarball (src, remotedir, format, localfile, cb) ->
+      let g = get_g () in
+      let f = match format with
+        | Tar -> g#tar_out
+        | TGZ -> g#tgz_out
+        | TXZ -> g#txz_out
+      in
+      with_mount_ro g src (
+        fun () ->
+          f remotedir localfile
+      );
+      callback_if_not_discarded cb ()
+
+  | Download_file (src, remotefile, localfile, cb) ->
+      let g = get_g () in
+      with_mount_ro g src (
+        fun () ->
+          g#download remotefile localfile
+      );
+      callback_if_not_discarded cb ()
+
   | Open_domain (name, cb) ->
       let conn = get_conn () in
       let dom = D.lookup_by_name conn name in
@@ -360,6 +420,8 @@ and open_disk_images images cb =
   g := Some g';
   let g = g' in
 
+  g#set_trace (trace ());
+
   (* Uncomment the next line to pass the verbose flag from the command
    * line through to libguestfs.  This is not generally necessary since
    * we are not so interested in debugging libguestfs problems at this