Version 0.0.2

diff --git a/HACKING b/HACKING
index ab5f83a..468162e 100644 (file)
--- a/HACKING
+++ b/HACKING
@@ -51,9 +51,9 @@ safe, and in any case we don't want the main thread to block because
 it performs some long-running operation by accident).
 
 The slave thread is defined in the Slave module (interface:
-'slave.mli') and all slave_* files.  The Slave module also defines
-what commands are possible.  Every other module and file is part of
-the main thread except for a few utility / library modules.
+'slave.mli') and the slave.ml implementation.  The Slave module also
+defines what commands are possible.  Every other module and file is
+part of the main thread except for a few utility modules.
 
 The main thread starts in the module Main.
 

diff --git a/README b/README
index f37102f..b21b50d 100644 (file)
--- a/README
+++ b/README
@@ -12,14 +12,16 @@ script and it will tell you what's missing).
 
 We strongly suggest you run the program like this:
 
-  ./guestfs-browser [--verbose] [--write] --connect qemu:///system
+  guestfs-browser [--verbose] [--write] --connect qemu:///system
 or:
-  ./guestfs-browser [--verbose] [--write] disk.img
+  guestfs-browser [--verbose] [--write] disk.img
 
 --verbose enables debug level messages and is recommended.
 
---write enables writes to the filesystems and is *not* recommended.
+--write enables writes to the filesystems and is *not* recommended for
+casual users.
 
---connect tells the program which libvirt to connect to, and is
-required at the moment if you want to use libvirt, because we have not
-yet implemented the associated menu options.
+--connect tells the program which libvirt URI to connect to.
+
+Note that libguestfs cannot access remote storage, so accessing a
+remote libvirt URI will usually not work.

diff --git a/configure.ac b/configure.ac
index 8f45e75..872c5c0 100644 (file)
--- a/configure.ac
+++ b/configure.ac
@@ -15,7 +15,7 @@ dnl You should have received a copy of the GNU General Public License along
 dnl with this program; if not, write to the Free Software Foundation, Inc.,
 dnl 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
-AC_INIT([guestfs-browser],[0.0.1])
+AC_INIT([guestfs-browser],[0.0.2])
 AM_INIT_AUTOMAKE([foreign])
 AC_CONFIG_MACRO_DIR([m4])
 

diff --git a/filetree.ml b/filetree.ml
index 122320e..797c3df 100644 (file)
--- a/filetree.ml
+++ b/filetree.ml
@@ -24,8 +24,6 @@ open Utils
 
 module G = Guestfs
 
