(* Guestfs Browser.
 * Copyright (C) 2010 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

module G = Guestfs

let (//) = Filename.concat

(* Display state. *)
type display_state = {
  window : GWindow.window;
  throbber_busy : unit -> unit;
  throbber_idle : unit -> unit;
  set_statusbar : string -> unit;
  clear_statusbar : unit -> unit;
  set_vmlist : string list -> unit;
  clear_vmlist : unit -> unit;
  clear_notebook : unit -> unit;
  filesystem : GPack.box;
  notebook : GPack.notebook;
}

let rec open_main_window () =
  let title = "Guest Filesystem Browser" in
  let window = GWindow.window ~width:700 ~height:700 ~title () in
  let vbox = GPack.vbox ~packing:window#add () in

  (* Do the menus. *)
  let menubar = GMenu.menu_bar ~packing:vbox#pack () in
  let factory = new GMenu.factory menubar in
  let accel_group = factory#accel_group in
  let connect_menu = factory#add_submenu "_Connect" in

  let factory = new GMenu.factory connect_menu ~accel_group in
  let connect_item = factory#add_item "_Connect to libvirt ..." in
  let open_item = factory#add_item "_Open disk image ..." ~key:GdkKeysyms._O in
  ignore (factory#add_separator ());
  let quit_item = factory#add_item "E_xit" ~key:GdkKeysyms._Q in

  (* Quit. *)
  let quit _ = GMain.quit (); false in
  ignore (window#connect#destroy ~callback:GMain.quit);
  ignore (window#event#connect#delete ~callback:quit);
  ignore (quit_item#connect#activate
            ~callback:(fun () -> ignore (quit ()); ()));

  (* Top status area. *)
  let hbox = GPack.hbox ~border_width:4 ~packing:vbox#pack () in
  hbox#pack (mklabel "Guest: ");

  (* List of VMs. *)
  let vmcombo = GEdit.combo_box_text ~packing:hbox#pack () in
  let set_vmlist names =
    let combo, (model, column) = vmcombo in
    model#clear ();
    List.iter (
      fun name ->
        let row = model#append () in
        model#set ~row ~column name
    ) names
  in
  let clear_vmlist () = set_vmlist [] in

  (* Throbber, http://faq.pygtk.org/index.py?req=show&file=faq23.037.htp *)
  let static = Throbber.static () in
  (*let animation = Throbber.animation () in*)
  let throbber =
    GMisc.image ~pixbuf:static ~packing:(hbox#pack ~from:`END) () in
  let throbber_busy () =
    (*throbber#set_pixbuf animation*)
    (* Workaround because no binding for GdkPixbufAnimation: *)
    let file = Filename.dirname Sys.argv.(0) // "Throbber.gif" in
    throbber#set_file file
  and throbber_idle () =
    throbber#set_pixbuf static
  in

  (* Tabbed pane ("notebook") filling the main window. *)
  let nb = GPack.notebook ~scrollable:true
    ~packing:(vbox#pack ~expand:true ~fill:true) () in
  let filesystem = GPack.vbox () in
  filesystem#add (intro_label () :> GObj.widget);
  ignore (nb#append_page
            ~tab_label:(mklabel "Filesystem") (filesystem :> GObj.widget));
  let clear_notebook () =
    nb#goto_page 0;
    (* Remove all tabs except the first ("Filesystem") tab ... *)
    List.iter nb#remove (List.tl nb#all_children);
    (* ... and clear out the filesystem tab. *)
    List.iter filesystem#remove filesystem#all_children
  in

  (* Status bar at the bottom of the screen. *)
  let set_statusbar =
    let statusbar = GMisc.statusbar ~packing:vbox#pack () in
    let context = statusbar#new_context ~name:"Standard" in
    ignore (context#push title);
    fun msg ->
      context#pop ();
      ignore (context#push msg)
  in
  let clear_statusbar () = set_statusbar "" in

  window#show ();
  window#add_accel_group accel_group;

  (* display_state which is threaded through all the other callbacks,
   * allowing callbacks to update the window.
   *)
  let ds = {
    window = window;
    throbber_busy = throbber_busy; throbber_idle = throbber_idle;
    set_statusbar = set_statusbar; clear_statusbar = clear_statusbar;
    set_vmlist = set_vmlist; clear_vmlist = clear_vmlist;
    clear_notebook = clear_notebook;
    filesystem = filesystem; notebook = nb;
  } in

  (* Set up some callbacks which require access to the display_state. *)
  ignore (
    let combo, (model, column) = vmcombo in
    combo#connect#changed
      ~callback:(
        fun () ->
          match combo#active_iter with
          | None -> ()
          | Some row ->
              let name = model#get ~row ~column in
              ds.set_statusbar (sprintf "Opening %s ..." name);
              ds.clear_notebook ();
              Slave.discard_command_queue ();
              Slave.open_domain name (opened_domain ds))
  );

  ignore (connect_item#connect#activate ~callback:(connect_dialog ds));
  ignore (open_item#connect#activate ~callback:(open_dialog ds));

  (* Return the display state. *)
  ds

(* Convenience function to make a label containing some text.  It is
 * returned as a generic widget.
 *)
and mklabel text =
  (GMisc.label ~text () :> GObj.widget)

(* This is called in the main thread whenever a command fails in the
 * slave thread.  The command queue has been cleared before this is
 * called, so our job here is to reset the main window, and if
 * necessary to turn the exception into an error message.
 *)
and failure ds exn =
  let title = "Error" in
  let msg = Printexc.to_string exn in
  debug "thread id %d: failure hook: %s" (Thread.id (Thread.self ())) msg;
  let icon = GMisc.image () in
  icon#set_stock `DIALOG_ERROR;
  icon#set_icon_size `DIALOG;
  GToolbox.message_box ~title ~icon msg

(* This is called in the main thread when we've connected to libvirt. *)
and connected ds uri () =
  debug "thread id %d: connected callback" (Thread.id (Thread.self ()));
  let msg =
    match uri with
    | None -> "Connected to libvirt"
    | Some uri -> sprintf "Connected to %s" uri in
  ds.set_statusbar msg;
  Slave.get_domains (got_domains ds)

(* This is called in the main thread when we've got the list of domains. *)
and got_domains ds doms =
  let doms = List.map (fun { Slave.dom_name = name } -> name) doms in
  debug "thread id %d: got_domains callback: (%s)"
    (Thread.id (Thread.self ())) (String.concat " " doms);
  ds.set_vmlist doms

(* This callback indicates that the domain was opened successfully. *)
and opened_domain ds rw =
  debug "thread id %d: opened_domain callback" (Thread.id (Thread.self ()));
  opened ds rw

(* This callback indicates that local disk image(s) were opened successfully.*)
and opened_images ds rw =
  debug "thread id %d: opened_images callback" (Thread.id (Thread.self ()));
  opened ds rw

and opened ds rw =
  ds.clear_statusbar ();
  ds.clear_notebook ();

  (* Get the list of mountable filesystems. *)
  Slave.get_volumes (got_volume ds rw)

(* This callback is called once for each mountable filesystem that is
 * found in a guest.
 *)
and got_volume ds rw vol =
  let dev = vol.Slave.vol_device in
  debug "thread id %d: got_volume callback: %s"
    (Thread.id (Thread.self ())) dev;

  (* What's on the tab. *)
  let tab =
    match vol.Slave.vol_label with
    | "" -> sprintf "%s" dev
    | label -> sprintf "%s (%s)" dev label in

  (* What's on the notebook page. *)
  let page =
    let vbox = GPack.vbox () in

    (* VFS stats table. *)

    (* For calculations, see libguestfs/tools/virt-df. *)
    let st = vol.Slave.vol_statvfs in
    let factor = st.G.bsize /^ 1024L in

    (* Right-aligned label with width, for stats table. *)
    let mklabelh text =
      let markup = "<b>" ^ text ^ "</b>" in
      let label = GMisc.label ~markup ~xalign:1. () in
      label#set_width_chars 12;
      (label :> GObj.widget)
    and mklabelr text =
      let label = GMisc.label ~text ~selectable:true ~xalign:1. () in
      label#set_width_chars 12;
      (label :> GObj.widget)
    in

    let stats = GPack.table ~columns:4 ~rows:5
      ~homogeneous:true ~col_spacings:4 ~row_spacings:4
      ~packing:vbox#pack () in
    stats#attach ~top:0 ~left:0 (mklabelh "1K-blocks");
    stats#attach ~top:0 ~left:1 (mklabelh "Used");
    stats#attach ~top:0 ~left:2 (mklabelh "Available");
    stats#attach ~top:0 ~left:3 (mklabelh "Use%");
    let blocks = st.G.blocks *^ factor in
    stats#attach ~top:1 ~left:0 (mklabelr (sprintf "%Ld" blocks));
    let used = (st.G.blocks -^ st.G.bfree) *^ factor in
    stats#attach ~top:1 ~left:1 (mklabelr (sprintf "%Ld" used));
    let available = st.G.bavail *^ factor in
    stats#attach ~top:1 ~left:2 (mklabelr (sprintf "%Ld" available));
    stats#attach ~top:1 ~left:3
      (mklabelr (sprintf "%Ld%%" (100L -^ 100L *^ st.G.bfree /^ st.G.blocks)));
    stats#attach ~top:2 ~left:0 (mklabelr ("= " ^ human_size_1k blocks));
    stats#attach ~top:2 ~left:1 (mklabelr ("= " ^ human_size_1k used));
    stats#attach ~top:2 ~left:2 (mklabelr ("= " ^ human_size_1k available));
    stats#attach ~top:3 ~left:0 (mklabelh "Inodes");
    stats#attach ~top:3 ~left:1 (mklabelh "IUsed");
    stats#attach ~top:3 ~left:2 (mklabelh "IFree");
    stats#attach ~top:3 ~left:3 (mklabelh "IUse%");
    stats#attach ~top:4 ~left:0 (mklabelr (sprintf "%Ld" st.G.files));
    stats#attach ~top:4 ~left:1
      (mklabelr (sprintf "%Ld" (st.G.files -^ st.G.ffree)));
    stats#attach ~top:4 ~left:2 (mklabelr (sprintf "%Ld" st.G.ffree));
    stats#attach ~top:4 ~left:3
      (mklabelr (sprintf "%Ld%%" (100L -^ 100L *^ st.G.ffree /^ st.G.files)));

    (* Info table. *)

    (* Left- and right-aligned labels, for info table. *)
    let mklabelr text =
      let label = GMisc.label ~text ~xalign:1. () in
      label#set_width_chars 9;
      (label :> GObj.widget)
    and mklabell text =
      let label = GMisc.label ~text ~selectable:true ~xalign:0. () in
      (label :> GObj.widget)
    in

    let info = GPack.table ~columns:4 ~rows:2
      ~col_spacings:4 ~row_spacings:4
      ~packing:vbox#pack () in
    info#attach ~top:0 ~left:0 (mklabelr "FS label:");
    info#attach ~top:0 ~left:1 (mklabell vol.Slave.vol_label);
    info#attach ~top:1 ~left:0 (mklabelr "FS type:");
    info#attach ~top:1 ~left:1 (mklabell vol.Slave.vol_type);
    info#attach ~top:0 ~left:2 (mklabelr "FS UUID:");
    info#attach ~top:0 ~left:3 (mklabell vol.Slave.vol_uuid);
    info#attach ~top:1 ~left:2 (mklabelr "Device:");
    info#attach ~top:1 ~left:3 (mklabell dev);

    (* Files display. *)
    let sw = GBin.scrolled_window
      ~packing:(vbox#pack ~expand:true ~fill:true)
      ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in
    let view = Filetree.filetree dev rw in
    sw#add (view :> GObj.widget);

    vbox in
  ignore (
    ds.notebook#append_page ~tab_label:(mklabel tab) (page :> GObj.widget)
  )

(* Open the connect to libvirt dialog. *)
and connect_dialog ds () =
  debug "connect menu";
  (*ds.clear_notebook ();*)
  (*Slave.discard_command_queue ();*)
  (* XXX NOT IMPL XXX *)
  ()

(* Open the disk images dialog. *)
and open_dialog ds () =
  debug "open menu";
  (*ds.clear_notebook ();*)
  (*Slave.discard_command_queue ();*)
  (* XXX NOT IMPL XXX *)
  ()

(* The introductory text which appears in the tabbed notebook to
 * tell the user how to start.  XXX We should add images.
 *)
and intro_label () =
  let text =
    sprintf "Open a disk image (Connect %s Open disk image), connect to libvirt (Connect %s Connect to libvirt), or choose a guest from the \"Guest\" menu above."
      utf8_rarrow utf8_rarrow in
  let label = GMisc.label ~text () in
  label#set_line_wrap true;
  label

let run_cli_request ds = function
  | Cmdline.Empty_window -> ()
  | Cmdline.Connect_to_libvirt uri ->
      Slave.connect uri (connected ds uri)
  | Cmdline.Open_disk_image images ->
      Slave.open_images images (opened_images ds)