(* Guestfs Browser.
* Copyright (C) 2011 Red Hat Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License along
* with this program; if not, write to the Free Software Foundation, Inc.,
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
open Printf
open Utils
open Slave_types
module G = Guestfs
let rec inspection_dialog tree os =
debug "inspection dialog";
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;
(* 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. *)
let sigid =
tree#clear_tree ~callback:(
fun () ->
debug "inspection clear_tree -> destroy dialog";
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 "%s" (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 "%s" (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