-(* This callback is called once for each mountable filesystem that is
- * 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;
-
- (* What's on the tab. *)
- let tab =
- match vol.Slave.vol_label with
- | "" -> sprintf "%s" dev
- | label -> sprintf "%s (%s)" dev label in
-
- (* What's on the notebook page. *)
- let page =
- let vbox = GPack.vbox () in
-
- (* VFS stats table. *)
-
- (* For calculations, see libguestfs/tools/virt-df. *)
- let st = vol.Slave.vol_statvfs in
- let factor = st.G.bsize /^ 1024L in
-
- (* Right-aligned label with width, for stats table. *)
- let mklabelh text =
- let markup = "<b>" ^ text ^ "</b>" in
- let label = GMisc.label ~markup ~xalign:1. () in
- label#set_width_chars 12;
- (label :> GObj.widget)
- and mklabelr text =
- let label = GMisc.label ~text ~selectable:true ~xalign:1. () in
- label#set_width_chars 12;
- (label :> GObj.widget)
- in
-
- let stats = GPack.table ~columns:4 ~rows:5
- ~homogeneous:true ~col_spacings:4 ~row_spacings:4
- ~packing:vbox#pack () in
- stats#attach ~top:0 ~left:0 (mklabelh "1K-blocks");
- stats#attach ~top:0 ~left:1 (mklabelh "Used");
- stats#attach ~top:0 ~left:2 (mklabelh "Available");
- stats#attach ~top:0 ~left:3 (mklabelh "Use%");
- let blocks = st.G.blocks *^ factor in
- stats#attach ~top:1 ~left:0 (mklabelr (sprintf "%Ld" blocks));
- let used = (st.G.blocks -^ st.G.bfree) *^ factor in
- stats#attach ~top:1 ~left:1 (mklabelr (sprintf "%Ld" used));
- let available = st.G.bavail *^ factor in
- stats#attach ~top:1 ~left:2 (mklabelr (sprintf "%Ld" available));
- stats#attach ~top:1 ~left:3
- (mklabelr (sprintf "%Ld%%" (100L -^ 100L *^ st.G.bfree /^ st.G.blocks)));
- stats#attach ~top:2 ~left:0 (mklabelr ("= " ^ human_size_1k blocks));
- stats#attach ~top:2 ~left:1 (mklabelr ("= " ^ human_size_1k used));
- stats#attach ~top:2 ~left:2 (mklabelr ("= " ^ human_size_1k available));
- stats#attach ~top:3 ~left:0 (mklabelh "Inodes");
- stats#attach ~top:3 ~left:1 (mklabelh "IUsed");
- stats#attach ~top:3 ~left:2 (mklabelh "IFree");
- stats#attach ~top:3 ~left:3 (mklabelh "IUse%");
- stats#attach ~top:4 ~left:0 (mklabelr (sprintf "%Ld" st.G.files));
- stats#attach ~top:4 ~left:1
- (mklabelr (sprintf "%Ld" (st.G.files -^ st.G.ffree)));
- stats#attach ~top:4 ~left:2 (mklabelr (sprintf "%Ld" st.G.ffree));
- stats#attach ~top:4 ~left:3
- (mklabelr (sprintf "%Ld%%" (100L -^ 100L *^ st.G.ffree /^ st.G.files)));
-
- (* Info table. *)
-
- (* Left- and right-aligned labels, for info table. *)
- let mklabelr text =
- let label = GMisc.label ~text ~xalign:1. () in
- label#set_width_chars 9;
- (label :> GObj.widget)
- and mklabell text =
- let label = GMisc.label ~text ~selectable:true ~xalign:0. () in
- (label :> GObj.widget)
- in
-
- let info = GPack.table ~columns:4 ~rows:2
- ~col_spacings:4 ~row_spacings:4
- ~packing:vbox#pack () in
- info#attach ~top:0 ~left:0 (mklabelr "FS label:");
- info#attach ~top:0 ~left:1 (mklabell vol.Slave.vol_label);
- info#attach ~top:1 ~left:0 (mklabelr "FS type:");
- info#attach ~top:1 ~left:1 (mklabell vol.Slave.vol_type);
- info#attach ~top:0 ~left:2 (mklabelr "FS UUID:");
- info#attach ~top:0 ~left:3 (mklabell vol.Slave.vol_uuid);
- info#attach ~top:1 ~left:2 (mklabelr "Device:");
- info#attach ~top:1 ~left:3 (mklabell dev);
-
- (* Files display. *)
- let sw = GBin.scrolled_window
- ~packing:(vbox#pack ~expand:true ~fill:true)
- ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
- let view = Filetree.filetree dev rw in
- sw#add (view :> GObj.widget);
-
- vbox in
- ignore (
- ds.notebook#append_page ~tab_label:(mklabel tab) (page :> GObj.widget)
- )
-
-(* Open the connect to libvirt dialog. *)
-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]