Add Reopen option to the menu.

[guestfs-browser.git] / slave.ml

diff --git a/slave.ml b/slave.ml
index 034bbdf..975ab35 100644 (file)
--- a/slave.ml
+++ b/slave.ml
@@ -51,6 +51,7 @@ type command =
   | 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
+  | Reopen of inspection_data callback
   | Run_command of string * unit callback
 
 let rec string_of_command = function
@@ -81,6 +82,8 @@ let rec string_of_command = function
       sprintf "Open_images %s" (string_of_images images)
   | Read_directory (src, dir, _) ->
       sprintf "Read_directory (%s, %s)" (string_of_source src) dir
+  | Reopen _ ->
+      "Reopen"
   | Run_command (cmd, _) ->
       sprintf "Run_command %s" cmd
 
@@ -174,6 +177,8 @@ 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 =
   send_to_slave ?fail (Read_directory (src, path, cb))
+let reopen ?fail cb =
+  send_to_slave ?fail (Reopen cb)
 let run_command ?fail cmd cb =
   send_to_slave ?fail (Run_command (cmd, cb))
 
@@ -188,6 +193,11 @@ let quit = ref false
 let conn = ref None
 let g = ref None
 
+(* Last Open_domain or Open_images command.  This is so we can implement
+ * the Reopen command.
+ *)
+let last_open = ref None
+
 (* Run the callback unless someone set the q_discard flag while
  * we were running the command.
  *)
@@ -356,19 +366,19 @@ and execute_command = function
       status "Finished listing applications";
       callback_if_not_discarded cb r
 
-  | Open_domain (name, cb) ->
+  | Open_domain (name, cb) as cmd ->
       status "Opening %s ..." name;
 
       let conn = get_conn () in
       let dom = D.lookup_by_name conn name in
       let xml = D.get_xml_desc dom in
       let images = get_disk_images_from_xml xml in
-      open_disk_images images cb
+      open_disk_images images cb cmd
 
-  | Open_images (images, cb) ->
+  | Open_images (images, cb) as cmd ->
       status "Opening disk images ...";
 
-      open_disk_images images cb
+      open_disk_images images cb cmd
 
   | Read_directory (src, dir, cb) ->
       status "Reading directory %s ..." dir;
@@ -395,6 +405,22 @@ and execute_command = function
       status "Finished reading directory %s" dir;
       callback_if_not_discarded cb entries
 
+  | Reopen cb ->
+      (* Execute the last_open command, if there was one.  But note
+       * that we have to replace the callback in the saved command with
+       * the new callback passed by the main thread to reopen.
+       *)
+      (match !last_open with
+       | Some (Open_domain (name, _)) ->
+           execute_command (Open_domain (name, cb))
+       | Some (Open_images (images, _)) ->
+           execute_command (Open_images (images, cb))
+       | None ->
+           () (* invalid_arg? *)
+       | _ ->
+           assert false (* should never happen *)
+      )
+
   | Run_command (cmd, cb) ->
       status "Running %s ..." cmd;
 
@@ -420,6 +446,7 @@ and get_g () =
 and close_all () =
   (match !conn with Some conn -> C.close conn | None -> ());
   conn := None;
+  last_open := None;
   close_g ()
 
 and close_g () =
@@ -487,7 +514,7 @@ and get_disk_images_from_xml xml =
 (* The common code for Open_domain and Open_images which opens the
  * libguestfs handle, adds the disks, and launches the appliance.
  *)
-and open_disk_images images cb =
+and open_disk_images images cb cmd =
   debug "opening disk image %s" (string_of_images images);
 
   close_g ();
@@ -628,6 +655,10 @@ and open_disk_images images cb =
   } in
 
   status "Finished opening disk";
+
+  (* Save the command, in case user does Reopen. *)
+  last_open := Some cmd;
+
   callback_if_not_discarded cb data
 
 (* Start up one slave thread. *)