open Printf
open Utils
+open Slave_types
-let inspection_dialog (tree : Filetree.tree) os =
+module G = Guestfs
+
+let rec inspection_dialog tree os =
debug "inspection dialog";
- let title = "Inspection data" in
- let dlg = GWindow.dialog ~title () in
+ let title = "Operating system information" in
+ let d = GWindow.dialog ~width:500 ~height:600 ~title () in
+
+ let nb = GPack.notebook ~packing:d#vbox#add () in
+
+ (* Fill in the basic information. *)
+ let vbox = tab "Basic information" nb in
+ let tbl = GPack.table ~columns:4 ~rows:1 ~packing:vbox#add () in
+ tbl#set_col_spacings 8;
+ tbl#set_row_spacings 8;
+
+ wide tbl 0 "Product name: " os.insp_product_name;
+ wide tbl 1 "Hostname: " os.insp_hostname;
+
+ simple tbl 2 0 "OS type: " os.insp_type;
+ simple tbl 3 0 "Distro: " os.insp_distro;
+ simple tbl 4 0 "Version: "
+ (sprintf "%d.%d"
+ os.insp_major_version
+ os.insp_minor_version);
+ simple tbl 5 0 "Product variant: " os.insp_product_variant;
+
+ simple tbl 2 2 "Root: " os.insp_root;
+ simple tbl 3 2 "Arch: " os.insp_arch;
+ simple tbl 4 2 "Package mgr: " os.insp_package_management;
+ simple tbl 5 2 "Package fmt: " os.insp_package_format;
+
+ (match os.insp_windows_systemroot with
+ | None -> ()
+ | Some systemroot ->
+ simple tbl 6 0 "%systemroot%: " systemroot
+ );
+ (match os.insp_windows_current_control_set with
+ | None -> ()
+ | Some ccs ->
+ simple tbl 6 2 "CurrentControlSet: " ccs
+ );
+
+ (* Applications. *)
+ let vbox = tab "Applications" nb in
+ applications_view ~packing:vbox#add os;
+
+ (* Mountpoints. *)
+ let vbox = tab "Mount points" nb in
+ two_column_view ~title1:"Mount" ~title2:"Filesystem"
+ ~packing:vbox#add os.insp_mountpoints;
- dlg#show ();
+ (* Filesystems. *)
+ let vbox = tab "Filesystems" nb in
+ one_column_view ~title:"Filesystem" ~packing:vbox#add
+ (Array.to_list os.insp_filesystems);
+
+ (* Drive mappings. *)
+ (match os.insp_drive_mappings with
+ | [] -> ()
+ | mappings ->
+ let vbox = tab "Drive letters" nb in
+ two_column_view ~title1:"Drive letter" ~title2:"Filesystem"
+ ~packing:vbox#add mappings
+ );
(* Make sure dialog is destroyed when the tree is cleared. *)
- ignore (
+ let sigid =
tree#clear_tree ~callback:(
fun () ->
debug "inspection clear_tree -> destroy dialog";
- dlg#destroy ()
- )
- )
+ d#destroy ()
+ ) in
+
+ let destroy_dialog () =
+ tree#disconnect sigid;
+ d#destroy ()
+ in
+
+ (* Add a close button. *)
+ let close_button = GButton.button ~label:"Close"
+ ~packing:d#action_area#add () in
+ ignore (close_button#connect#clicked ~callback:destroy_dialog);
+
+ (* Destroy dialog when WM close button is pressed. *)
+ ignore (d#connect#destroy ~callback:destroy_dialog);
+
+ d#show ()
+
+(* Helper functions. *)
+and tab text nb =
+ let vbox = GPack.vbox ~border_width:8 () in
+ let tab_label = (GMisc.label ~text () :> GObj.widget) in
+ ignore (nb#append_page ~tab_label (vbox :> GObj.widget));
+ vbox
+
+and simple tbl top left label text =
+ let markup = sprintf "<b>%s</b>" (markup_escape text) in
+ ignore (GMisc.label ~xalign:1. ~text:label
+ ~packing:(tbl#attach ~top ~left) ());
+ let left = left + 1 in
+ ignore (GMisc.label ~xalign:0. ~markup ~packing:(tbl#attach ~top ~left) ());
+
+and wide tbl top label text =
+ let markup = sprintf "<b>%s</b>" (markup_escape text) in
+ ignore (GMisc.label ~xalign:1.
+ ~text:label ~packing:(tbl#attach ~top ~left:0) ());
+ ignore (GMisc.label ~xalign:0.
+ ~markup ~packing:(tbl#attach ~top ~left:1 ~right:4) ());
+
+and one_column_view ~title ?packing data =
+ let data = List.sort compare data in
+ let model, c1 = GTree.store_of_list Gobject.Data.string data in
+
+ let sw =
+ GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
+
+ let view = GTree.view ~model ~packing:sw#add () in
+ view#selection#set_mode `NONE;
+
+ let renderer = GTree.cell_renderer_text [], ["text", c1] in
+ let vc = GTree.view_column ~title ~renderer () in
+ vc#set_resizable true;
+ ignore (view#append_column vc)
+
+and two_column_view ~title1 ~title2 ?packing data =
+ let data = List.sort compare data in
+
+ let cols = new GTree.column_list in
+ let c1 = cols#add Gobject.Data.string in
+ let c2 = cols#add Gobject.Data.string in
+
+ let model = GTree.list_store cols in
+ List.iter (
+ fun (d1, d2) ->
+ let row = model#append () in
+ model#set ~row ~column:c1 d1;
+ model#set ~row ~column:c2 d2
+ ) data;
+
+ let sw =
+ GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
+
+ let view = GTree.view ~model ~packing:sw#add () in
+ view#selection#set_mode `NONE;
+
+ let renderer = GTree.cell_renderer_text [], ["text", c1] in
+ let vc = GTree.view_column ~title:title1 ~renderer () in
+ vc#set_resizable true;
+ ignore (view#append_column vc);
+ let renderer = GTree.cell_renderer_text [], ["text", c2] in
+ let vc = GTree.view_column ~title:title2 ~renderer () in
+ vc#set_resizable true;
+ ignore (view#append_column vc)
+
+(* Applications view: populated after a round-trip to the slave thread. *)
+and applications_view ?packing os =
+ let cols = new GTree.column_list in
+ let name_col = cols#add Gobject.Data.string in
+ let version_col = cols#add Gobject.Data.string in
+
+ let model = GTree.list_store cols in
+
+ let sw =
+ GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
+
+ let view = GTree.view ~model ~packing:sw#add () in
+ view#selection#set_mode `NONE;
+
+ let renderer = GTree.cell_renderer_text [], ["text", name_col] in
+ let vc = GTree.view_column ~title:"Name" ~renderer () in
+ vc#set_resizable true;
+ ignore (view#append_column vc);
+ let renderer = GTree.cell_renderer_text [], ["text", version_col] in
+ let vc = GTree.view_column ~title:"Version" ~renderer () in
+ vc#set_resizable true;
+ ignore (view#append_column vc);
+
+ Slave.list_applications os
+ (when_applications_loaded model name_col version_col)
+
+and when_applications_loaded model name_col version_col apps =
+ Array.iter (
+ fun { G.app_name = name; app_display_name = display_name;
+ app_version = version; app_release = release } ->
+ let name = if display_name <> "" then display_name else name in
+ let version = version ^ if release <> "" then "-"^release else "" in
+ let row = model#append () in
+ model#set ~row ~column:name_col name;
+ model#set ~row ~column:version_col version
+ ) apps
git.annexia.org / guestfs-browser.git / blobdiff