diff options
| -rw-r--r-- | sid.ml | 55 | ||||
| -rw-r--r-- | sid.mli | 2 | ||||
| -rw-r--r-- | sid_test.ml | 117 |
3 files changed, 164 insertions, 10 deletions
@@ -7,9 +7,9 @@ type sid = } and sub_auths = U32.t array -let sub_auth_max = 15 - -let sizeof_sub_auth = 4 +let sizeof_ident_auth = 6 +let sizeof_sub_auth = 4 +let max_subauth_count = 15 let create_unsafe sa ia = { sid_ident_auth = ia @@ -71,7 +71,7 @@ module StringFmt = struct let read_decimal_u64 = read_decimal_string U64.of_string let read_decimal_u32 = read_decimal_string U32.of_string - + (* * The spec ([MS-DTYP]): * @@ -92,7 +92,7 @@ module StringFmt = struct let p = 4 in let p, ia = read_decimal_u64 s p in let sa = ref [] and p' = ref p in - while !p' < n && List.length !sa < sub_auth_max do + while !p' < n && List.length !sa < max_subauth_count do expect_char s '-' !p'; let np, d = read_decimal_u32 s (!p' + 1) in sa := d :: !sa; @@ -129,6 +129,8 @@ end (* [module StringFmt] *) module PacketRep = struct (* [MS-DTYP] 2.4.22 *) + (* XXX configurable endianness *) + let encode s = let nsa = Array.length s.sid_sub_auths in let l = 8 + nsa * sizeof_sub_auth in @@ -152,6 +154,49 @@ module PacketRep = struct (* [MS-DTYP] 2.4.22 *) s.sid_sub_auths; Bytes.unsafe_of_string (Buffer.contents b) + let wordlen = 4 (* sizeof int *) + let min_pktrep_len = 1 + 1 + sizeof_ident_auth + let max_pktrep_len = 1 + 1 + + sizeof_ident_auth + + max_subauth_count * sizeof_sub_auth + let pktrep_sa_off = min_pktrep_len + + let decode b = + let l = Bytes.length b in + if l < min_pktrep_len || max_pktrep_len < l then + Error (Printf.sprintf + "bad input size: expected %d–%d B, got %d B" + min_pktrep_len max_pktrep_len l) else + if l mod wordlen <> 0 then + Error (Printf.sprintf + "bad input size: not divisible by word length (%d)" + wordlen) else + let v = Bytes.get b 0 |> int_of_char in + if v <> 0x01 then + Error (Printf.sprintf + "input malformed: expected SID version=0x01, got 0x%0.2x" v) else + let nsa = Bytes.get b 1 |> int_of_char in + if max_subauth_count < nsa then + Error (Printf.sprintf + "input malformed: up to %d subAuthority elements permitted, \ + %d specified" + max_subauth_count nsa) else + let getbyte n ia = (* b[n] << (5 - (n - 2)) *) + U64.logor ia + (U64.shift_left (Bytes.get b n |> int_of_char |> U64.of_int) (5 - (n - 2))) + in + let ia = U64.zero + |> getbyte 2 |> getbyte 3 |> getbyte 4 + |> getbyte 5 |> getbyte 6 |> getbyte 7 in + let sas = Array.make nsa (U32.zero) in + for i = 0 to (nsa - 1) do + let off = pktrep_sa_off + i * sizeof_sub_auth in + sas.(i) <- U32.of_bytes_little_endian b off + done; + Ok { sid_ident_auth = ia + ; sid_sub_auths = sas + } + end (* [module PacketRep] *) module WellKnown = struct @@ -1,6 +1,5 @@ type t type sub_auths = Stdint.Uint32.t array -val sub_auth_max : int 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 @@ -19,6 +18,7 @@ module StringFmt : module PacketRep : sig val encode : t -> bytes + val decode : bytes -> (t, string) result end module WellKnown : diff --git a/sid_test.ml b/sid_test.ml index 137575e..aaee961 100644 --- a/sid_test.ml +++ b/sid_test.ml @@ -1,5 +1,9 @@ open OUnit +(* +let () = Printexc.record_backtrace true ;; + *) + (* S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14 *) let max_sid = Stdint.( Sid.create_unsafe @@ -82,7 +86,7 @@ let sf_parse_too_long_ok () = let pr_encode_null_ok () = let x = Sid.WellKnown.null - |> Sid.PacketRep.encode + |> Sid.PacketRep.encode |> Xxd.xxd_of_bytes ~blocklen:2 in let expect = "0101 0000 0000 0000 0000 0000" in @@ -94,7 +98,7 @@ let pr_encode_null_ok () = let pr_encode_all_ok () = let x = Sid.WellKnown.everyone - |> Sid.PacketRep.encode + |> Sid.PacketRep.encode |> Xxd.xxd_of_bytes ~blocklen:2 in let expect = "0101 0000 0000 0001 0000 0000" in @@ -103,6 +107,105 @@ let pr_encode_all_ok () = ~msg:(Printf.sprintf "[%s] ≠ [%s]" x expect) x expect +let pr_decode_all_ok () = + let s = + match + Xxd.bytes_of_xxd "0101 0000 0000 0001 0000 0000" + (* vvcc iiii iiii iiii ssss ssss *) + |> Sid.PacketRep.decode + with + | Ok s -> s + | Error e -> + assert_failure + (Printf.sprintf "error decoding SID: %s" e) + in + let w = Sid.WellKnown.world in + assert_bool + (Printf.sprintf "[%s] ≠ [%s]" + (Sid.to_string s) (Sid.to_string w)) + (Sid.equal s w) + +let pr_decode_version_fail () = + let b = Xxd.bytes_of_xxd "0201 0000 0000 0001 0000 0000" in + (* vvcc iiii iiii iiii ssss ssss *) + match Sid.PacketRep.decode b with + | Error e -> + let expect = "input malformed: expected SID version=0x01, got 0x02" in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + +let pr_decode_sacount_fail () = + let b = Xxd.bytes_of_xxd "0110 0000 0000 0001 0000 0000" in + (* vvcc iiii iiii iiii ssss ssss *) + match Sid.PacketRep.decode b with + | Error e -> + let expect = "input malformed: up to 15 subAuthority elements \ + permitted, 16 specified" in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + +let pr_decode_short_fail () = + let b = Xxd.bytes_of_xxd "0105 0000 0000 00" in + (* vvcc iiii iiii ii…… *) + match Sid.PacketRep.decode b with + | Error e -> + let expect = "bad input size: expected 8–68 B, got 7 B" in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + +let pr_decode_long_fail () = + let r = + "010e 0000 0000 0000 0100 0000 0200 0000 \ + 0300 0000 0400 0000 0500 0000 0600 0000 \ + 0700 0000 0800 0000 0900 0000 0a00 0000 \ + 0b00 0000 0c00 0000 0d00 0000 0e00 0000 \ + 0f00 0000 1000 0000" + in + let b = Xxd.bytes_of_xxd r in + match Sid.PacketRep.decode b with + | Error e -> + let expect = "bad input size: expected 8–68 B, got 72 B" in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + +let pr_decode_odd_fail () = + match + Xxd.bytes_of_xxd "0101 0000 0000 0000 0100 0000 0200" + (* vvcc iiii iiii iiii ssss ssss ssss … + upper half word missing *) + |> Sid.PacketRep.decode + with + | Error e -> + let expect = "bad input size: not divisible by word length (4)" in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + + let string_format_test = "string-format-syntax" >::: [ "parse-ok" >:: sf_parse_ok ; "parse-empty-fail" >:: sf_parse_empty_fail @@ -117,8 +220,14 @@ let string_format_test = "string-format-syntax" >::: let packet_rep_test = "packet-rep" >::: - [ "encode-null-ok" >:: pr_encode_null_ok - ; "encode-all-ok" >:: pr_encode_all_ok + [ "encode-null-ok" >:: pr_encode_null_ok + ; "encode-all-ok" >:: pr_encode_all_ok + ; "decode-all-ok" >:: pr_decode_all_ok + ; "decode-version-fail" >:: pr_decode_version_fail + ; "decode-sacount-fail" >:: pr_decode_sacount_fail + ; "decode-short-fail" >:: pr_decode_short_fail + ; "decode-long-fail" >:: pr_decode_long_fail + ; "decode-odd-fail" >:: pr_decode_odd_fail ] let () = |