summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sid.ml55
-rw-r--r--sid.mli2
-rw-r--r--sid_test.ml117
3 files changed, 164 insertions, 10 deletions
diff --git a/sid.ml b/sid.ml
index f3fb77d..9f1e591 100644
--- a/sid.ml
+++ b/sid.ml
@@ -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
diff --git a/sid.mli b/sid.mli
index 9a7e8b0..7c0451c 100644
--- a/sid.mli
+++ b/sid.mli
@@ -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 () =