X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=utils.ml;h=57faf38b97893fd2dde26bf008f7c9bb5935dc53;hb=23a1eac79ffcbab1801b89430fc0354e44cf7599;hp=ca2432fe798f9d1ff50523e966a71852504370ec;hpb=e0047b09f88dcfa6dd9e771caf57a744095321f2;p=guestfs-browser.git diff --git a/utils.ml b/utils.ml index ca2432f..57faf38 100644 --- a/utils.ml +++ b/utils.ml @@ -17,6 +17,7 @@ *) open ExtString +open ExtList open Printf @@ -24,6 +25,7 @@ let (+^) = Int64.add let (-^) = Int64.sub let ( *^ ) = Int64.mul let (/^) = Int64.div +let (&^) = Int64.logand type ('a, 'b) either = Left of 'a | Right of 'b @@ -61,8 +63,41 @@ let connect_uri = ref None let set_connect_uri conn = connect_uri := conn let connect_uri () = !connect_uri +let utf8_copyright = "\194\169" let utf8_rarrow = "\xe2\x86\x92" +let pretty_string_of_exn = + function + | Guestfs.Error str -> + "Libguestfs error", + sprintf "libguestfs reported an error: + +%s + +To get more information about libguestfs errors, run guestfs-browser +with the -x flag on the command line." + str + + | Libvirt.Virterror err -> + "Libvirt error", + sprintf "libvirt reported an error: + +%s + +To get more information about libvirt errors, run guestfs-browser +from the command line like this: + +LIBVIRT_DEBUG=1 guestfs-browser" + (Libvirt.Virterror.to_string err) + + (* Add more exception types here as we come across them. Last + * case below is the catch-all. + *) + | exn -> + let str = Printexc.to_string exn in + debug "pretty_string_of_exn: unhandled exception %s" str; + "Error", str + let human_size i = if i < 1024L then sprintf "%Ld" i @@ -144,6 +179,35 @@ and is_xo mode = test_bit 0o001L mode and test_bit mask mode = Int64.logand mode mask = mask +let file_permissions_string 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 + let tmpdir () = let chan = open_in "/dev/urandom" in let data = String.create 16 in @@ -153,7 +217,7 @@ let tmpdir () = (* Note this is secure, because if the name already exists, even as a * symlink, mkdir(2) will fail. *) - let tmpdir = Filename.temp_dir_name // sprintf "febootstrap%s.tmp" data in + let tmpdir = Filename.temp_dir_name // sprintf "guestfsbrowser%s.tmp" data in Unix.mkdir tmpdir 0o700; at_exit (fun () -> @@ -161,44 +225,82 @@ let tmpdir () = ignore (Sys.command cmd)); tmpdir -(* This would be so much simpler with ChriS's delimited - * overloading macro XXX - *) -let i32_of_string_le v = - let b0 = int_of_char (String.unsafe_get v 0) in - let b1 = int_of_char (String.unsafe_get v 1) in - let b2 = int_of_char (String.unsafe_get v 2) in - let b3 = Int32.of_int (int_of_char (String.unsafe_get v 3)) in - Int32.logor - (Int32.of_int (b0 lor (b1 lsl 8) lor (b2 lsl 16))) - (Int32.shift_left b3 24) - -let i32_of_string_be v = - let b0 = Int32.of_int (int_of_char (String.unsafe_get v 0)) in - let b1 = int_of_char (String.unsafe_get v 1) in - let b2 = int_of_char (String.unsafe_get v 2) in - let b3 = int_of_char (String.unsafe_get v 3) in - Int32.logor - (Int32.of_int (b3 lor (b2 lsl 8) lor (b1 lsl 16))) - (Int32.shift_left b0 24) - -let i64_of_string_le v = - let b0 = int_of_char (String.unsafe_get v 0) in - let b1 = int_of_char (String.unsafe_get v 1) in - let b2 = int_of_char (String.unsafe_get v 2) in - let b3 = Int64.of_int (int_of_char (String.unsafe_get v 3)) in - let b4 = Int64.of_int (int_of_char (String.unsafe_get v 4)) in - let b5 = Int64.of_int (int_of_char (String.unsafe_get v 5)) in - let b6 = Int64.of_int (int_of_char (String.unsafe_get v 6)) in - let b7 = Int64.of_int (int_of_char (String.unsafe_get v 7)) in - Int64.logor - (Int64.logor - (Int64.logor - (Int64.logor - (Int64.logor - (Int64.of_int (b0 lor (b1 lsl 8) lor (b2 lsl 16))) - (Int64.shift_left b3 24)) - (Int64.shift_left b4 32)) - (Int64.shift_left b5 40)) - (Int64.shift_left b6 48)) - (Int64.shift_left b7 56) +module CE = CamomileLibraryDefault.Camomile.CharEncoding +module UTF8 = CamomileLibraryDefault.Camomile.UTF8 +module UChar = CamomileLibraryDefault.Camomile.UChar +let utf16le = CE.utf16le +let utf8 = CE.utf8 +let recode = CE.recode_string ~in_enc:utf16le ~out_enc:utf8 + +let windows_string_to_utf8 str = + let str = recode str in + + (* Windows strings include the final \0 so remove this if present. *) + let len = UTF8.length str in + if len > 0 && UChar.code (UTF8.get str (len-1)) = 0 then + String.sub str 0 (UTF8.last str) + else + str + +(* Best effort convert hive value to printable string. *) +let rec printable_hivex_value ?split_long_lines t v = + let hex = reg_hex_of_string ?split_long_lines in + match t with + | Hivex.REG_NONE -> if v = "" then "" else hex v + | Hivex.REG_SZ -> + (try windows_string_to_utf8 v with _ -> hex v) + | Hivex.REG_EXPAND_SZ -> + (try windows_string_to_utf8 v with _ -> hex v) + | Hivex.REG_BINARY -> hex v + | Hivex.REG_DWORD -> + (bitmatch Bitstring.bitstring_of_string v with + | { i : 32 : littleendian } -> sprintf "%08lx" i + | { _ } -> hex v) + | Hivex.REG_DWORD_BIG_ENDIAN -> + (bitmatch Bitstring.bitstring_of_string v with + | { i : 32 : bigendian } -> sprintf "%08lx" i + | { _ } -> hex v) + | Hivex.REG_LINK -> hex v + | Hivex.REG_MULTI_SZ -> (* XXX should be better for this one *) + hex v + | Hivex.REG_RESOURCE_LIST -> hex v + | Hivex.REG_FULL_RESOURCE_DESCRIPTOR -> hex v + | Hivex.REG_RESOURCE_REQUIREMENTS_LIST -> hex v + | Hivex.REG_QWORD -> + (bitmatch Bitstring.bitstring_of_string v with + | { i : 64 : littleendian } -> sprintf "%016Lx" i + | { _ } -> hex v) + | Hivex.REG_UNKNOWN i32 -> hex v + +(* Convert binary data to a hex string. This includes line breaks. *) +and reg_hex_of_string ?(split_long_lines=false) v = + let vs = String.explode v in + let vs = List.mapi ( + fun i c -> + sprintf "%s%02x" + (if split_long_lines && i mod 16 = 0 then "\n" else "") + (int_of_char c) + ) vs in + String.concat "," vs + +let local_file_exists filename = + try Unix.access filename [Unix.F_OK]; true + with Unix.Unix_error _ -> false + +let basename pathname = + let len = String.length pathname in + try + let i = String.rindex pathname '/' in + let r = String.sub pathname (i+1) (len-i-1) in + if r = "" then "root" else r + with + Not_found -> pathname + +let extension pathname = + let len = String.length pathname in + try + let i = String.rindex pathname '.' in + let r = String.sub pathname i (len-i) in + r + with + Not_found -> ""