--- /dev/null
+(* 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 CamomileLibrary
+open Default.Camomile
+
+open Utils
+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.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 "<span weight=\"bold\" fgcolor=\"%s\">%s</span>"
+ 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 "<span style=\"italic\" fgcolor=\"%s\">%s</span> %s <span style=\"italic\" fgcolor=\"%s\">%s</span>"
+ 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 "<span fgcolor=\"%s\"%s>%s</span>"
+ 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 name = if name = "" then "@" else name in
+ let fg = if not visited then normal dir_color else darken dir_color in
+ sprintf "<span fgcolor=\"%s\">%s</span>" fg (markup_escape name)
+
+(* Mark up a registry value. *)
+and markup_of_regvalue ?(visited = false) h value =
+ debug "markup_of_regvalue";
+ let k = Hivex.value_key h value in
+ let t, v = Hivex.value_value h value in
+
+ (* Ignore long values. *)
+ let len = String.length v in
+ let v =
+ if len >= 256 then
+ sprintf "<%d bytes not printed>" len
+ else (
+ (* Deal as best we can with printing the value. *)
+ match t with
+ | Hivex.REG_NONE -> if v = "" then "" else markup_hex_data v
+ | Hivex.REG_SZ -> markup_windows_string v
+ | Hivex.REG_EXPAND_SZ -> markup_windows_string v
+ | Hivex.REG_BINARY -> markup_hex_data v
+ | Hivex.REG_DWORD ->
+ if len = 4 then
+ sprintf "%08lx" (i32_of_string_le v)
+ else
+ markup_hex_data v
+ | Hivex.REG_DWORD_BIG_ENDIAN ->
+ if len = 4 then
+ sprintf "%08lx" (i32_of_string_be v)
+ else
+ markup_hex_data v
+ | Hivex.REG_LINK -> markup_hex_data v
+ | Hivex.REG_MULTI_SZ -> (* XXX could do better with this *)
+ markup_hex_data v
+ | Hivex.REG_RESOURCE_LIST -> markup_hex_data v
+ | Hivex.REG_FULL_RESOURCE_DESCRIPTOR -> markup_hex_data v
+ | Hivex.REG_RESOURCE_REQUIREMENTS_LIST -> markup_hex_data v
+ | Hivex.REG_QWORD ->
+ if len = 8 then
+ sprintf "%016Lx" (i64_of_string_le v)
+ else
+ markup_hex_data v
+ | Hivex.REG_UNKNOWN i32 -> markup_hex_data v
+ ) in
+
+ let fg = if not visited then normal file_color else darken file_color in
+ sprintf "<span fgcolor=\"%s\">%s</span>=<span fgcolor=\"%s\">%s</span>"
+ fg (markup_escape k) fg v
+
+(* Mark up registry value as hex data. *)
+and markup_hex_data v =
+ let vs = String.explode v in
+ let vs = List.mapi (
+ fun i c ->
+ sprintf "%s%02x" (if i mod 16 = 0 then "\n" else "") (int_of_char c)
+ ) vs in
+ String.concat "," vs
+
+(* Best guess the format of the string and convert to UTF-8. *)
+and markup_windows_string v =
+ let utf16le = CharEncoding.utf16le in
+ let utf8 = CharEncoding.utf8 in
+ try
+ let v = CharEncoding.recode_string ~in_enc:utf16le ~out_enc:utf8 v in
+ (* Registry strings include the final \0 so remove this if present. *)
+ let len = UTF8.length v in
+ let v =
+ if len > 0 && UChar.code (UTF8.get v (len-1)) = 0 then
+ String.sub v 0 (UTF8.last v)
+ else
+ v in
+ markup_escape v
+ with
+ | CharEncoding.Malformed_code
+ | CharEncoding.Out_of_range ->
+ (* Fallback to displaying the string as hex. *)
+ markup_hex_data 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';
+
+ "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
+
+(* 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 "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
+ (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
+ "<small>now</small>"
+ else if ago < 60. *. 60. then
+ sprintf "<small>%.0f minutes ago</small>" (ago /. 60.)
+ else if ago < 60. *. 60. *. 24. then
+ sprintf "<small>%.0f hours ago</small>" (ago /. 60. /. 60.)
+ else if ago < 60. *. 60. *. 24. *. 28. then
+ sprintf "<small>%.0f days ago</small>" (ago /. 60. /. 60. /. 24.)
+ else
+ show_full_date ()
+
+(* Mark up file sizes. *)
+let markup_of_size bytes =
+ sprintf "<small>%s</small>" (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.Slave.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 _ -> ()
+ )
git.annexia.org / guestfs-browser.git / blobdiff