(* 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 ExtList
open ExtString
open Printf

open Utils

module G = Guestfs

let unique = let i = ref 0 in fun () -> incr i; !i

(* The type of the hidden column used to implement on-demand loading.
 * We are going to store these in the model as simple ints because that
 * is easier on the GC.  Don't change these numbers!
 *)
let isFile = 0           (* it's not a directory, there are no children *)
let dirNotStarted = 1    (* user has not tried to open this *)
let dirLoading = 2       (* user tried to open it, still loading *)
let isDir = 3            (* we've loaded the children of this directory *)
let loading = 4          (* this row contains the "Loading ..." message *)

let rec filetree dev rw =
  let view = GTree.view () in
  (*view#set_rules_hint true;*)
  view#selection#set_mode `MULTIPLE;

  (* Hash of index numbers -> other data.  We do this because it's
   * more efficient for the GC compared to storing OCaml objects
   * directly in the rows.
   *)
  let hash = Hashtbl.create 1023 in

  (* The columns stored in each row.  The hidden [state_col] column
   * stores the current state of the row, and is used to implement
   * on-demand loading.  The hidden [index_col] column is an index into
   * the hash table that records everything else about this row
   * (filename, file stat, etc).  The other display columns, eg.
   * [name_col] contain Pango markup and thus have to be escaped.
   *)
  let cols = new GTree.column_list in
  (* Hidden: *)
  let state_col = cols#add Gobject.Data.int in
  let index_col = cols#add Gobject.Data.int in
  (* Displayed: *)
  let mode_col = cols#add Gobject.Data.string in
  let name_col = cols#add Gobject.Data.string in
  let size_col = cols#add Gobject.Data.int64 in
  let date_col = cols#add Gobject.Data.string in
  let link_col = cols#add Gobject.Data.string in

  let model = GTree.tree_store cols in
  view#set_model (Some (model :> GTree.model));

  let renderer = GTree.cell_renderer_text [], ["markup", mode_col] in
  let mode_view = GTree.view_column ~title:"Permissions" ~renderer () in
  ignore (view#append_column mode_view);

  let renderer = GTree.cell_renderer_text [], ["markup", name_col] in
  let name_view = GTree.view_column ~title:"Filename" ~renderer () in
  ignore (view#append_column name_view);

  let renderer = GTree.cell_renderer_text [], ["text", size_col] in
  let size_view = GTree.view_column ~title:"Size" ~renderer () in
  ignore (view#append_column size_view);

  let renderer = GTree.cell_renderer_text [], ["markup", date_col] in
  let date_view = GTree.view_column ~title:"Date" ~renderer () in
  ignore (view#append_column date_view);

  let renderer = GTree.cell_renderer_text [], ["markup", link_col] in
  let link_view = GTree.view_column ~title:"Link" ~renderer () in
  ignore (view#append_column link_view);

  let tree =
    model, view, hash, dev, rw,
    (state_col, index_col, mode_col, name_col, size_col, date_col,
     link_col) in

  (* Create the root directory entry, then expand it which will force
   * it to be loaded (asynchronously).
   * XXX Should stat "/"
   *)
  let root = model#append () in
  add_directory_row tree root "/" None;
  view#expand_row (model#get_path root);

  ignore (view#event#connect#button_press ~callback:(button_press tree));
  (*ignore (view#event#connect#popup_menu ~callback);*)

  view

(* Add an "embryonic" directory to the tree store.  This contains a
 * dummy entry (as explained
 * http://mail.gnome.org/archives/gtk-app-devel-list/2003-May/msg00241.html)
 * and when the user opens it, it triggers the real directory to be
 * read.
 *)
and add_directory_row tree row filename direntry =
  let model, view, hash, _, _,
    (state_col, index_col, mode_col, name_col, size_col, date_col,
     link_col)
    = tree in

  model#set ~row ~column:state_col dirNotStarted;
  model#set ~row ~column:index_col (-1);
  model#set ~row ~column:name_col (markup_of_name filename);
  (match direntry with
   | None -> ()
   | Some direntry ->
       let index = unique () in
       Hashtbl.add hash index direntry;
       model#set ~row ~column:index_col index;
       let stat = direntry.Slave.dent_stat in
       model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
       model#set ~row ~column:size_col stat.G.size;
       model#set ~row ~column:date_col (markup_of_date stat.G.mtime));

  let placeholder = model#append ~parent:row () in
  model#set ~row:placeholder ~column:state_col loading;
  model#set ~row:placeholder ~column:index_col (-1);
  model#set ~row:placeholder ~column:name_col "<i>Loading ...</i>";
  ignore (view#connect#row_expanded ~callback:(expand_row tree))

(* This is called when the user expands the [directory] row. *)
and expand_row tree row _ =
  let model, _, _, dev, _, (state_col, _, _, _, _, _, _) = tree in

  match model#get ~row ~column:state_col with
  | 1 (* dirNotStarted *) -> (* Kick off a directory read. *)
      (* Get a stable path for this row so we can use it inside
       * the callback, which may happen a lot later.
       *)
      let path = model#get_path row in

      (* Now invoke libguestfs in the slave thread. *)
      Slave.read_directory
        dev (get_pathname tree row) (read_directory_cb tree path);

      (* Mark this row as now loading, so we don't start another
       * directory read if the user expands it again.
       *)
      model#set ~row ~column:state_col dirLoading

  | 0 (* isFile *) | 2 (* dirLoading *) | 3 (* isDir *) -> ()
  | 4 (* loading *) -> assert false
  | _ -> assert false

and read_directory_cb tree path entries =
  let model, _, hash, _, _,
    (state_col, index_col, mode_col, name_col, size_col, date_col,
     link_col)
    = tree in

  let row = model#get_iter path in

  (* Add the entries. *)
  List.iter (
    fun direntry ->
      let { Slave.dent_name = name; dent_stat = stat; dent_link = link } =
        direntry in
      let row = model#append ~parent:row () in
      if is_directory stat.G.mode then
        add_directory_row tree row name (Some direntry)
      else (
        let index = unique () in
        Hashtbl.add hash index direntry;
        model#set ~row ~column:state_col isFile;
        model#set ~row ~column:index_col index;
        model#set ~row ~column:name_col (markup_of_name name);
        model#set ~row ~column:mode_col (markup_of_mode stat.G.mode);
        model#set ~row ~column:size_col stat.G.size;
        model#set ~row ~column:date_col (markup_of_date stat.G.mtime);
        model#set ~row ~column:link_col (markup_of_link link)
      )
  ) entries;

  (* Remove the placeholder entry.  NB. Must be done AFTER adding
   * the other entries, or else Gtk will unexpand the row.
   *)
  (try
     let placeholder = model#iter_children ~nth:0 (Some row) in
     ignore (model#remove placeholder)
   with Invalid_argument _ -> ());

  (* The original directory entry has now been loaded, so
   * update its state.
   *)
  model#set ~row ~column:state_col isDir

(* Get the actual full pathname of a row. *)
and get_pathname tree row =
  let model, _, _, _, _, _ = tree in

  match model#iter_parent row with
  | None -> "/"
  | Some parent ->
      match get_direntry_of_row tree row with
      | Some { Slave.dent_name = name } ->
          let pname = get_pathname tree parent in
          if pname = "/" then "/" ^ name else pname ^ "/" ^ name
      | None ->
          assert false

(* Get the directory entry from a row (contains the stat(2) results etc).
 * Some rows don't have the required information (eg. placeholder rows
 * and currently the root directory) and for them we return [None].
 *)
and get_direntry_of_row tree row =
  let model, _, hash, _, _, (_, index_col, _, _, _, _, _) = tree in
  let index = model#get ~row ~column:index_col in
  try Some (Hashtbl.find hash index)
  with Not_found -> None

(* XXX No binding for g_markup_escape in lablgtk2. *)
and markup_escape name =
  let f = function
    | '&' -> "&amp;" | '<' -> "&lt;" | '>' -> "&gt;"
    | c -> String.make 1 c
  in
  String.replace_chars f name

(* Mark up a filename for the name_col column. *)
and markup_of_name name =
  (* First, protect against any markup in the name. *)
  let name = markup_escape name in
  name

(* Mark up symbolic links. *)
and markup_of_link link =
  let link = markup_escape link in
  if link <> "" then utf8_rarrow ^ " " ^ link else ""

(* Mark up mode. *)
and markup_of_mode mode =
  let c =
    if is_socket mode then 's'
    else if is_symlink mode then 'l'
    else if is_regular_file mode then '-'
    else if is_block mode then 'b'
    else if is_directory mode then 'd'
    else if is_char mode then 'c'
    else if is_fifo mode then 'p' else '?' in
  let ru = if test_bit 0o400L mode then 'r' else '-' in
  let wu = if test_bit 0o200L mode then 'w' else '-' in
  let xu = if test_bit 0o100L mode then 'x' else '-' in
  let rg = if test_bit 0o40L mode then 'r' else '-' in
  let wg = if test_bit 0o20L mode then 'w' else '-' in
  let xg = if test_bit 0o10L mode then 'x' else '-' in
  let ro = if test_bit 0o4L mode then 'r' else '-' in
  let wo = if test_bit 0o2L mode then 'w' else '-' in
  let xo = if test_bit 0o1L mode then 'x' else '-' in
  let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in

  let suid = test_bit 0o4000L mode in
  let sgid = test_bit 0o2000L mode in
  let svtx = test_bit 0o1000L mode in
  if suid then str.[3] <- 's';
  if sgid then str.[6] <- 's';
  if svtx then str.[9] <- 't';

  "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"

(* File type tests. *)
and file_type mask mode = Int64.logand mode 0o170000L = mask

and is_socket mode =       file_type 0o140000L mode
and is_symlink mode =      file_type 0o120000L mode
and is_regular_file mode = file_type 0o100000L mode
and is_block mode =        file_type 0o060000L mode
and is_directory mode =    file_type 0o040000L mode
and is_char mode =         file_type 0o020000L mode
and is_fifo mode =         file_type 0o010000L mode

and test_bit mask mode = Int64.logand mode mask = mask

(* Mark up dates. *)
and markup_of_date time =
  let time = Int64.to_float time in
  let tm = Unix.localtime time in
  sprintf "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
    (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
    tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec

(* Handle mouse button press on the selected row.  This opens the
 * pop-up context menu.
 * http://scentric.net/tutorial/sec-selections-context-menus.html
 *)
and button_press tree ev =
  let button = GdkEvent.Button.button ev in
  let x = int_of_float (GdkEvent.Button.x ev) in
  let y = int_of_float (GdkEvent.Button.y ev) in
  let time = GdkEvent.Button.time ev in

  (* Right button for opening the context menu. *)
  if button = 3 then (
    let model, view, hash, _, _, (_, index_col, _, _, _, _, _) = tree in

    (* If no row is selected, select the row under the mouse. *)
    let paths =
      let sel = view#selection in
      if sel#count_selected_rows < 1 then (
        match view#get_path_at_pos ~x ~y with
        | None -> []
        | Some (path, _, _, _) ->
            sel#unselect_all ();
            sel#select_path path;
            [path]
      ) else
        sel#get_selected_rows (* actually returns paths *) in

    (* Ignore paths that don't contain index fields, and get the
     * direntry for the others.  Currently this causes the root
     * directory to be ignored because we don't have stat information
     * for it (XXX).
     *)
    let paths =
      List.filter_map (
        fun path ->
          let row = model#get_iter path in
          match get_direntry_of_row tree row with
          | None -> None
          | Some direntry -> Some (path, direntry)
      ) paths in

    (* Choose the menu and menu options according to the number of
     * selected rows and what is selected.
     *)
    let menu =
      try
        (match paths with
         | [] -> None
         | [path, direntry] ->          (* Single selection. *)
             (* What object is selected? *)
             let stat = direntry.Slave.dent_stat in
             let mode = stat.G.mode in
             if is_directory mode then
               Some (make_context_menu tree ~dir:true ~file:false paths)
             else if is_regular_file mode then
               Some (make_context_menu tree ~dir:false ~file:true paths)
             else (* not directory, not regular file *)
               Some (make_context_menu tree ~dir:false ~file:false paths)
         | paths ->                        (* Multiple selection. *)
             let dir = List.for_all (
               fun (_, { Slave.dent_stat = stat }) ->
                 is_directory stat.G.mode
             ) paths in
             let file = List.for_all (
               fun (_, { Slave.dent_stat = stat }) ->
                 is_regular_file stat.G.mode
             ) paths in
             Some (make_context_menu tree ~dir ~file paths)
        )
      with Not_found -> None
    in
    (match menu with
     | None -> ()
     | Some menu ->
         menu#popup ~button ~time;
    );

    (* Return true so no other handler will run. *)
    true
  ) else
    (* Defer to other handlers. *)
    false

(* Make a context menu for file(s) and directory(s).  ~file is true is
 * they are all regular files, ~dir is true if they are all
 * directories.  If neither is set, then it can be a single selection
 * of a non-file non-directory, or it can be a mixed multiple
 * selection.
 *)
and make_context_menu tree ~dir ~file paths =
  let _, _, _, _, rw, _ = tree in
  let n = List.length paths in

  debug "make_context_menu dir %b file %b n %d" dir file n;

  let menu = GMenu.menu () in
  let factory = new GMenu.factory menu in

  (* Open appears first, and unconditionally.  This is just to catch
   * the case where nothing below matches, and we want to display
   * _something_.  Open is not necessarily useful ...
   *)
  ignore (factory#add_item "Open");
  ignore (factory#add_separator ());

  if dir && n = 1 then (
    ignore (factory#add_item "Disk usage ...");
    ignore (factory#add_item "Export as an archive (tar etc) ...");
    ignore (factory#add_item "Export checksums ...");
    ignore (factory#add_item "Export as a list of files ...");
  );

  if file then
    ignore (factory#add_item "Determine file type ...");

  if n = 1 then
    ignore (factory#add_item "View permissions ...");

  (* Write operations go below the separator. *)
  (match rw with
   | Slave.RO -> ()
   | Slave.RW ->
       ignore (factory#add_separator ());

       if dir && n = 1 then (
         ignore (factory#add_item "New file ...");
         ignore (factory#add_item "New subdirectory ...");
         ignore (factory#add_item "Import an archive here ...");
       );

       if file then (
         ignore (factory#add_item "Touch file");
         ignore (factory#add_item "Edit file");
       );

       if n = 1 then
         ignore (factory#add_item "Edit permissions ...");

       ignore (factory#add_item "Delete")
  );

  menu