X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=filetree_markup.ml;h=b5f3b48e4a24f0f17ff3795cbde680a306707eef;hb=38e0e295c438adea7a8acabd21c2fd02c236cc04;hp=55bb425936d3c6da91fce0815e51a7471fc89e55;hpb=3ab788383673a8300925a7de6113ef3962378a15;p=guestfs-browser.git

diff --git a/filetree_markup.ml b/filetree_markup.ml
index 55bb425..b5f3b48 100644
--- a/filetree_markup.ml
+++ b/filetree_markup.ml
@@ -18,15 +18,15 @@
 
 open ExtString
 open ExtList
-open CamomileLibrary
-open Default.Camomile
 open Unix
 
 open Utils
-open Filetree_type
+open Slave_types
 
 open Printf
 
+module CL = CalendarLib
+
 (* Base colours. XXX Should be configurable somewhere. *)
 let file_color = 0x20, 0x20, 0xff  (* regular file *)
 let dir_color = 0x80, 0x80, 0x20   (* directory *)
@@ -47,15 +47,15 @@ let other_color = file_color       (* anything not one of the above *)
  * 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
+  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 "<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 link = direntry.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>"
@@ -85,69 +85,25 @@ let rec markup_of_name ?(visited = false) direntry =
 (* 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 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 >= 256 then
-      sprintf "&lt;%d bytes not printed&gt;" 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 ->
-          (bitmatch Bitstring.bitstring_of_string v with
-           | { i : 32 : littleendian } -> sprintf "%08lx" i
-           | { _ } -> markup_hex_data v)
-      | Hivex.REG_DWORD_BIG_ENDIAN ->
-          (bitmatch Bitstring.bitstring_of_string v with
-           | { i : 32 : bigendian } -> sprintf "%08lx" i
-           | { _ } -> 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 ->
-          (bitmatch Bitstring.bitstring_of_string v with
-           | { i : 64 : littleendian } -> sprintf "%016Lx" i
-           | { _ } -> markup_hex_data v)
-      | Hivex.REG_UNKNOWN i32 -> markup_hex_data v
-    ) in
+    if len >= 512 then sprintf "&lt;%d bytes not printed&gt;" 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 "<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 =
-  try markup_escape (windows_string_to_utf8 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
@@ -159,32 +115,7 @@ and darken (r, g, b) =
 
 (* 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';
-
+  let str = file_permissions_string mode in
   "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
 
 (* Mark up dates. *)
@@ -195,10 +126,10 @@ let markup_of_date 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
+    let cal = CL.Calendar.from_unixfloat t in
+    let cal = CL.Calendar.convert cal CL.Time_Zone.UTC CL.Time_Zone.Local in
+    CL.Printer.Calendar.sprint
+      "<span color=\"#222222\" size=\"small\">%F %T</span>" cal
   in
 
   (* How long ago? *)
@@ -244,30 +175,3 @@ let markup_of_regvaluetype h value =
 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 _ -> ()
-  )