(* Guestfs Browser.
 * 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 Slave_types
open Utils

open Printf

(* I'd like to open CalendarLib but unfortunately it contains a
 * submodule also called Utils, which clashes with our module.
 *)
module CL = CalendarLib
module G = Guestfs

let rec file_properties tree path =
  let model = tree#model in
  let row = model#get_iter path in
  let src, pathname = tree#get_pathname row in

  debug "file properties dialog %s" pathname;

  let title = "File properties" in
  let d = GWindow.dialog ~width:400 ~height:600 ~title () in
  let nb = GPack.notebook ~packing:d#vbox#add () in

  let dent = tree#get_direntry row in
  let stat = dent.dent_stat in
  let mode = stat.G.mode in

  let filetype =
    if is_socket mode then "Socket"
    else if is_symlink mode then "Symbolic link"
    else if is_regular_file mode then "File"
    else if is_block mode then "Block device"
    else if is_directory mode then "Directory"
    else if is_char mode then "Character device"
    else if is_fifo mode then "Pipe"
    else "Unknown" in

  (* Fill in the basic information. *)
  let vbox = tab filetype nb in
  let tbl = GPack.table ~columns:4 ~rows:1 ~packing:vbox#add () in
  tbl#set_col_spacings 8;
  tbl#set_row_spacings 8;

  wide tbl 0 "Name: " dent.dent_name;
  wide tbl 1 "" pathname;
  wide tbl 2 "Size: " (sprintf "%Ld bytes" stat.G.size);
  wide tbl 3 "" (human_size stat.G.size);
  simple tbl 4 0 "Type: " filetype;
  if is_block mode || is_char mode then
    simple tbl 4 2 "Device: " (sprintf "0x%Lx" stat.G.rdev)
  else if is_symlink mode then
    simple tbl 4 2 "Link: " dent.dent_link;
  simple tbl 5 0 "UID: " (Int64.to_string stat.G.uid);
  simple tbl 5 2 "GID: " (Int64.to_string stat.G.gid);

  wide tbl 6 "" (file_permissions_string mode);

  simple tbl 7 0 "Perms: " (sprintf "0%Lo" (mode &^ 0o777L));
  simple tbl 7 2 "Sticky bit: " (if is_svtx mode then "yes" else "no");
  simple tbl 8 0 "Setuid bit: " (if is_suid mode then "yes" else "no");
  simple tbl 8 2 "Setgid bit: " (if is_sgid mode then "yes" else "no");

  wide2 tbl 9 "Last access: " (display_time stat.G.atime);
  wide2 tbl 10 "Last modification: " (display_time stat.G.mtime);
  wide2 tbl 11 "Last status change: " (display_time stat.G.ctime);

  (* Extended attrs. *)
  let vbox = tab "Extended attrs" nb in
  xattrs_view ~packing:vbox#add src pathname;

  (* Make sure dialog is destroyed when the tree is cleared. *)
  let sigid =
    tree#clear_tree ~callback:(
      fun () ->
        debug "inspection clear_tree -> destroy dialog";
        d#destroy ()
    ) in

  let destroy_dialog () =
    tree#disconnect sigid;
    d#destroy ()
  in

  (* Add a close button. *)
  let close_button = GButton.button ~label:"Close"
    ~packing:d#action_area#add () in
  ignore (close_button#connect#clicked ~callback:destroy_dialog);

  (* Destroy dialog when WM close button is pressed. *)
  ignore (d#connect#destroy ~callback:destroy_dialog);

  d#show ()

(* Helper functions. *)
and tab text nb =
  let vbox = GPack.vbox ~border_width:8 () in
  let tab_label = (GMisc.label ~text () :> GObj.widget) in
  ignore (nb#append_page ~tab_label (vbox :> GObj.widget));
  vbox

and simple tbl top left label text =
  let markup = sprintf "<b>%s</b>" (markup_escape text) in
  ignore (GMisc.label ~xalign:1. ~text:label
            ~packing:(tbl#attach ~top ~left) ());
  let left = left + 1 in
  ignore (GMisc.label ~xalign:0. ~markup ~packing:(tbl#attach ~top ~left) ());

and wide tbl top label text =
  let markup = sprintf "<b>%s</b>" (markup_escape text) in
  ignore (GMisc.label ~xalign:1.
            ~text:label ~packing:(tbl#attach ~top ~left:0) ());
  ignore (GMisc.label ~xalign:0.
            ~markup ~packing:(tbl#attach ~top ~left:1 ~right:4) ());

and wide2 tbl top label text =
  let markup = sprintf "<b>%s</b>" (markup_escape text) in
  ignore (GMisc.label ~xalign:1.
            ~text:label ~packing:(tbl#attach ~top ~left:0 ~right:2) ());
  ignore (GMisc.label ~xalign:0.
            ~markup ~packing:(tbl#attach ~top ~left:2 ~right:4) ());

and display_time t =
  let t = Int64.to_float t in
  let cal = CL.Calendar.from_unixfloat t in
  let cal = CL.Calendar.convert cal CL.Time_Zone.UTC CL.Time_Zone.Local in
  CL.Printer.Calendar.to_string cal

(* Extended attrs: loaded on demand. *)
and xattrs_view ?packing src pathname =
  let cols = new GTree.column_list in
  let name_col = cols#add Gobject.Data.string in
  let value_col = cols#add Gobject.Data.string in

  let model = GTree.list_store cols in

  let sw =
    GBin.scrolled_window ?packing ~hpolicy:`AUTOMATIC ~vpolicy:`ALWAYS () in

  let view = GTree.view ~model ~packing:sw#add () in
  view#selection#set_mode `NONE;

  let renderer = GTree.cell_renderer_text [], ["text", name_col] in
  let vc = GTree.view_column ~title:"Name" ~renderer () in
  vc#set_resizable true;
  ignore (view#append_column vc);
  let renderer = GTree.cell_renderer_text [], ["text", value_col] in
  let vc = GTree.view_column ~title:"Value" ~renderer () in
  vc#set_resizable true;
  ignore (view#append_column vc);

  Slave.file_xattrs src pathname
    (when_xattrs_loaded model name_col value_col)

and when_xattrs_loaded model name_col value_col xattrs =
  Array.iter (
    fun { G.attrname = name; attrval = value } ->
      let value = sprintf "%S" value in (* OCaml string escaping *)
      let row = model#append () in
      model#set ~row ~column:name_col name;
      model#set ~row ~column:value_col value
  ) xattrs