X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=utils.ml;h=57faf38b97893fd2dde26bf008f7c9bb5935dc53;hb=23a1eac79ffcbab1801b89430fc0354e44cf7599;hp=f9cf35d441ceeeb8defcb56706368342d20b904c;hpb=3ab788383673a8300925a7de6113ef3962378a15;p=guestfs-browser.git diff --git a/utils.ml b/utils.ml index f9cf35d..57faf38 100644 --- a/utils.ml +++ b/utils.ml @@ -17,8 +17,7 @@ *) open ExtString -open CamomileLibrary -open Default.Camomile +open ExtList open Printf @@ -26,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 @@ -63,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 @@ -146,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 @@ -155,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 () -> @@ -163,9 +225,12 @@ let tmpdir () = ignore (Sys.command cmd)); tmpdir -let utf16le = CharEncoding.utf16le -let utf8 = CharEncoding.utf8 -let recode = CharEncoding.recode_string ~in_enc:utf16le ~out_enc:utf8 +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 @@ -176,3 +241,66 @@ let windows_string_to_utf8 str = 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 -> ""