Basic inspection data.

diff --git a/.depend b/.depend
index 984a66e..af5fe13 100644 (file)
--- a/.depend
+++ b/.depend
@@ -40,8 +40,8 @@ op_file_information.cmi: filetree.cmi
 op_file_information.cmo: utils.cmi slave.cmi op_file_information.cmi
 op_file_information.cmx: utils.cmx slave.cmx op_file_information.cmi
 op_inspection_dialog.cmi: slave_types.cmi filetree.cmi
-op_inspection_dialog.cmo: utils.cmi filetree.cmi op_inspection_dialog.cmi
-op_inspection_dialog.cmx: utils.cmx filetree.cmx op_inspection_dialog.cmi
+op_inspection_dialog.cmo: utils.cmi slave_types.cmi slave.cmi op_inspection_dialog.cmi
+op_inspection_dialog.cmx: utils.cmx slave_types.cmx slave.cmx op_inspection_dialog.cmi
 op_view_file.cmi: filetree.cmi
 op_view_file.cmo: utils.cmi slave.cmi op_view_file.cmi
 op_view_file.cmx: utils.cmx slave.cmx op_view_file.cmi

diff --git a/op_inspection_dialog.ml b/op_inspection_dialog.ml
index f1b17da..2e84ded 100644 (file)
--- a/op_inspection_dialog.ml
+++ b/op_inspection_dialog.ml
@@ -20,18 +20,187 @@ open Printf
 
 open Utils
 
-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 d = GWindow.dialog ~title () in
+
+  (* Fill in the basic information. *)
+  let packing : GObj.widget -> unit = d#vbox#add in
+  let vbox = frame ~label:"Basic information" ~packing () 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.Slave_types.insp_product_name;
+  wide tbl 1 "Hostname: " os.Slave_types.insp_hostname;
+
+  simple tbl 2 0 "OS type: " os.Slave_types.insp_type;
+  simple tbl 3 0 "Distro: " os.Slave_types.insp_distro;
+  simple tbl 4 0 "Version: "
+    (sprintf "%d.%d"
+       os.Slave_types.insp_major_version
+       os.Slave_types.insp_minor_version);
+  simple tbl 5 0 "Product variant: " os.Slave_types.insp_product_variant;
+
+  simple tbl 2 2 "Root: " os.Slave_types.insp_root;
+  simple tbl 3 2 "Arch: " os.Slave_types.insp_arch;
+  simple tbl 4 2 "Package mgr: " os.Slave_types.insp_package_management;
+  simple tbl 5 2 "Package fmt: " os.Slave_types.insp_package_format;
+
+  (match os.Slave_types.insp_windows_systemroot with
+   | None -> ()
+   | Some systemroot ->
+       simple tbl 6 0 "%systemroot%: " systemroot
+  );
+  (match os.Slave_types.insp_windows_current_control_set with
+   | None -> ()
+   | Some ccs ->
+       simple tbl 6 2 "CurrentControlSet: " ccs
+  );
+
+  (* Applications. *)
+  let vbox = frame ~label:"Applications" ~packing:d#vbox#add () in
+  applications_view ~packing:vbox#add os;
+
+  (* Mountpoints. *)
+  let vbox = frame ~label:"Mount points" ~packing:d#vbox#add () in
+  two_column_view ~title1:"Mount" ~title2:"Filesystem"
+    ~packing:vbox#add os.Slave_types.insp_mountpoints;
 
