summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPhilipp Gesang <phg@phi-gamma.net>2018-11-14 00:15:33 +0100
committerPhilipp Gesang <phg@phi-gamma.net>2018-11-29 00:06:53 +0100
commit039f4068c0e991b79769426486147d7851d5d6fd (patch)
treeacafb4b294817e3c71050ceec6a525d0df2555aa
parent7b3d8e1d13bab22c82b38012cfcb8cbfe67ed7e5 (diff)
downloadocaml-sid-039f4068c0e991b79769426486147d7851d5d6fd.tar.gz
sid: sid_test: add conformance mode imitating MS API
Add a conformance handler “Con_MS” to achieve a behavior that mimicks that of MS’s implementation bug-for-bug. Aspects of reading and formatting governd by the conformance: - Validation of ident auths, - validation of subauths, - validation of leading zeros in decimal numbers, - zero-padding of hex numbers.
-rw-r--r--sid.ml218
-rw-r--r--sid.mli11
-rw-r--r--sid_test.ml95
3 files changed, 257 insertions, 67 deletions
diff --git a/sid.ml b/sid.ml
index e8bc4ad..17c8124 100644
--- a/sid.ml
+++ b/sid.ml
@@ -11,6 +11,8 @@ and sub_auths = U32.t array
let sizeof_ident_auth = 6
let max_ident_auth = U64.of_string "0x0000_ffff_ffff_ffff"
+let ident_auth_hexlen = 14 (* 0x, 12 × hex digit *)
+let ident_auth_hexmin = U64.of_string "0x0001_0000_0000"
let sizeof_sub_auth = 4
let max_subauth_count = 15
@@ -44,113 +46,198 @@ 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 Validator = sig
+module Util = struct
+ let expect_char s c p =
+ if s.[p] = c then () else
+ raise
+ (Invalid_argument
+ (Printf.sprintf
+ "Invalid SID [%s]: expected ‘%c’ at position %d, found ‘%c’"
+ s c p s.[p]))
+
+ let is_digit c = '0' <= c && c <= '9'
+
+ let is_xdigit c =
+ '0' <= c && c <= '9'
+ || 'a' <= c && c <= 'f'
+ || 'A' <= c && c <= 'F'
+end
+
+module type Conformance = sig
val name : string
- val ia : bool -> U64.t -> bool
- val sas : U32.t array -> bool
+
+ val parse_hex_ia : string -> int -> U64.t * int
+ (** [parse_hex_ia raw p] read ia from [raw] at position [p] in hexadecimal,
+ return the value and the next position in the string. This only enforces
+ parsing behavior, not the value range. *)
+
+ val valid_decimal : string -> bool
+ (** [valid_decimal s] holds if [s] conforms to the constraints for decimal
+ numbers. Assumes the input already is all decimal digits. *)
+
+ val valid_ia : bool -> U64.t -> bool
+ (** [valid_ia ia] holds if [ia] is a valid identifier authority. *)
+
+ val valid_sas : U32.t array -> bool
+ (** [valid_sas sas] holds if [sas] is a valid array of
+ subauthorities. *)
+
+ val pad_hex_ia : int -> int
+ (** [pad n] return the number of padding zeros to prepend to the hex format
+ ident auth. *)
end
-(** Validate as though the spec in [MS-DTYP] were normative. *)
-module Vtor_strict = struct
+(* Validate and convert as though the spec in [MS-DTYP] were normative. *)
+module Con_strict = struct
let name = "strict"
- let ident_auth_hexlen = 14 (* 0x, 12 × hex digit *)
- let ident_auth_hexmin = U64.of_string "0x0001_0000_0000"
+ let parse_hex_ia s p =
+ assert (p <= String.length s - ident_auth_hexlen);
+ let e = p + ident_auth_hexlen - 1 in
+ let b = Bytes.make ident_auth_hexlen '\x2a' in
+ Bytes.set b 0 '0'; (* hex indicator for U64.of_string *)
+ Bytes.set b 1 'x';
+ for i = p + 2 to e do
+ (* assumption: prefix “0x” checked by caller *)
+ if not (Util.is_xdigit s.[i]) then
+ raise (Invalid_argument
+ (Printf.sprintf
+ "Invalid SID [%s]: expected hexadecimal digit at \
+ position %d while parsing ident auth, got ‘%c’"
+ s i s.[i]))
+ done;
+ Bytes.blit_string s (p+2) b 2 12;
+ U64.of_string (Bytes.unsafe_to_string b),
+ p + ident_auth_hexlen
+
+ (* leading zeros forbidden except for zero itself *)
+ let valid_decimal d =
+ String.length d > 0
+ && (String.length d = 1 || String.get d 0 <> '0')
- let ia hex v =
+ let valid_ia hex v =
if U64.compare v max_ident_auth > 0 then false else
if not hex && U64.compare v ident_auth_hexmin >= 0 then false else
not (hex && U64.compare v ident_auth_hexmin < 0)
- let sas v =
+ let valid_sas v =
+ let nsa = Array.length v in
+ 0 < nsa && nsa <= max_subauth_count
+
+ (* zero-pad to exactly twelve hex digits *)
+ let pad_hex_ia niax =
+ ident_auth_hexlen - niax
+end (* [module Con_strict] *)
+
+(* Validate simulating the empirically determined behavior of MS’s own
+ implementation “ConvertStringSidToSidA()”. The error code it returns
+ when rejecting an input is “ERROR_INVALID_SID”.
+
+ input | well-formed parsed | round-trip well-formed
+ -------------------------+----------------------+------------------------------------
+ S-1-0x000000000000-1 | no yes | S-1-0-1 yes
+ S-1-0x0000000000ff-1 | no yes | S-1-255-1 yes
+ S-1-0x0001000000ff-1 | yes yes | S-1-0x1000000FF-1 no
+ S-1-0xffffffffffff-1 | yes yes | S-1-0xFFFFFFFFFFFF-1 yes
+ S-1-0xff00ff00ff-1 | no yes | S-1-0xFF00FF00FF-1 no
+ S-1-0xff00ff00ff00ff-1 | no no | ø -
+ S-1-4294967296-1 | no yes | S-1-0x100000000-1 no
+ S-1-01-1 | no yes | S-1-1-1 yes
+ S-1-08-1 | no yes | S-1-8-1 yes
+ S-1-001-1 | no yes | S-1-1-1 yes
+ S-1-1 | no no | ø -
+ S-1-5 | no no | ø -
+
+ The inverse operations were modeled after “ConvertSidToStringSidA()”.
+*)
+module Con_MS = struct
+ let name = "MS"
+
+ let parse_hex_ia s p =
+ assert (String.length s - p - 2 > 0);
+ let e = p + ident_auth_hexlen in
+ let b = Buffer.create ident_auth_hexlen in
+ Buffer.add_string b "0x"; (* hex indicator for U64.of_string *)
+ let i = ref (p + 2) in
+ while !i < min (String.length s) e
+ && Util.is_xdigit s.[!i]
+ do
+ Buffer.add_char b s.[!i];
+ incr i;
+ done;
+ U64.of_string (Buffer.contents b),
+ !i
+
+ (* MS doesn’t care for leading zeros. *)
+ let valid_decimal d =
+ String.length d > 0
+
+ (* MS accepts hex-formatted ias of arbitrary values as long as they
+ fit a u64 *)
+ let valid_ia _hex v = true
+
+ (* Interestingly, subauths behave as specified. *)
+ let valid_sas v =
let nsa = Array.length v in
0 < nsa && nsa <= max_subauth_count
-end (* [module Vtor_strict] *)
+
+ (* No leading zeros in the hex output despite the spec mandating this
+ only for decimal formatting. *)
+ let pad_hex_ia _niax =
+ 0
+end (* [module Con_strict] *)
module type StringFmt_intf = sig
val decode : string -> (sid, string) result
val encode : sid -> string
end
-module MkStringFmt (Vtor : Validator) = struct
-
- let expect_char s c p =
- if s.[p] = c then () else
- raise
- (Invalid_argument
- (Printf.sprintf
- "Invalid SID [%s]: expected ‘%c’ at position %d, found ‘%c’"
- s c p s.[p]))
-
- let is_digit c = '0' <= c && c <= '9'
-
- let is_xdigit c =
- '0' <= c && c <= '9'
- || 'a' <= c && c <= 'f'
- || 'A' <= c && c <= 'F'
+module MkStringFmt (Con : Conformance) = struct
let read_decimal_string f s p =
let n = String.length s in
assert (p < n);
let p' = ref p in
let b = Buffer.create 16 in
- while !p' < n && is_digit s.[!p'] do
+ while !p' < n && Util.is_digit s.[!p'] do
Buffer.add_char b s.[!p'];
incr p'
done;
- let nb = Buffer.length b in
- if nb = 0 then
+ let d = Buffer.contents b in
+ if not (Con.valid_decimal d) then
raise (Invalid_argument
(Printf.sprintf
- "Invalid SID [%s]: expected decimal at position %d" s p))
+ "Invalid SID [%s]: “%s” is not a valid decimal in mode %s"
+ s d Con.name))
else
- p + nb,
- f (Buffer.contents b)
+ p + String.length d,
+ f d
let read_decimal_u64 = read_decimal_string U64.of_string
let read_decimal_u32 = read_decimal_string U32.of_string
- let ident_auth_hexlen = 14 (* 0x, 12 × hex digit *)
- let ident_auth_hexmin = U64.of_string "0x0001_0000_0000"
-
(* specialized cause only needed for ia *)
let read_ident_auth_hex s p =
- assert (p <= String.length s - ident_auth_hexlen);
- let e = p + ident_auth_hexlen - 1 in
- let b = Bytes.make ident_auth_hexlen '\x2a' in
- Bytes.set b 0 '0'; (* hex indicator for U64.of_string *)
- Bytes.set b 1 'x';
- for i = p + 2 to e do
- (* assumption: prefix “0x” checked by caller *)
- if not (is_xdigit s.[i]) then
- raise (Invalid_argument
- (Printf.sprintf
- "Invalid SID [%s]: expected hexadecimal digit at \
- position %d while parsing ident auth, got ‘%c’"
- s i s.[i]))
- done;
- Bytes.blit_string s (p+2) b 2 12;
- let ia = U64.of_string (Bytes.unsafe_to_string b) in
- if not (Vtor.ia true ia) then
+ let ia, p' = Con.parse_hex_ia s p in
+ if not (Con.valid_ia true ia) then
raise
(Invalid_argument
(Printf.sprintf
"input malformed: hex-encoded identifier authority failed \
“%s” validation (value=%s)"
- Vtor.name (U64.to_string ia)))
+ Con.name (U64.to_string ia)))
else
- p + ident_auth_hexlen,
- ia
+ p', ia
let ident_auth_decimal s p =
let p, ia = read_decimal_u64 s p in
- if not (Vtor.ia false ia) then
+ if not (Con.valid_ia false ia) then
raise
(Invalid_argument
(Printf.sprintf
"input malformed: decimal identifier authority failed \
“%s” validation (value=%s)"
- Vtor.name (U64.to_string ia))) else
+ Con.name (U64.to_string ia))) else
p, ia
let read_ident_auth s p =
@@ -173,10 +260,10 @@ module MkStringFmt (Vtor : Validator) = struct
"Invalid SID: ‘%s’ too short to be a SID in string format" s)
else begin
try
- expect_char s 'S' 0;
- expect_char s '-' 1;
- expect_char s '1' 2;
- expect_char s '-' 3;
+ Util.expect_char s 'S' 0;
+ Util.expect_char s '-' 1;
+ Util.expect_char s '1' 2;
+ Util.expect_char s '-' 3;
let p = 4 in
let p, ia = read_ident_auth s p in
let sa = ref [] and p' = ref p in
@@ -198,12 +285,12 @@ module MkStringFmt (Vtor : Validator) = struct
p' := np
done;
let sas = Array.of_list (List.rev !sa) in
- if not (Vtor.sas sas) then
+ if not (Con.valid_sas sas) then
Error
(Printf.sprintf
"input malformed: subauthority list failed “%s” validation \
(count=%n)"
- Vtor.name (Array.length sas))
+ Con.name (Array.length sas))
else
Ok { sid_ident_auth = ia
; sid_sub_auths = sas
@@ -219,7 +306,7 @@ module MkStringFmt (Vtor : Validator) = struct
else begin
let iax = U64.to_string_hex ia in
let niax = String.length iax in
- let pad = ident_auth_hexlen - niax in
+ let pad = Con.pad_hex_ia niax in
if pad = 0 then Buffer.add_string b iax else
(Buffer.add_string b (String.sub ident_auth_blank 0 (2+pad));
Buffer.add_string b (String.sub iax 2 (niax - 2)))
@@ -241,7 +328,8 @@ module MkStringFmt (Vtor : Validator) = struct
end (* [module MkStringFmt] *)
-module StringFmt = MkStringFmt (Vtor_strict)
+module StringFmt = MkStringFmt (Con_strict)
+module MSStringFmt = MkStringFmt (Con_MS)
module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
diff --git a/sid.mli b/sid.mli
index e2c94df..a21c5ec 100644
--- a/sid.mli
+++ b/sid.mli
@@ -46,6 +46,17 @@ module StringFmt :
(** [encode s] convert SID [s] to its string representation. *)
end
+(** Conversions to and from the {e string format syntax} with permissive
+ input validation. *)
+module MSStringFmt :
+ sig
+ val decode : string -> (t, string) result
+ (** [decode b] parse string buffer [b] into a SID. *)
+
+ val encode : t -> string
+ (** [encode s] convert SID [s] to its string representation. *)
+ end
+
(** Conversion to and from the {e packet representation} (MS-DTYP 2.4.2.2). *)
module PacketRep :
sig
diff --git a/sid_test.ml b/sid_test.ml
index 26a125b..b339190 100644
--- a/sid_test.ml
+++ b/sid_test.ml
@@ -255,6 +255,91 @@ let sf_print_iaxx_ok () =
~msg:(Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string sid) str)
(Sid.to_string sid) str
+let ms_unwrap_of_string s =
+ match Sid.MSStringFmt.decode s with
+ | Error e ->
+ assert_failure
+ (Printf.sprintf "error parsing assumed well-formed sid [%s]: %s" s e)
+ | Ok r -> r
+
+let mssf_parse_ok () =
+ (* accept well-formed input *)
+ let s = ms_unwrap_of_string "S-1-1-0"
+ and z = Sid.create_unsafe U64.one [| U32.zero |] in
+ assert_bool
+ (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string z))
+ (Sid.equal s z);
+ let w = Sid.WellKnown.world in
+ assert_bool
+ (Printf.sprintf "[%s] ≠ [well known: %s]"
+ (Sid.to_string s) (Sid.to_string w))
+ (Sid.equal s w)
+
+let mssf_parse_hex_junk_ok () =
+ (* accept certain kinds of malformed input; note: we expect hex digit
+ to be lowercase *)
+ let samples =
+ [ "S-1-0x000000000000-1" , false, Some ("S-1-0-1" , true )
+ ; "S-1-0x0000000000ff-1" , false, Some ("S-1-255-1" , true )
+ ; "S-1-0x0001000000ff-1" , true , Some ("S-1-0x1000000ff-1" , false)
+ ; "S-1-0xffffffffffff-1" , true , Some ("S-1-0xffffffffffff-1", true )
+ ; "S-1-0xff00ff00ff-1" , false, Some ("S-1-0xff00ff00ff-1" , false)
+ ; "S-1-0xff00ff00ff00ff-1", false, None
+ ; "S-1-4294967296-1" , false, Some ("S-1-0x100000000-1" , false)
+ ; "S-1-01-1" , false, Some ("S-1-1-1" , true )
+ ; "S-1-08-1" , false, Some ("S-1-8-1" , true )
+ ; "S-1-001-1" , false, Some ("S-1-1-1" , true )
+ ; "S-1-1" , false, None
+ ; "S-1-5" , false, None
+ ]
+ in
+ let is_wellformed s =
+ match Sid.StringFmt.decode s with Ok _ -> true | Error _ -> false in
+ let check (input, inwell, output) =
+ let () =
+ if is_wellformed input then
+ assert_bool
+ (Printf.sprintf "Sid [%s] parsed a-ok despite strict mode" input)
+ inwell
+ else
+ assert_bool
+ (Printf.sprintf "Sid [%s] failed to parse with strict mode" input)
+ (not inwell)
+ in
+ let () =
+ match Sid.MSStringFmt.decode input, output with
+ | Ok s, None ->
+ assert_bool
+ (Printf.sprintf "Sid [%s] unexpectedly parsed a-ok with MS mode"
+ input)
+ false
+ | Ok s, Some (output, outwell) -> (* test round-trip results *)
+ let reenc = Sid.MSStringFmt.encode s in
+ let () =
+ assert_bool
+ (Printf.sprintf "Sid [%s] re-encoded as [%s] failed to match \
+ expected value of [%s]"
+ input reenc output)
+ (output = reenc)
+ in (* finally: validate behavior of strict parse against output *)
+ assert_bool
+ (Printf.sprintf "Sid [%s] re-encoded as [%s] unexpectedly \
+ %s in strict mode"
+ input reenc
+ (if outwell then "failed to parse" else "parsed ok"))
+ (is_wellformed reenc = outwell)
+ | Error _, None -> () (* bad even by MS standards *)
+ | Error e, Some (output, _) ->
+ assert_bool
+ (Printf.sprintf "Sid [%s] failed to parse in MS mode (%s), \
+ expected [%s] after reconversion"
+ input e output)
+ false
+ in ()
+ in
+ List.iter check samples
+
+
let pr_encode_null_ok () =
let x =
Sid.WellKnown.null
@@ -455,6 +540,11 @@ let string_format_test = "string-format-syntax" >:::
; "print-iaxx-ok" >:: sf_print_iaxx_ok
]
+let ms_string_format_test = "ms-string-format-syntax" >:::
+ [ "parse-ok" >:: mssf_parse_ok
+ ; "parse-hex-junk-ok" >:: mssf_parse_hex_junk_ok
+ ]
+
let packet_rep_test = "packet-rep" >:::
[ "encode-null-ok" >:: pr_encode_null_ok
; "encode-all-ok" >:: pr_encode_all_ok
@@ -476,6 +566,7 @@ let toplevel_test = "toplevel" >:::
let () =
ignore (run_test_tt_main string_format_test);
- ignore (run_test_tt_main packet_rep_test );
- ignore (run_test_tt_main toplevel_test )
+ ignore (run_test_tt_main ms_string_format_test);
+ ignore (run_test_tt_main packet_rep_test);
+ ignore (run_test_tt_main toplevel_test)