2 * Copyright (C) 2010 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
30 (* Base colours. XXX Should be configurable somewhere. *)
31 let file_color = 0x20, 0x20, 0xff (* regular file *)
32 let dir_color = 0x80, 0x80, 0x20 (* directory *)
33 let symlink_color = file_color (* symlink *)
34 let suid_color = 0x20, 0x20, 0x80 (* setuid bit set on regular file *)
35 let suid_bgcolor = 0xff, 0xc0, 0xc0
36 let sgid_color = suid_color (* setgid bit set on regular file *)
37 let sgid_bgcolor = suid_bgcolor
38 let block_color = 0x00, 0x60, 0x60 (* block device *)
39 let char_color = block_color (* char device *)
40 let fifo_color = 0x60, 0x00, 0x60 (* fifo *)
41 let socket_color = fifo_color (* socket *)
42 let other_color = file_color (* anything not one of the above *)
44 (* Mark up a filename for the name_col column.
47 * http://library.gnome.org/devel/pango/stable/PangoMarkupFormat.html
49 let rec markup_of_name ?(visited = false) direntry =
50 let name = direntry.Slave.dent_name in
51 let mode = direntry.Slave.dent_stat.Guestfs.mode in
52 if is_directory mode then ( (* directory *)
53 let fg = if not visited then normal dir_color else darken dir_color in
54 sprintf "<span weight=\"bold\" fgcolor=\"%s\">%s</span>"
55 fg (markup_escape name)
57 else if is_symlink mode then ( (* symlink *)
58 let link = direntry.Slave.dent_link in
60 if not visited then normal symlink_color else darken symlink_color in
61 sprintf "<span style=\"italic\" fgcolor=\"%s\">%s</span> %s <span style=\"italic\" fgcolor=\"%s\">%s</span>"
62 fg (markup_escape name) utf8_rarrow fg (markup_escape link)
64 else ( (* not directory, not symlink *)
66 if is_regular_file mode then (
67 if is_suid mode then suid_color, Some suid_bgcolor
68 else if is_sgid mode then sgid_color, Some sgid_bgcolor
71 else if is_block mode then block_color, None
72 else if is_char mode then char_color, None
73 else if is_fifo mode then fifo_color, None
74 else if is_socket mode then socket_color, None
75 else other_color, None in
76 let fg = if not visited then normal fg else darken fg in
79 | Some bg -> sprintf " bgcolor=\"%s\"" (normal bg)
81 sprintf "<span fgcolor=\"%s\"%s>%s</span>"
82 fg bg (markup_escape name)
85 (* Mark up a registry key. *)
86 and markup_of_regkey ?(visited = false) h node =
87 let name = Hivex.node_name h node in
88 let fg = if not visited then normal dir_color else darken dir_color in
89 sprintf "<span fgcolor=\"%s\">%s</span>" fg (markup_escape name)
91 (* Mark up a registry value. *)
92 and markup_of_regvalue ?(visited = false) h value =
93 let k = Hivex.value_key h value in
94 let k = if k = "" then "@" else k in
95 let t, v = Hivex.value_value h value in
97 (* Ignore long values. *)
98 let len = String.length v in
100 if len >= 512 then sprintf "<%d bytes not printed>" len
101 else markup_escape (printable_hivex_value ~split_long_lines:true t v) in
103 let fg = if not visited then normal file_color else darken file_color in
104 sprintf "<span fgcolor=\"%s\">%s</span>=<span fgcolor=\"%s\">%s</span>"
105 fg (markup_escape k) fg v
107 and normal (r, g, b) =
108 let r = if r < 0 then 0 else if r > 255 then 255 else r in
109 let g = if g < 0 then 0 else if g > 255 then 255 else g in
110 let b = if b < 0 then 0 else if b > 255 then 255 else b in
111 sprintf "#%02x%02x%02x" r g b
113 and darken (r, g, b) =
114 normal (r * 4 / 10, g * 4 / 10, b * 4 / 10)
117 let markup_of_mode mode =
119 if is_socket mode then 's'
120 else if is_symlink mode then 'l'
121 else if is_regular_file mode then '-'
122 else if is_block mode then 'b'
123 else if is_directory mode then 'd'
124 else if is_char mode then 'c'
125 else if is_fifo mode then 'p' else '?' in
126 let ru = if is_ru mode then 'r' else '-' in
127 let wu = if is_wu mode then 'w' else '-' in
128 let xu = if is_xu mode then 'x' else '-' in
129 let rg = if is_rg mode then 'r' else '-' in
130 let wg = if is_wg mode then 'w' else '-' in
131 let xg = if is_xg mode then 'x' else '-' in
132 let ro = if is_ro mode then 'r' else '-' in
133 let wo = if is_wo mode then 'w' else '-' in
134 let xo = if is_xo mode then 'x' else '-' in
135 let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in
137 let suid = is_suid mode in
138 let sgid = is_sgid mode in
139 let svtx = is_svtx mode in
140 if suid then str.[3] <- 's';
141 if sgid then str.[6] <- 's';
142 if svtx then str.[9] <- 't';
144 "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
147 let markup_of_date t =
148 (* Guestfs gives us int64's, we want float which is OCaml's
149 * equivalent of time_t.
151 let t = Int64.to_float t in
153 let show_full_date () =
154 let tm = localtime t in
155 sprintf "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
156 (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday
157 tm.tm_hour tm.tm_min tm.tm_sec
162 let ago = now -. t in
163 if ago < 0. then (* future *)
165 else if ago < 60. then
167 else if ago < 60. *. 60. then
168 sprintf "<small>%.0f minutes ago</small>" (ago /. 60.)
169 else if ago < 60. *. 60. *. 24. then
170 sprintf "<small>%.0f hours ago</small>" (ago /. 60. /. 60.)
171 else if ago < 60. *. 60. *. 24. *. 28. then
172 sprintf "<small>%.0f days ago</small>" (ago /. 60. /. 60. /. 24.)
176 (* Mark up file sizes. *)
177 let markup_of_size bytes =
178 sprintf "<small>%s</small>" (human_size bytes)
180 (* Mark up registry value types. *)
181 let markup_of_regvaluetype h value =
182 let t, _ = Hivex.value_value h value in
185 | Hivex.REG_NONE -> "none(0)"
186 | Hivex.REG_SZ -> "str(1)"
187 | Hivex.REG_EXPAND_SZ -> "str(2)"
188 | Hivex.REG_BINARY -> "hex(3)"
189 | Hivex.REG_DWORD -> "dword(4)"
190 | Hivex.REG_DWORD_BIG_ENDIAN -> "dword(5)"
191 | Hivex.REG_LINK -> "link(6)"
192 | Hivex.REG_MULTI_SZ -> "multi string (7)"
193 | Hivex.REG_RESOURCE_LIST -> "resource list (8)"
194 | Hivex.REG_FULL_RESOURCE_DESCRIPTOR -> "full resource descriptor (9)"
195 | Hivex.REG_RESOURCE_REQUIREMENTS_LIST -> "resource requirements list (10)"
196 | Hivex.REG_QWORD -> "qword (11)"
197 | Hivex.REG_UNKNOWN i32 -> sprintf "type 0x%08lx" i32
199 (* Mark up registry value sizes. *)
200 let markup_of_regvaluesize h value =
201 let _, len = Hivex.value_type h value in
204 (* This is a bit of a hack. Ideally just setting 'visited' would
205 * darken the colour when the cell was re-rendered. However that would
206 * mean we couldn't store other stuff in the name column. Therefore,
207 * repopulate the name column.
209 let set_visited ({ model = model; name_col = name_col } as t) row =
210 let hdata = get_hdata t row in
211 if hdata.visited = false then (
212 hdata.visited <- true;
213 match hdata.content with
214 | Directory direntry | File direntry ->
215 debug "set_visited %s" direntry.Slave.dent_name;
216 model#set ~row ~column:name_col
217 (markup_of_name ~visited:true direntry)
219 debug "set_visited RegKey";
220 let h = Option.get hdata.hiveh in
221 model#set ~row ~column:name_col
222 (markup_of_regkey ~visited:true h node)
224 debug "set_visited RegValue";
225 let h = Option.get hdata.hiveh in
226 model#set ~row ~column:name_col
227 (markup_of_regvalue ~visited:true h value)
228 | Loading | ErrorMessage _ | Info _ | Top _ | TopWinReg _ -> ()