-let unique = let i = ref 0 in fun () -> incr i; !i
-
 (* The type of the hidden column used to implement on-demand loading.
  * We are going to store these in the model as simple ints because that
  * is easier on the GC.  Don't change these numbers!

diff --git a/utils.ml b/utils.ml
index a3eca86..94a59a0 100644 (file)
--- a/utils.ml
+++ b/utils.ml
@@ -60,3 +60,5 @@ let human_size_1k i =
     sprintf "%.1fM" (Int64.to_float i /. 1024.)
   else
     sprintf "%.1fG" (Int64.to_float i /. 1024. /. 1024.)
+
+let unique = let i = ref 0 in fun () -> incr i; !i

diff --git a/utils.mli b/utils.mli
index 0df3a43..1959ef6 100644 (file)
--- a/utils.mli
+++ b/utils.mli
@@ -52,3 +52,6 @@ val utf8_rarrow : string (** UTF-8 RIGHTWARDS ARROW *)
 
 val human_size_1k : int64 -> string
   (** Convert a number (of 1K blocks) into a human readable string. *)
+
+val unique : unit -> int
+  (** Return a new integer each time called. *)

diff --git a/window.ml b/window.ml
index f5ec47d..f58d76f 100644 (file)
--- a/window.ml
+++ b/window.ml
@@ -50,8 +50,13 @@ let rec open_main_window () =
   let connect_menu = factory#add_submenu "_Connect" in
 
   let factory = new GMenu.factory connect_menu ~accel_group in
-  let connect_item = factory#add_item "_Connect to libvirt ..." in
-  let open_item = factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in
+  let connect_kvm_item = factory#add_item "_Connect to local KVM hypervisor" in
+  let connect_xen_item = factory#add_item "_Connect to local Xen hypervisor" in
+  let connect_none_item = factory#add_item "_Connect to default hypervisor" in
+  let connect_uri_item = factory#add_item "_Connect to a libvirt URI ..." in
+  ignore (factory#add_separator ());
+  let open_image_item =
+    factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in
   ignore (factory#add_separator ());
   let quit_item = factory#add_item "E_xit" ~key:GdkKeysyms._Q in
 
@@ -140,18 +145,19 @@ let rec open_main_window () =
     combo#connect#changed
       ~callback:(
         fun () ->
-          match combo#active_iter with
-          | None -> ()
-          | Some row ->
-              let name = model#get ~row ~column in
-              ds.set_statusbar (sprintf "Opening %s ..." name);
-              ds.clear_notebook ();
-              Slave.discard_command_queue ();
-              Slave.open_domain name (opened_domain ds))
+          Option.may (fun row -> open_domain ds (model#get ~row ~column))
+            combo#active_iter
+      )
   );
 
-  ignore (connect_item#connect#activate ~callback:(connect_dialog ds));
-  ignore (open_item#connect#activate ~callback:(open_dialog ds));
+  ignore (connect_kvm_item#connect#activate
+            ~callback:(fun () -> connect ds (Some "qemu:///system")));
+  ignore (connect_xen_item#connect#activate
+            ~callback:(fun () -> connect ds (Some "xen:///")));
+  ignore (connect_none_item#connect#activate
+            ~callback:(fun () -> connect ds None));
+  ignore (connect_uri_item#connect#activate ~callback:(connect_uri_dialog ds));
+  ignore (open_image_item#connect#activate ~callback:(open_image_dialog ds));
 
   (* Return the display state. *)
   ds
@@ -176,6 +182,15 @@ and failure ds exn =
   icon#set_icon_size `DIALOG;
   GToolbox.message_box ~title ~icon msg
 
+(* Perform action to open the named libvirt URI. *)
+and connect ds uri =
+  (match uri with
+   | None -> ds.set_statusbar "Connecting to default libvirt ...";
+   | Some uri -> ds.set_statusbar (sprintf "Connecting to %s ..." uri));
+  ds.clear_notebook ();
+  Slave.discard_command_queue ();
+  Slave.connect uri (connected ds uri)
+
 (* This is called in the main thread when we've connected to libvirt. *)
 and connected ds uri () =
   debug "thread id %d: connected callback" (Thread.id (Thread.self ()));
@@ -193,18 +208,33 @@ and got_domains ds doms =
     (Thread.id (Thread.self ())) (String.concat " " doms);
   ds.set_vmlist doms
 
+(* Perform action to open the named domain. *)
+and open_domain ds name =
+  ds.set_statusbar (sprintf "Opening %s ..." name);
+  ds.clear_notebook ();
+  Slave.discard_command_queue ();
+  Slave.open_domain name (opened_domain ds)
+
 (* This callback indicates that the domain was opened successfully. *)
 and opened_domain ds rw =
   debug "thread id %d: opened_domain callback" (Thread.id (Thread.self ()));
-  opened ds rw
+  _opened ds rw
+
+(* Perform action of opening disk image(s). *)
+and open_images ds images =
+  ds.set_statusbar (sprintf "Opening disk image %s ..."
+                      (String.concat " " images));
+  ds.clear_notebook ();
+  Slave.discard_command_queue ();
+  Slave.open_images images (opened_images ds)
 
 (* This callback indicates that local disk image(s) were opened successfully.*)
 and opened_images ds rw =
   debug "thread id %d: opened_images callback" (Thread.id (Thread.self ()));
-  opened ds rw
+  _opened ds rw
 
-and opened ds rw =
-  ds.clear_statusbar ();
+and _opened ds rw =
+  ds.set_statusbar ("Opening filesystems ...");
   ds.clear_notebook ();
 
   (* Get the list of mountable filesystems. *)
@@ -214,6 +244,8 @@ and opened ds rw =
  * found in a guest.
  *)
 and got_volume ds rw vol =
+  ds.clear_statusbar ();
+
   let dev = vol.Slave.vol_device in
   debug "thread id %d: got_volume callback: %s"
     (Thread.id (Thread.self ())) dev;
@@ -312,20 +344,41 @@ and got_volume ds rw vol =
   )
 
 (* Open the connect to libvirt dialog. *)
-and connect_dialog ds () =
-  debug "connect menu";
-  (*ds.clear_notebook ();*)
-  (*Slave.discard_command_queue ();*)
-  (* XXX NOT IMPL XXX *)
-  ()
-
-(* Open the disk images dialog. *)
-and open_dialog ds () =
-  debug "open menu";
-  (*ds.clear_notebook ();*)
-  (*Slave.discard_command_queue ();*)
-  (* XXX NOT IMPL XXX *)
-  ()
+and connect_uri_dialog ds () =
+  debug "connect_uri_dialog";
+  let title = "Choose a libvirt URI" in
+  let ok = "Connect to libvirt" in
+  let text = "NB: Remote storage cannot be accessed, so entering
+a libvirt remote URI here will probably not work." in
+  let uri = GToolbox.input_string ~title ~ok text in
+  match uri with
+  | None -> debug "connect_uri_dialog cancelled"; ()
+  | Some "" -> debug "connect to default"; connect ds None
+  | (Some s) as uri -> debug "connect to %s" s; connect ds uri
+
+(* Open the disk images dialog.
+ * XXX This can only deal with a single disk image at the moment, but
+ * underlying code can deal with multiple.
+ *)
+and open_image_dialog ds () =
+  let title = "Choose a disk image" in
+  let dlg = GWindow.file_chooser_dialog ~action:`OPEN ~title ~modal:true () in
+  dlg#add_button "Open disk image" `OPEN_IMAGE;
+  dlg#add_button "Close" `DELETE_EVENT;
+
+  let callback = function
+    | `DELETE_EVENT -> debug "DELETE_EVENT response"; dlg#destroy ()
+    | `OPEN_IMAGE ->
+        match dlg#filename with
+        | None -> () (* nothing selected in dialog, keep dialog open *)
+        | Some filename ->
+            debug "OPEN_IMAGE response, filename = %s" filename;
+            dlg#destroy ();
+            open_images ds [filename]
+  in
+  ignore (dlg#connect#response ~callback);
+
+  dlg#show ()
 
 (* The introductory text which appears in the tabbed notebook to
  * tell the user how to start.  XXX We should add images.
@@ -340,7 +393,5 @@ and intro_label () =
 
 let run_cli_request ds = function
   | Cmdline.Empty_window -> ()
-  | Cmdline.Connect_to_libvirt uri ->
-      Slave.connect uri (connected ds uri)
-  | Cmdline.Open_disk_image images ->
-      Slave.open_images images (opened_images ds)
+  | Cmdline.Connect_to_libvirt uri -> connect ds uri
+  | Cmdline.Open_disk_image images -> open_images ds images