diff options
| -rw-r--r-- | sid.ml | 22 | ||||
| -rw-r--r-- | sid.mli | 2 | ||||
| -rw-r--r-- | xxd.ml | 107 |
3 files changed, 112 insertions, 19 deletions
@@ -21,6 +21,9 @@ let create ?(sa=[||]) ia = if Array.length sa > max_subauth_count then None else Some (create_unsafe sa ia) +let get_ident_auth s = s.sid_ident_auth +let get_sub_auths s = s.sid_sub_auths + exception Nope let equal_sub_auths saa sab = @@ -36,25 +39,6 @@ let equal a b = && Array.length a.sid_sub_auths = Array.length b.sid_sub_auths && equal_sub_auths a.sid_sub_auths b.sid_sub_auths -module type Xtract = sig - type t - val nth_byte : t -> int -> int -end - -module MkExtract (INTTYPE : Stdint.Int) = struct - type t = INTTYPE.t - - let ilsr = INTTYPE.shift_left - let iland = INTTYPE.logand - let ixff = INTTYPE.of_string "255" - - let nth_byte n i = - (ilsr n i) |> iland ixff |> INTTYPE.to_int -end - -module U32Extract = MkExtract (U32) -module U64Extract = MkExtract (U64) - module StringFmt = struct let expect_char s c p = @@ -5,6 +5,8 @@ val create_unsafe : Stdint.Uint32.t array -> Stdint.Uint64.t -> t val create : ?sa:Stdint.Uint32.t array -> Stdint.Uint64.t -> t val equal_sub_auths : Stdint.Uint32.t array -> Stdint.Uint32.t array -> bool val equal : t -> t -> bool +val get_ident_auth : t -> Stdint.Uint64.t +val get_sub_auths : t -> sub_auths module StringFmt : sig @@ -0,0 +1,107 @@ +let (!!) = Bytes.unsafe_of_string +let (??) = Bytes.unsafe_to_string + +module U64 = Stdint.Uint64 +module U32 = Stdint.Uint32 + +module type Xtract = sig + type t + val nth_byte : t -> int -> int +end + +module MkExtract (INTTYPE : Stdint.Int) = struct + type t = INTTYPE.t + + let ilsr = INTTYPE.shift_left + let iland = INTTYPE.logand + let ixff = INTTYPE.of_string "255" + + let nth_byte n i = + (ilsr n i) |> iland ixff |> INTTYPE.to_int +end + +module U32Extract = MkExtract (U32) +module U64Extract = MkExtract (U64) + +let string_of_sid s = + let b = Buffer.create 16 in + let pushbuf = Buffer.add_string b in + let ia_nth = U64Extract.nth_byte (Sid.get_ident_auth s) in + pushbuf + (Printf.sprintf "01%0.2x %0.2x%0.2x %0.2x%0.2x %0.2x%0.2x" + (Array.length (Sid.get_sub_auths s)) + (ia_nth 0) (ia_nth 1) (ia_nth 2) (ia_nth 3) (ia_nth 4) (ia_nth 5)); + Array.iter + (fun sa -> + let sa_nth = U32Extract.nth_byte sa in + pushbuf + (Printf.sprintf "%0.2x%0.2x %0.2x%0.2x" + (sa_nth 0) (sa_nth 1) (sa_nth 2) (sa_nth 3))) + (Sid.get_sub_auths s); + Buffer.contents b + +let xdigit_table = + let t = Array.make 256 !!"\x00\x00" in + let xd n = Printf.sprintf "%0.2x" (n land 0xff) |> (!!) in + for i = 0 to 255 do t.(i) <- xd i done; + t + +let xdigit n = xdigit_table.(n land 0xff) + +let nope _ = false +let every n i = i > 0 && i mod n = 0 + +(* result length can be calculated in advance so we can do + this without realloc() *) +let xxd_of_bytes ?(blocklen=0) src = + let ls = Bytes.length src in + if ls = 0 then "" else + let ld = 2 * ls + if blocklen = 0 then 0 else (ls - 1) / blocklen in + let dst = Bytes.create ld in + let spacep = if blocklen = 0 then nope else every blocklen in + let rec aux is id = + if is = ls then ??dst else + let id' = + if not (spacep is) then id + else (Bytes.set dst id ' '; id + 1) + in + assert (id' < ld - 1); + Bytes.blit (Bytes.get src is |> int_of_char |> xdigit) 0 dst id' 2; + aux (is+1) (id'+2) + in + aux 0 0 + +let bufsiz = 4096 + +let base_decimal = int_of_char '0' +let base_lower = int_of_char 'a' - 10 +let base_upper = int_of_char 'A' - 10 + +let int_of_nibble c = + if '0' <= c && c <= '9' then Some (int_of_char c - base_decimal) else + if 'a' <= c && c <= 'f' then Some (int_of_char c - base_lower ) else + if 'A' <= c && c <= 'F' then Some (int_of_char c - base_upper ) else + None + +let bytes_of_xxd src = + let ls = String.length src in + if ls = 0 then Bytes.empty else + let buf = Buffer.create bufsiz in + let rec aux hi is = + if is = ls then + if hi = None then (Buffer.contents buf |> (!!)) else + raise (Invalid_argument + "bytes_of_xxd: odd number of hex digits in input") + else + match String.get src is |> int_of_nibble with + | None -> aux hi (is+1) + | Some c -> begin + match hi with + | None -> aux (Some (c lsl 4)) (is+1) + | Some hi -> + Buffer.add_char buf (hi lor c |> char_of_int); + aux None (is+1) + end + in + aux None 0 + |