source_tab.ml

   1 (* Virt resize UI.
   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 Slave_types
  22 open Utils
  23
  24 type file_input = {
  25   file_button : GButton.radio_button;
  26   file_chooser : GFile.chooser_button;
  27   file_format_raw : GButton.radio_button;
  28   file_format_qcow2 : GButton.radio_button;
  29   file_format_detect : GButton.radio_button;
  30   file_open_button : GButton.button;
  31 }
  32
  33 let file_input_set_sensitive t b =
  34   t.file_chooser#misc#set_sensitive b;
  35   t.file_format_raw#misc#set_sensitive b;
  36   t.file_format_qcow2#misc#set_sensitive b;
  37   t.file_format_detect#misc#set_sensitive b;
  38   t.file_open_button#misc#set_sensitive b
  39
  40 type libvirt_input = {
  41   libvirt_button : GButton.radio_button;
  42   libvirt_combo : GEdit.combo;
  43 }
  44
  45 let libvirt_input_set_sensitive t b =
  46   t.libvirt_combo#misc#set_sensitive b
  47
  48 type inspection = {
  49   inspection_label : GMisc.label;
  50 }
  51
  52 class tab
  53   (tbl : GPack.table) ready_signal not_ready_signal
  54   file_input libvirt_input inspection =
  55 object (self)
  56   inherit GObj.widget (tbl#as_widget)
  57   inherit GUtil.ml_signals [ready_signal#disconnect;
  58                             not_ready_signal#disconnect]
  59
  60   (* Signals. *)
  61   method ready : callback:(unit -> unit) -> GtkSignal.id =
  62     ready_signal#connect ~after
  63   method not_ready : callback:(unit -> unit) -> GtkSignal.id =
  64     not_ready_signal#connect ~after
  65
  66   (* This method will be called back when disk image or guest is
  67      opened. *)
  68   method private opened inspection_data =
  69     (* We expect that there are some filesystems in the image,
  70        otherwise fail. *)
  71     if inspection_data.insp_all_filesystems = [] then
  72       inspection.inspection_label#set_text
  73         "error: no filesystems were found in the selected disk image or guest"
  74     else (
  75       (match inspection_data.insp_oses with
  76       | [] ->                           (* no OS, but there were filesystems *)
  77         inspection.inspection_label#set_text
  78           "warning: no operating systems were recognized in this disk image or guest"
  79
  80       | [ os ] ->
  81         let label =
  82           sprintf "%s %s %d.%d"
  83             os.insp_type os.insp_distro
  84             os.insp_major_version os.insp_minor_version in
  85         let label =
  86           if os.insp_product_name <> "" then
  87             label ^ " (" ^ os.insp_product_name ^ ")"
  88           else
  89             label in
  90         inspection.inspection_label#set_text label
  91
  92       | _ ->
  93         inspection.inspection_label#set_text
  94           "warning: resizing multi-boot virtual machines may not be successful"
  95       );
  96
  97       (* Raise the ready signal. *)
  98       ready_signal#call ()
  99     )
 100
 101   initializer
 102     (* Set the inputs to be sensitive according to the state of the
 103        top level radio buttons. *)
 104     let make_sensitive = function
 105       | `FileInput ->
 106         file_input_set_sensitive file_input true;
 107         libvirt_input_set_sensitive libvirt_input false
 108       | `LibvirtInput ->
 109         file_input_set_sensitive file_input false;
 110         libvirt_input_set_sensitive libvirt_input true
 111     in
 112
 113     ignore (
 114       file_input.file_button#connect#toggled ~callback:(
 115         fun () ->
 116           if file_input.file_button#active then
 117             make_sensitive `FileInput
 118           else
 119             make_sensitive `LibvirtInput
 120       )
 121     );
 122     ignore (
 123       libvirt_input.libvirt_button#connect#toggled ~callback:(
 124         fun () ->
 125           if libvirt_input.libvirt_button#active then
 126             make_sensitive `LibvirtInput
 127           else
 128             make_sensitive `FileInput
 129       )
 130     );
 131
 132     (* Default sensitivity. *)
 133     make_sensitive `FileInput;
 134
 135     (* Wire up file dialog. *)
 136     ignore (
 137       file_input.file_open_button#connect#clicked ~callback:(
 138         fun () ->
 139           match file_input.file_chooser#filename with
 140           | None -> ()                    (* nothing selected yet *)
 141           | Some filename ->              (* filename selected *)
 142             let format =
 143               if file_input.file_format_raw#active then Some "raw"
 144               else if file_input.file_format_qcow2#active then Some "qcow2"
 145               else if file_input.file_format_detect#active then None
 146               else assert false in (* shouldn't be possible??? *)
 147             let msg = Slave.Open_images ([filename, format], self#opened) in
 148             Slave.send_message msg
 149       )
 150     )
 151
 152 end
 153
 154 let tab () =
 155   let tbl = GPack.table ~border_width:8 ~columns:2 ~rows:1 () in
 156
 157   (* Signals. *)
 158   let ready_signal = new GUtil.signal () in
 159   let not_ready_signal = new GUtil.signal () in
 160
 161   let file_input =
 162     let button =
 163       GButton.radio_button ~label:"File or device:"
 164         ~packing:(tbl#attach ~top:0 ~left:0) () in
 165     let chooser =
 166       GFile.chooser_button ~action:`OPEN
 167         ~packing:(tbl#attach ~top:0 ~left:1) () in
 168     (* We have an "unnecessary" open button here for a couple of
 169        reasons: Firstly because lablgtk2 doesn't bind the file-set
 170        callback, so we can't tell when a file has been picked in the
 171        file chooser.  But secondly because it allows the user to pick
 172        a file and the format before actually opening the file (which
 173        could be an expensive operation).  *)
 174     let open_button =
 175       GButton.button ~label:"Open"
 176         ~packing:(tbl#attach ~top:0 ~left:2) () in
 177     let raw = GButton.radio_button ~label:"raw"
 178       ~packing:(tbl#attach ~top:1 ~left:1) () in
 179     let group = raw#group in
 180     let qcow2 = GButton.radio_button ~label:"qcow2" ~group
 181       ~packing:(tbl#attach ~top:2 ~left:1) () in
 182     let detect = GButton.radio_button ~label:"autodetect format"
 183       ~group ~active:true
 184       ~packing:(tbl#attach ~top:3 ~left:1) () in
 185     { file_button = button; file_chooser = chooser;
 186       file_format_raw = raw; file_format_qcow2 = qcow2;
 187       file_format_detect = detect;
 188       file_open_button = open_button } in
 189
 190   (* Add a dummy row as a spacer. *)
 191   ignore (GMisc.label ~packing:(tbl#attach ~top:4 ~left:0) ());
 192   tbl#set_row_spacing 4 16;
 193
 194   let libvirt_input =
 195     let group = file_input.file_button#group in
 196     let button =
 197       GButton.radio_button ~label:"Guest:" ~group
 198         ~packing:(tbl#attach ~top:5 ~left:0) () in
 199     let combo =
 200       GEdit.combo ~packing:(tbl#attach ~top:5 ~left:1) () in
 201     { libvirt_button = button; libvirt_combo = combo } in
 202
 203   (* Add a dummy row as a spacer. *)
 204   ignore (GMisc.label ~packing:(tbl#attach ~top:6 ~left:0) ());
 205   tbl#set_row_spacing 6 16;
 206
 207   let inspection =
 208     let label = GMisc.label ~packing:(tbl#attach ~top:7 ~left:0 ~right:2) () in
 209     { inspection_label = label } in
 210
 211   (* Return the object. *)
 212   new tab tbl ready_signal not_ready_signal
 213     file_input libvirt_input inspection