(* 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 Utils open Printf (* See struct/field description in .mli file. *) type t = { view : GTree.view; model : GTree.tree_store; hash : (int, hdata) Hashtbl.t; index_col : int GTree.column; mode_col : string GTree.column; name_col : string GTree.column; size_col : string GTree.column; date_col : string GTree.column; } and hdata = { mutable state : state_t; content : content_t; mutable visited : bool; } and state_t = | IsLeaf | NodeNotStarted | NodeLoading | IsNode and content_t = | Loading | ErrorMessage of string | Info of string | Top of Slave.source | Directory of Slave.direntry | File of Slave.direntry (* Store hdata into a row. *) let store_hdata {model = model; hash = hash; index_col = index_col} row hdata = let index = unique () in Hashtbl.add hash index hdata; model#set ~row ~column:index_col index (* Retrieve previously stored hdata from a row. *) let get_hdata { model = model; hash = hash; index_col = index_col } row = let index = model#get ~row ~column:index_col in try Hashtbl.find hash index with Not_found -> assert false (* Iterate over children of node, looking for matching hdata. *) let find_child_node_by_content ({ model = model } as t) row c = let rec loop row = if (get_hdata t row).content = c then row else if model#iter_next row then loop row else raise Not_found in if not (model#iter_has_child row) then raise Not_found; let first_child = model#iter_children (Some row) in loop first_child (* Search up to the top of the tree so we know if this directory * comes from an OS or a volume, and the full path to here. * * The path up the tree will always look something like: * Top * \_ Directory * \_ Directory * \_ Loading <--- you are here *) let rec get_pathname ({ model = model } as t) row = let hdata = get_hdata t row in let parent = model#iter_parent row in match hdata, parent with | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent -> get_pathname t parent | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None -> assert false | { content=Directory { Slave.dent_name = name }}, Some parent | { content=File { Slave.dent_name = name }}, Some parent -> let src, parent_name = get_pathname t parent in let path = if parent_name = "/" then "/" ^ name else parent_name ^ "/" ^ name in src, path | { content=Top src }, _ -> src, "/" | { content=Directory _}, None -> assert false | { content=File _}, None -> assert false | { content=Loading }, _ -> assert false | { content=ErrorMessage _}, _ -> assert false | { content=Info _}, _ -> assert false (* Base colours. XXX Should be configurable somewhere. *) let file_color = 0x20, 0x20, 0xff (* regular file *) let dir_color = 0x80, 0x80, 0x20 (* directory *) let symlink_color = file_color (* symlink *) let suid_color = 0x20, 0x20, 0x80 (* setuid bit set on regular file *) let suid_bgcolor = 0xff, 0xc0, 0xc0 let sgid_color = suid_color (* setgid bit set on regular file *) let sgid_bgcolor = suid_bgcolor let block_color = 0x00, 0x60, 0x60 (* block device *) let char_color = block_color (* char device *) let fifo_color = 0x60, 0x00, 0x60 (* fifo *) let socket_color = fifo_color (* socket *) let other_color = file_color (* anything not one of the above *) (* Mark up a filename for the name_col column. * * XXX This shouldn't be in Filetree_type module, but we have to have * it here because set_visited is here. * * See also * http://library.gnome.org/devel/pango/stable/PangoMarkupFormat.html *) let rec markup_of_name ?(visited = false) direntry = let name = direntry.Slave.dent_name in let mode = direntry.Slave.dent_stat.Guestfs.mode in if is_directory mode then ( (* directory *) let fg = if not visited then normal dir_color else darken dir_color in sprintf "%s" fg (markup_escape name) ) else if is_symlink mode then ( (* symlink *) let link = direntry.Slave.dent_link in let fg = if not visited then normal symlink_color else darken symlink_color in sprintf "%s %s %s" fg (markup_escape name) utf8_rarrow fg (markup_escape link) ) else ( (* not directory, not symlink *) let fg, bg = if is_regular_file mode then ( if is_suid mode then suid_color, Some suid_bgcolor else if is_sgid mode then sgid_color, Some sgid_bgcolor else file_color, None ) else if is_block mode then block_color, None else if is_char mode then char_color, None else if is_fifo mode then fifo_color, None else if is_socket mode then socket_color, None else other_color, None in let fg = if not visited then normal fg else darken fg in let bg = match bg with | Some bg -> sprintf " bgcolor=\"%s\"" (normal bg) | None -> "" in sprintf "%s" fg bg (markup_escape name) ) and normal (r, g, b) = let r = if r < 0 then 0 else if r > 255 then 255 else r in let g = if g < 0 then 0 else if g > 255 then 255 else g in let b = if b < 0 then 0 else if b > 255 then 255 else b in sprintf "#%02x%02x%02x" r g b and darken (r, g, b) = normal (r * 4 / 10, g * 4 / 10, b * 4 / 10) (* This is a bit of a hack. Ideally just setting 'visited' would * darken the colour when the cell was re-rendered. However that would * mean we couldn't store other stuff in the name column. Therefore, * repopulate the name column. *) let set_visited ({ model = model; name_col = name_col } as t) row = let hdata = get_hdata t row in if hdata.visited = false then ( hdata.visited <- true; match hdata.content with | Directory direntry | File direntry -> debug "set_visited %s" direntry.Slave.dent_name; model#set ~row ~column:name_col (markup_of_name ~visited:true direntry) | Loading | ErrorMessage _ | Info _ | Top _ -> () )