main.ml

   1 (* Guestfs Browser.
   2  * Copyright (C) 2010 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 (* Main. *)
  24 let () =
  25   let cli_request = Cmdline.command_line () in
  26
  27   (* If we're in verbose mode, print some debug information which
  28    * could be useful in bug reports.
  29    *)
  30   if verbose () then (
  31     debug "%s %s" Config.package Config.version;
  32     debug "libguestfs %s" (libguestfs_version_string ());
  33     debug "libvirt %s" (libvirt_version_string ());
  34   );
  35
  36   (* Create the main window. *)
  37   let w = new Window.window in
  38
  39   (* Wire up hooks that carry messages from the slave thread
  40    * to the main thread.
  41    *)
  42   Slave.set_failure_hook w#failure;
  43   Slave.set_busy_hook w#throbber_busy;
  44   Slave.set_idle_hook w#throbber_idle;
  45   Slave.set_status_hook w#set_statusbar;
  46   Slave.set_progress_hook w#progress;
  47
  48   (* Wire up the loosely-coupled external components of the filetree.
  49    * See the note about signals in {!Filetree.tree} documentation.
  50    *)
  51   let tree = w#tree in
  52   ignore (tree#op_checksum_file
  53             ~callback:(Op_checksum_file.checksum_file tree));
  54   ignore (tree#op_copy_regvalue
  55             ~callback:(Op_copy_regvalue.copy_regvalue tree));
  56   ignore (tree#op_disk_usage
  57             ~callback:(Op_disk_usage.disk_usage tree));
  58   ignore (tree#op_download_as_reg
  59             ~callback:(Op_download_as_reg.download_as_reg tree));
  60   ignore (tree#op_download_dir_find0
  61             ~callback:(Op_download_dir_find0.download_dir_find0 tree));
  62   ignore (tree#op_download_dir_tarball
  63             ~callback:(Op_download_dir_tarball.download_dir_tarball tree));
  64   ignore (tree#op_download_file
  65             ~callback:(Op_download_file.download_file tree));
  66   ignore (tree#op_file_information
  67             ~callback:(Op_file_information.file_information tree));
  68   ignore (tree#op_file_properties
  69             ~callback:(Op_file_properties.file_properties tree));
  70   ignore (tree#op_inspection_dialog
  71             ~callback:(Op_inspection_dialog.inspection_dialog tree));
  72   ignore (tree#op_view_file
  73             ~callback:(Op_view_file.view_file tree));
  74
  75   (* Connect menu entry signals to the functions that implement them. *)
  76   ignore (w#connect_kvm_signal
  77             ~callback:(w#connect_to (Some "qemu:///system")));
  78   ignore (w#connect_xen_signal
  79             ~callback:(w#connect_to (Some "xen:///")));
  80   ignore (w#connect_none_signal
  81             ~callback:(w#connect_to None));
  82   ignore (w#connect_uri_signal
  83             ~callback:(Menu_open_uri.open_uri_dialog w));
  84   ignore (w#open_disk_signal
  85             ~callback:(Menu_open_disk.open_disk_dialog w));
  86   ignore (w#reopen_signal ~callback:w#reopen);
  87   ignore (
  88     w#inspection_signal
  89       ~callback:(
  90         fun () ->
  91           match tree#oses with
  92           | [] -> ()
  93           | os :: _ ->
  94               (* Note the menu entry only shows data for the first OS,
  95                  (for multiboot). *)
  96               Op_inspection_dialog.inspection_dialog tree os
  97       )
  98   );
  99   ignore (w#about_signal ~callback:(Menu_about.open_about_dialog w));
 100
 101   (* What did the user request on the command line? *)
 102   w#run_cli_request cli_request;
 103
 104   (* Run the main display thread.  When this returns, the application
 105    * has been closed.
 106    *)
 107   GtkThread.main ();
 108   Slave.exit_thread ()