(* 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 ExtString open ExtList open Unix open Utils open Slave_types open Filetree_type open Printf (* 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. * * See also * http://library.gnome.org/devel/pango/stable/PangoMarkupFormat.html *) let rec markup_of_name ?(visited = false) direntry = let name = direntry.dent_name in let mode = direntry.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.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) ) (* Mark up a registry key. *) and markup_of_regkey ?(visited = false) h node = let name = Hivex.node_name h node in let fg = if not visited then normal dir_color else darken dir_color in sprintf "%s" fg (markup_escape name) (* Mark up a registry value. *) and markup_of_regvalue ?(visited = false) h value = let k = Hivex.value_key h value in let k = if k = "" then "@" else k in let t, v = Hivex.value_value h value in (* Ignore long values. *) let len = String.length v in let v = if len >= 512 then sprintf "<%d bytes not printed>" len else markup_escape (printable_hivex_value ~split_long_lines:true t v) in let fg = if not visited then normal file_color else darken file_color in sprintf "%s=%s" fg (markup_escape k) fg v 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) (* Mark up mode. *) let 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 is_ru mode then 'r' else '-' in let wu = if is_wu mode then 'w' else '-' in let xu = if is_xu mode then 'x' else '-' in let rg = if is_rg mode then 'r' else '-' in let wg = if is_wg mode then 'w' else '-' in let xg = if is_xg mode then 'x' else '-' in let ro = if is_ro mode then 'r' else '-' in let wo = if is_wo mode then 'w' else '-' in let xo = if is_xo 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 = is_suid mode in let sgid = is_sgid mode in let svtx = is_svtx mode in if suid then str.[3] <- 's'; if sgid then str.[6] <- 's'; if svtx then str.[9] <- 't'; "" ^ str ^ "" (* Mark up dates. *) let markup_of_date t = (* Guestfs gives us int64's, we want float which is OCaml's * equivalent of time_t. *) let t = Int64.to_float t in let show_full_date () = let tm = localtime t in sprintf "%04d-%02d-%02d %02d:%02d:%02d" (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec in (* How long ago? *) let now = time () in let ago = now -. t in if ago < 0. then (* future *) show_full_date () else if ago < 60. then "now" else if ago < 60. *. 60. then sprintf "%.0f minutes ago" (ago /. 60.) else if ago < 60. *. 60. *. 24. then sprintf "%.0f hours ago" (ago /. 60. /. 60.) else if ago < 60. *. 60. *. 24. *. 28. then sprintf "%.0f days ago" (ago /. 60. /. 60. /. 24.) else show_full_date () (* Mark up file sizes. *) let markup_of_size bytes = sprintf "%s" (human_size bytes) (* Mark up registry value types. *) let markup_of_regvaluetype h value = let t, _ = Hivex.value_value h value in match t with | Hivex.REG_NONE -> "none(0)" | Hivex.REG_SZ -> "str(1)" | Hivex.REG_EXPAND_SZ -> "str(2)" | Hivex.REG_BINARY -> "hex(3)" | Hivex.REG_DWORD -> "dword(4)" | Hivex.REG_DWORD_BIG_ENDIAN -> "dword(5)" | Hivex.REG_LINK -> "link(6)" | Hivex.REG_MULTI_SZ -> "multi string (7)" | Hivex.REG_RESOURCE_LIST -> "resource list (8)" | Hivex.REG_FULL_RESOURCE_DESCRIPTOR -> "full resource descriptor (9)" | Hivex.REG_RESOURCE_REQUIREMENTS_LIST -> "resource requirements list (10)" | Hivex.REG_QWORD -> "qword (11)" | Hivex.REG_UNKNOWN i32 -> sprintf "type 0x%08lx" i32 (* Mark up registry value sizes. *) let markup_of_regvaluesize h value = let _, len = Hivex.value_type h value in sprintf "%d" len (* 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.dent_name; model#set ~row ~column:name_col (markup_of_name ~visited:true direntry) | RegKey node -> debug "set_visited RegKey"; let h = Option.get hdata.hiveh in model#set ~row ~column:name_col (markup_of_regkey ~visited:true h node) | RegValue value -> debug "set_visited RegValue"; let h = Option.get hdata.hiveh in model#set ~row ~column:name_col (markup_of_regvalue ~visited:true h value) | Loading | ErrorMessage _ | Info _ | Top _ | TopWinReg _ -> () )