+cmdline.cmi:
+cmdline.cmo: utils.cmi config.cmi cmdline.cmi
+cmdline.cmx: utils.cmx config.cmx cmdline.cmi
config.cmi:
config.cmo: config.cmi
config.cmx: config.cmi
logvols_tab.cmi:
logvols_tab.cmo: logvols_tab.cmi
logvols_tab.cmx: logvols_tab.cmi
-main.cmo: window.cmi slave.cmi
-main.cmx: window.cmx slave.cmx
+main.cmo: window.cmi utils.cmi slave.cmi config.cmi cmdline.cmi
+main.cmx: window.cmx utils.cmx slave.cmx config.cmx cmdline.cmx
partitions_tab.cmi:
partitions_tab.cmo: partitions_tab.cmi
partitions_tab.cmx: partitions_tab.cmi
slave_types.cmi:
slave_types.cmo: slave_types.cmi
slave_types.cmx: slave_types.cmi
-source_tab.cmi:
-source_tab.cmo: utils.cmi slave_types.cmi slave.cmi source_tab.cmi
-source_tab.cmx: utils.cmx slave_types.cmx slave.cmx source_tab.cmi
+source_tab.cmi: cmdline.cmi
+source_tab.cmo: utils.cmi slave_types.cmi slave.cmi cmdline.cmi source_tab.cmi
+source_tab.cmx: utils.cmx slave_types.cmx slave.cmx cmdline.cmx source_tab.cmi
utils.cmi:
utils.cmo: config.cmi utils.cmi
utils.cmx: config.cmx utils.cmi
-window.cmi:
-window.cmo: source_tab.cmi partitions_tab.cmi logvols_tab.cmi destination_tab.cmi window.cmi
-window.cmx: source_tab.cmx partitions_tab.cmx logvols_tab.cmx destination_tab.cmx window.cmi
+window.cmi: source_tab.cmi
+window.cmo: utils.cmi source_tab.cmi partitions_tab.cmi logvols_tab.cmi destination_tab.cmi window.cmi
+window.cmx: utils.cmx source_tab.cmx partitions_tab.cmx logvols_tab.cmx destination_tab.cmx window.cmi
# These are listed here in alphabetical order.
SOURCES = \
+ cmdline.mli \
+ cmdline.ml \
config.mli \
destination_tab.mli \
destination_tab.ml \
OBJECTS = \
config.cmo \
utils.cmo \
+ cmdline.cmo \
slave_types.cmo \
slave.cmo \
source_tab.cmo \
--- /dev/null
+(* Virt resize UI.
+ * 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
+
+type cli_request =
+ | Empty_window
+ | Open_guest of string
+ | Open_images of (string * string option) list
+
+let display_version () =
+ printf "%s %s\n" Config.package Config.version;
+ exit 0
+
+let format = ref None
+let images = ref []
+let guests = ref []
+
+let set_connect = function
+ | "" -> set_connect_uri None
+ | uri -> set_connect_uri (Some uri)
+let set_format = function
+ | "" -> format := None
+ | f -> format := Some f
+let add_image image =
+ images := (image, !format) :: !images
+let add_guest guest =
+ guests := guest :: !guests
+
+(* Parse command line arguments. *)
+let argspec = Arg.align [
+ "-a", Arg.String add_image, "image Open disk image";
+ "--add", Arg.String add_image, "image Open disk image";
+ "-c", Arg.String set_connect, "uri Connect to libvirt URI";
+ "--connect", Arg.String set_connect, "uri Connect to libvirt URI";
+ "-d", Arg.String add_guest, "guest Open libvirt guest";
+ "--domain", Arg.String add_guest, "guest Open libvirt guest";
+ "--format", Arg.String set_format, "format Set format";
+ "-v", Arg.Unit set_verbose_flag, " Enable debugging messages";
+ "--verbose", Arg.Unit set_verbose_flag, " Enable debugging messages";
+ "-V", Arg.Unit display_version, " Display version and exit";
+ "--version", Arg.Unit display_version, " Display version and exit";
+ "-x", Arg.Unit set_trace_flag, " Enable tracing of libguestfs calls";
+]
+
+let prog = Filename.basename Sys.executable_name
+
+let anon_fun _ =
+ raise (Arg.Bad "unknown argument")
+
+let usage_msg =
+ sprintf "\
+%s: graphical guest filesystem browser
+
+Usage:
+ %s
+ Open the program with an empty window.
+
+ %s -a disk.img [-a disk.img [...]]
+ Start with a guest from a disk image file.
+
+ %s -d guest
+ Start with the named libvirt guest.
+
+Options:"
+ prog prog prog prog
+
+let command_line () =
+ Arg.parse argspec anon_fun usage_msg;
+
+ (* Verify number of -a and -d options given on the command line. *)
+ let images = List.rev !images in
+ let guests = List.rev !guests in
+
+ match images, guests with
+ | [], [] -> Empty_window
+ | _, [] -> Open_images images
+ | [], [guest] -> Open_guest guest
+ | [], _ ->
+ failwith "cannot use -d option more than once"
+ | _, _ ->
+ failwith "cannot mix -a and -d options"
--- /dev/null
+(* Virt resize UI.
+ * 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.
+ *)
+
+(** Handle the command line arguments. *)
+
+type cli_request =
+ | Empty_window
+ | Open_guest of string
+ | Open_images of (string * string option) list
+ (** The initial action requested by the user on the command line.
+
+ [Empty_window] means nothing was requested on the command line.
+
+ [Open_guest] means to open a guest (-d option).
+
+ [Open_images] means to open a list of disk images (-a option). *)
+
+val command_line : unit -> cli_request
+ (** Read the command line and return {!cli_request}. *)
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+open Utils
+
let () =
- ignore (new Window.window);
+ let cli_request = Cmdline.command_line () in
+
+ (* If we're in verbose mode, print some debug information which
+ could be useful in bug reports. *)
+ if verbose () then (
+ debug "%s %s" Config.package Config.version;
+ debug "libguestfs %s" (libguestfs_version_string ());
+ debug "libvirt %s" (libvirt_version_string ());
+ );
+
+ (* Create the main window. *)
+ let w = new Window.window in
+
+ (* Wire up hooks that carry messages from the slave thread
+ * to the main thread.
+ *)
+(*
+ Slave.set_failure_hook w#failure;
+ Slave.set_busy_hook w#throbber_busy;
+ Slave.set_idle_hook w#throbber_idle;
+*)
+ Slave.set_status_hook w#set_statusbar;
+ Slave.set_progress_hook w#progress;
+
+ (* What did the user request on the command line? *)
+ w#source_tab#run_cli_request cli_request;
+
+ (* Run the main display thread. When this returns, the application
+ has been closed so force the slave thread to exit. *)
GtkThread.main ();
Slave.exit_thread ()
method private opened inspection_data =
(* We expect that there are some filesystems in the image,
otherwise fail. *)
- if inspection_data.insp_all_filesystems = [] then
- inspection.inspection_label#set_text
- "error: no filesystems were found in the selected disk image or guest"
+ let nr_filesystems = List.length inspection_data.insp_all_filesystems in
+ if nr_filesystems = 0 then
+ inspection.inspection_label#set_label
+ "<b>error: no filesystems were found in the selected disk image or guest</b>"
else (
(match inspection_data.insp_oses with
| [] -> (* no OS, but there were filesystems *)
- inspection.inspection_label#set_text
- "warning: no operating systems were recognized in this disk image or guest"
-
- | [ os ] ->
- let label =
- sprintf "%s %s %d.%d"
- os.insp_type os.insp_distro
- os.insp_major_version os.insp_minor_version in
- let label =
- if os.insp_product_name <> "" then
- label ^ " (" ^ os.insp_product_name ^ ")"
+ let markup =
+ sprintf "%d filesystem(s) found\n<b>warning: no operating systems were recognized in this disk image or guest</b>"
+ nr_filesystems in
+ inspection.inspection_label#set_label markup
+
+ | os :: oses ->
+ let markup =
+ if os.insp_product_name = "" then
+ sprintf "%s %s %d.%d\n"
+ os.insp_type os.insp_distro
+ os.insp_major_version os.insp_minor_version
else
- label in
- inspection.inspection_label#set_text label
+ sprintf "%s\n" (markup_escape os.insp_product_name) in
+ let markup =
+ markup ^ sprintf "with %d filesystem(s)\n" nr_filesystems in
- | _ ->
- inspection.inspection_label#set_text
- "warning: resizing multi-boot virtual machines may not be successful"
+ let markup =
+ if oses <> [] then
+ markup ^ "<b>warning: resizing multi-boot virtual machines may not be successful</b>"
+ else markup in
+
+ inspection.inspection_label#set_label markup
);
(* Raise the ready signal. *)
ready_signal#call ()
)
+ method run_cli_request = function
+ | Cmdline.Empty_window -> ()
+ | Cmdline.Open_images images ->
+ let msg = Slave.Open_images (images, self#opened) in
+ Slave.send_message msg
+ | Cmdline.Open_guest guest ->
+(*
+ (* Open libvirt connection, and in the callback open the guest. *)
+ let uri = connect_uri () in
+ Slave.connect uri (self#when_connected_cli_request guest)
+*)
+ assert false (* XXX not implemented *)
+
initializer
(* Set the inputs to be sensitive according to the state of the
top level radio buttons. *)
let inspection =
let label = GMisc.label ~packing:(tbl#attach ~top:7 ~left:0 ~right:2) () in
+ label#set_use_markup true;
{ inspection_label = label } in
(* Return the object. *)
information requested, and the source disk image or guest has
been opened successfully. *)
method ready : callback:(unit -> unit) -> GtkSignal.id
+
+ (** This function performs the {!Cmdline.cli_request} operation.
+ The actual operation happens asynchronously after this function
+ has returned. *)
+ method run_cli_request : Cmdline.cli_request -> unit
end
val tab : unit -> tab
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
+open Printf
+
+open Utils
+
type file_menu = {
quit_item : GMenu.menu_item;
}
class window =
let title = "Resize a virtual machine - virt-resize-ui" in
object (self)
+ val mutable tabs = None
+ val mutable statusbar_context = None
+ val mutable progress_bar : GRange.progress_bar option = None
+
+ method source_tab = (Option.get tabs).source_tab
+
+ method set_statusbar msg =
+ Option.may (
+ fun c ->
+ c#pop ();
+ ignore (c#push msg)
+ ) statusbar_context
+
+ method progress (position, total) =
+ Option.may (
+ fun pb ->
+ if position = 0L && total = 1L then
+ pb#pulse ()
+ else (
+ let frac = Int64.to_float position /. Int64.to_float total in
+ if frac < 0. || frac > 1. then
+ eprintf "warning: progress bar out of range: %Ld / %Ld (%g)\n"
+ position total frac;
+ let frac = if frac < 0. then 0. else if frac > 1. then 1. else frac in
+ pb#set_fraction frac
+ )
+ ) progress_bar
+
initializer
(* Window. *)
let window = GWindow.window ~width:700 ~height:700 ~title () in
let about = factory#add_item "About virt-resize-ui ..." in
{ about_item = about } in
+ ignore help_menu;
+
(* Tabbed notebook for main part of the display. *)
- let tabs =
+ tabs <- (
let nb = GPack.notebook ~packing:(vbox#pack ~expand:true ~fill:true) () in
let src = Source_tab.tab () in
(GMisc.label ~text:"Expand logical volumes" () :> GObj.widget) in
ignore (nb#append_page ~tab_label (lvs :> GObj.widget));
- { source_tab = src; destination_tab = dest;
- partitions_tab = parts; logvols_tab = lvs } in
+ Some { source_tab = src; destination_tab = dest;
+ partitions_tab = parts; logvols_tab = lvs });
+
+ (* Status bar and progress bar. *)
+ let hbox = GPack.hbox ~spacing:4 ~packing:vbox#pack () in
+ progress_bar <- Some (GRange.progress_bar ~packing:hbox#pack ());
+ let statusbar = GMisc.statusbar ~packing:(hbox#pack ~expand:true) () in
+ statusbar_context <- Some (statusbar#new_context ~name:"Standard");
+ ignore ((Option.get statusbar_context)#push title);
(* Buttons. *)
let buttons =
{ prev_button = prev; next_button = next; go_button = go;
exit_button = ex } in
- ignore help_menu;
- ignore tabs;
-
(* Quit button. *)
let quit _ = GMain.quit (); false in
ignore (window#connect#destroy ~callback:GMain.quit);
class window :
object
- (* empty, for now *)
+ (** Return the source tab. *)
+ method source_tab : Source_tab.tab
+
+ (** Set the statusbar text. *)
+ method set_statusbar : string -> unit
+
+ (** Move the progress bar. *)
+ method progress : (int64 * int64) -> unit
+
end
git.annexia.org / virt-resize-ui.git / commitdiff