op_inspection_dialog.ml

   1 (* Guestfs Browser.
   2  * Copyright (C) 2011 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17  *)
  18
  19 open Printf
  20
  21 open Utils
  22
  23 module G = Guestfs
  24
  25 let rec inspection_dialog tree os =
  26   debug "inspection dialog";
  27   let title = "Inspection data" in
  28   let d = GWindow.dialog ~title () in
  29
  30   (* Fill in the basic information. *)
  31   let packing : GObj.widget -> unit = d#vbox#add in
  32   let vbox = frame ~label:"Basic information" ~packing () in
  33   let tbl = GPack.table ~columns:4 ~rows:1 ~packing:vbox#add () in
  34   tbl#set_col_spacings 8;
  35   tbl#set_row_spacings 8;
  36
  37   wide tbl 0 "Product name: " os.Slave_types.insp_product_name;
  38   wide tbl 1 "Hostname: " os.Slave_types.insp_hostname;
  39
  40   simple tbl 2 0 "OS type: " os.Slave_types.insp_type;
  41   simple tbl 3 0 "Distro: " os.Slave_types.insp_distro;
  42   simple tbl 4 0 "Version: "
  43     (sprintf "%d.%d"
  44        os.Slave_types.insp_major_version
  45        os.Slave_types.insp_minor_version);
  46   simple tbl 5 0 "Product variant: " os.Slave_types.insp_product_variant;
  47
  48   simple tbl 2 2 "Root: " os.Slave_types.insp_root;
  49   simple tbl 3 2 "Arch: " os.Slave_types.insp_arch;
  50   simple tbl 4 2 "Package mgr: " os.Slave_types.insp_package_management;
  51   simple tbl 5 2 "Package fmt: " os.Slave_types.insp_package_format;
  52
  53   (match os.Slave_types.insp_windows_systemroot with
  54    | None -> ()
  55    | Some systemroot ->
  56        simple tbl 6 0 "%systemroot%: " systemroot
  57   );
  58   (match os.Slave_types.insp_windows_current_control_set with
  59    | None -> ()
  60    | Some ccs ->
  61        simple tbl 6 2 "CurrentControlSet: " ccs
  62   );
  63
  64   (* Applications. *)
  65   let vbox = frame ~label:"Applications" ~packing:d#vbox#add () in
  66   applications_view ~packing:vbox#add os;
  67
  68   (* Mountpoints. *)
  69   let vbox = frame ~label:"Mount points" ~packing:d#vbox#add () in
  70   two_column_view ~title1:"Mount" ~title2:"Filesystem"
  71     ~packing:vbox#add os.Slave_types.insp_mountpoints;
  72
  73   (* Filesystems. *)
  74   let vbox = frame ~label:"Filesystems" ~packing:d#vbox#add () in
  75   one_column_view  ~title:"Filesystem" ~packing:vbox#add
  76     (Array.to_list os.Slave_types.insp_filesystems);
  77
  78   (* Drive mappings. *)
  79   (match os.Slave_types.insp_drive_mappings with
  80    | [] -> ()
  81    | mappings ->
  82        let vbox = frame ~label:"Drives" ~packing:d#vbox#add () in
  83        two_column_view ~title1:"Drive letter" ~title2:"Filesystem"
  84          ~packing:vbox#add mappings
  85   );
  86
  87   (* Make sure dialog is destroyed when the tree is cleared. *)
  88   let sigid =
  89     tree#clear_tree ~callback:(
  90       fun () ->
  91         debug "inspection clear_tree -> destroy dialog";
  92         d#destroy ()
  93     ) in
  94
  95   let destroy_dialog () =
  96     tree#disconnect sigid;
  97     d#destroy ()
  98   in
  99
 100   (* Add a close button. *)
 101   let close_button = GButton.button ~label:"Close"
 102     ~packing:d#action_area#add () in
 103   ignore (close_button#connect#clicked ~callback:destroy_dialog);
 104
 105   (* Destroy dialog when WM close button is pressed. *)
 106   ignore (d#connect#destroy ~callback:destroy_dialog);
 107
 108   d#show ()
 109
 110 (* Helper functions. *)
 111 and frame ?label ?packing () =
 112   let frame = GBin.frame ?label ?packing () in
 113   GPack.vbox ~border_width:8 ~packing:frame#add ()
 114
 115 and simple tbl top left label text =
 116   let markup = sprintf "<b>%s</b>" (markup_escape text) in
 117   ignore (GMisc.label ~xalign:1. ~text:label
 118             ~packing:(tbl#attach ~top ~left) ());
 119   let left = left + 1 in
 120   ignore (GMisc.label ~xalign:0. ~markup ~packing:(tbl#attach ~top ~left) ());
 121
 122 and wide tbl top label text =
 123   let markup = sprintf "<b>%s</b>" (markup_escape text) in
 124   ignore (GMisc.label ~xalign:1.
 125             ~text:label ~packing:(tbl#attach ~top ~left:0) ());
 126   ignore (GMisc.label ~xalign:0.
 127             ~markup ~packing:(tbl#attach ~top ~left:1 ~right:4) ());
 128
 129 and one_column_view ~title ?packing data =
 130   let model, c1 = GTree.store_of_list Gobject.Data.string data in
 131
 132   let sw =
 133     GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
 134
 135   let view = GTree.view ~model ~packing:sw#add () in
 136   view#selection#set_mode `NONE;
 137
 138   let renderer = GTree.cell_renderer_text [], ["text", c1] in
 139   let vc = GTree.view_column ~title ~renderer () in
 140   vc#set_resizable true;
 141   ignore (view#append_column vc)
 142
 143 and two_column_view ~title1 ~title2 ?packing data =
 144   let cols = new GTree.column_list in
 145   let c1 = cols#add Gobject.Data.string in
 146   let c2 = cols#add Gobject.Data.string in
 147
 148   let model = GTree.list_store cols in
 149   List.iter (
 150     fun (d1, d2) ->
 151       let row = model#append () in
 152       model#set ~row ~column:c1 d1;
 153       model#set ~row ~column:c2 d2
 154   ) data;
 155
 156   let sw =
 157     GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
 158
 159   let view = GTree.view ~model ~packing:sw#add () in
 160   view#selection#set_mode `NONE;
 161
 162   let renderer = GTree.cell_renderer_text [], ["text", c1] in
 163   let vc = GTree.view_column ~title:title1 ~renderer () in
 164   vc#set_resizable true;
 165   ignore (view#append_column vc);
 166   let renderer = GTree.cell_renderer_text [], ["text", c2] in
 167   let vc = GTree.view_column ~title:title2 ~renderer () in
 168   vc#set_resizable true;
 169   ignore (view#append_column vc)
 170
 171 (* Applications view: populated after a round-trip to the slave thread. *)
 172 and applications_view ?packing os =
 173   let cols = new GTree.column_list in
 174   let name_col = cols#add Gobject.Data.string in
 175   let version_col = cols#add Gobject.Data.string in
 176
 177   let model = GTree.list_store cols in
 178
 179   let sw =
 180     GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in
 181
 182   let view = GTree.view ~model ~height:150 ~packing:sw#add () in
 183   view#selection#set_mode `NONE;
 184
 185   let renderer = GTree.cell_renderer_text [], ["text", name_col] in
 186   let vc = GTree.view_column ~title:"Name" ~renderer () in
 187   vc#set_resizable true;
 188   ignore (view#append_column vc);
 189   let renderer = GTree.cell_renderer_text [], ["text", version_col] in
 190   let vc = GTree.view_column ~title:"Version" ~renderer () in
 191   vc#set_resizable true;
 192   ignore (view#append_column vc);
 193
 194   Slave.list_applications os
 195     (when_applications_loaded model name_col version_col)
 196
 197 and when_applications_loaded model name_col version_col apps =
 198   Array.iter (
 199     fun { G.app_name = name; app_display_name = display_name;
 200           app_version = version; app_release = release } ->
 201       let name = if display_name <> "" then display_name else name in
 202       let version = version ^ if release <> "" then "-"^release else "" in
 203       let row = model#append () in
 204       model#set ~row ~column:name_col name;
 205       model#set ~row ~column:version_col version
 206   ) apps