-  dlg#show ();
+  (* Filesystems. *)
+  let vbox = frame ~label:"Filesystems" ~packing:d#vbox#add () in
+  one_column_view  ~title:"Filesystem" ~packing:vbox#add
+    (Array.to_list os.Slave_types.insp_filesystems);
+
+  (* Drive mappings. *)
+  (match os.Slave_types.insp_drive_mappings with
+   | [] -> ()
+   | mappings ->
+       let vbox = frame ~label:"Drives" ~packing:d#vbox#add () 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 frame ?label ?packing () =
+  let frame = GBin.frame ?label ?packing () in
+  GPack.vbox ~border_width:8 ~packing:frame#add ()
+
+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 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 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 ~height:150 ~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

diff --git a/op_inspection_dialog.mli b/op_inspection_dialog.mli
index 9e9901c..1d2cb8a 100644 (file)
--- a/op_inspection_dialog.mli
+++ b/op_inspection_dialog.mli
@@ -19,8 +19,8 @@
 (** Operating system inspection data dialog. *)
 
 val inspection_dialog : Filetree.tree -> Slave_types.inspection_os -> unit
-  (** [dialog tree os] creates a operating system inspection
-      dialog, displaying the inspection data from [os].
+  (** [inspection_dialog tree os] creates a operating system
+      inspection dialog, displaying the inspection data from [os].
 
       [tree] is passed here just so that we can register a
       signal to destroy the dialog when the tree is cleared. *)

diff --git a/slave.ml b/slave.ml
index 412d183..034bbdf 100644 (file)
--- a/slave.ml
+++ b/slave.ml
@@ -47,6 +47,7 @@ type command =
   | Download_dir_tarball of source * string * download_dir_tarball_format * string * unit callback
   | Download_file of source * string * string * bool * unit callback
   | File_information of source * string * string callback
+  | List_applications of inspection_os * G.application array 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
@@ -73,6 +74,8 @@ let rec string_of_command = function
         (string_of_source src) remotefile localfile check
   | File_information (src, pathname, _) ->
       sprintf "File_information (%s, %s)" (string_of_source src) pathname
+  | List_applications (os, _) ->
+      sprintf "List_applications %s" os.insp_root
   | Open_domain (name, _) -> sprintf "Open_domain %s" name
   | Open_images (images, _) ->
       sprintf "Open_images %s" (string_of_images images)
@@ -165,6 +168,8 @@ let download_file_if_not_exist ?fail src remotefile localfile cb =
   send_to_slave ?fail (Download_file (src, remotefile, localfile, true, cb))
 let file_information ?fail src pathname cb =
   send_to_slave ?fail (File_information (src, pathname, cb))
+let list_applications ?fail os cb =
+  send_to_slave ?fail (List_applications (os, 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 =
@@ -338,6 +343,19 @@ and execute_command = function
       status "Finished calculating file information for %s" pathname;
       callback_if_not_discarded cb r
 
+  | List_applications (os, cb) ->
+      status "Listing applications ...";
+
+      let g = get_g () in
+      let r =
+        with_mount_ro g (OS os) (
+          fun () ->
+            g#inspect_list_applications os.insp_root
+        ) in
+
+      status "Finished listing applications";
+      callback_if_not_discarded cb r
+
   | Open_domain (name, cb) ->
       status "Opening %s ..." name;
 
@@ -561,6 +579,7 @@ and open_disk_images images cb =
         insp_package_format = g#inspect_get_package_format root;
         insp_package_management = g#inspect_get_package_management root;
         insp_product_name = g#inspect_get_product_name root;
+        insp_product_variant = g#inspect_get_product_variant root;
         insp_type = typ;
         insp_windows_current_control_set = windows_current_control_set;
         insp_windows_systemroot = windows_systemroot;

diff --git a/slave.mli b/slave.mli
index 57ce332..c1fdb04 100644 (file)
--- a/slave.mli
+++ b/slave.mli
@@ -113,6 +113,10 @@ val file_information : ?fail:exn callback -> Slave_types.source -> string -> str
   (** [file_information src pathname cb] calculates the file
       information of the file [pathname]. *)
 
+val list_applications : ?fail:exn callback -> Slave_types.inspection_os -> Guestfs.application array callback -> unit
+  (** [list_applications os cb] lists the applications in the
+      guest using libguestfs inspection. *)
+
 val open_domain : ?fail:exn callback -> string -> Slave_types.inspection_data callback -> unit
   (** [open_domain name cb] retrieves the list of block devices for
       the libvirt domain [name], creates a libguestfs handle, adds

diff --git a/slave_types.ml b/slave_types.ml
index ea6c75c..f6d2122 100644 (file)
--- a/slave_types.ml
+++ b/slave_types.ml
@@ -43,6 +43,7 @@ and inspection_os = {
   insp_package_format : string;
   insp_package_management : string;
   insp_product_name : string;
+  insp_product_variant : string;
   insp_type : string;
   insp_windows_current_control_set : string option;
   insp_windows_systemroot : string option;

diff --git a/slave_types.mli b/slave_types.mli
index ee897a5..fb24186 100644 (file)
--- a/slave_types.mli
+++ b/slave_types.mli
@@ -47,6 +47,7 @@ and inspection_os = {
   insp_package_format : string;
   insp_package_management : string;
   insp_product_name : string;
+  insp_product_variant : string;
   insp_type : string;
   insp_windows_current_control_set : string option;
   insp_windows_systemroot : string option;