summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sid.ml76
-rw-r--r--sid_test.ml16
2 files changed, 59 insertions, 33 deletions
diff --git a/sid.ml b/sid.ml
index 4edcf5a..e8bc4ad 100644
--- a/sid.ml
+++ b/sid.ml
@@ -44,7 +44,35 @@ 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 StringFmt = struct
+module type Validator = sig
+ val name : string
+ val ia : bool -> U64.t -> bool
+ val sas : U32.t array -> bool
+end
+
+(** Validate as though the spec in [MS-DTYP] were normative. *)
+module Vtor_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 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 nsa = Array.length v in
+ 0 < nsa && nsa <= max_subauth_count
+end (* [module Vtor_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
@@ -103,32 +131,26 @@ module StringFmt = struct
done;
Bytes.blit_string s (p+2) b 2 12;
let ia = U64.of_string (Bytes.unsafe_to_string b) in
- if ia < ident_auth_hexmin then
+ if not (Vtor.ia true ia) then
raise
(Invalid_argument
(Printf.sprintf
- "input malformed: identifier authority less than 2³² must \
- not be hex-encoded (value=%s)"
- (U64.to_string ia)))
- else if ia > max_ident_auth then
- raise (Invalid_argument
- (Printf.sprintf
- "Invalid SID: identifier authority (value=%s) cannot fit \
- 6 B (%s)"
- (U64.to_string ia) (U64.to_string max_ident_auth)))
+ "input malformed: hex-encoded identifier authority failed \
+ “%s” validation (value=%s)"
+ Vtor.name (U64.to_string ia)))
else
p + ident_auth_hexlen,
ia
let ident_auth_decimal s p =
let p, ia = read_decimal_u64 s p in
- if ia >= ident_auth_hexmin then
+ if not (Vtor.ia false ia) then
raise
(Invalid_argument
(Printf.sprintf
- "input malformed: identifier authority from 2³² on must \
- be hex-encoded (value=%s)"
- (U64.to_string ia))) else
+ "input malformed: decimal identifier authority failed \
+ “%s” validation (value=%s)"
+ Vtor.name (U64.to_string ia))) else
p, ia
let read_ident_auth s p =
@@ -157,12 +179,6 @@ module StringFmt = struct
expect_char s '-' 3;
let p = 4 in
let p, ia = read_ident_auth s p in
- if p = n || s.[p] <> '-' then
- raise (Invalid_argument
- (Printf.sprintf
- "Invalid SID: error parsing SID [%s] at position %d, \
- grammar mandates at least one subauthority"
- s p)) else
let sa = ref [] and p' = ref p in
while !p' < n - 1
&& List.length !sa < max_subauth_count
@@ -181,9 +197,17 @@ module StringFmt = struct
sa := d :: !sa;
p' := np
done;
- Ok { sid_ident_auth = ia
- ; sid_sub_auths = Array.of_list (List.rev !sa)
- }
+ let sas = Array.of_list (List.rev !sa) in
+ if not (Vtor.sas sas) then
+ Error
+ (Printf.sprintf
+ "input malformed: subauthority list failed “%s” validation \
+ (count=%n)"
+ Vtor.name (Array.length sas))
+ else
+ Ok { sid_ident_auth = ia
+ ; sid_sub_auths = sas
+ }
with Invalid_argument e -> Error e;
end
@@ -215,7 +239,9 @@ module StringFmt = struct
fmt_sub_auths b s.sid_sub_auths;
Buffer.contents b
-end (* [module StringFmt] *)
+end (* [module MkStringFmt] *)
+
+module StringFmt = MkStringFmt (Vtor_strict)
module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
diff --git a/sid_test.ml b/sid_test.ml
index 7da0d7f..26a125b 100644
--- a/sid_test.ml
+++ b/sid_test.ml
@@ -111,8 +111,8 @@ let sf_parse_nosa_fail () =
(Printf.sprintf "unexpectedly parsed garbage as SID [%s]"
(Sid.to_string s))
| Error e ->
- assert_equal e "Invalid SID: error parsing SID [S-1-1] at position 5, \
- grammar mandates at least one subauthority"
+ assert_equal e "input malformed: subauthority list failed “strict” \
+ validation (count=0)"
let sf_parse_trailing_ok () =
let s = unwrap_of_string "S-1-0-0-" in
@@ -139,8 +139,8 @@ let sf_parse_oobia_fail () =
with
| Ok _ -> assert_failure "unexpectedly parsed the out of bounds subauth"
| Error e ->
- assert_equal e "input malformed: identifier authority from 2³² on must \
- be hex-encoded (value=18446744073709551615)"
+ assert_equal e "input malformed: decimal identifier authority failed \
+ “strict” validation (value=18446744073709551615)"
let sf_parse_oobsa_fail () =
match Sid.of_string
@@ -189,8 +189,8 @@ let sf_parse_iaxxoob_fail () =
(* ias <= UINT32_MAX → decimal; hex not allowed *)
match Sid.of_string "S-1-0x0000deadbeef-17-01" with
| Error e ->
- let expect = "input malformed: identifier authority less than 2³² must \
- not be hex-encoded (value=3735928559)"
+ let expect = "input malformed: hex-encoded identifier authority failed \
+ “strict” validation (value=3735928559)"
in
assert_equal
~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
@@ -236,8 +236,8 @@ let sf_parse_iaxxlong_fail () =
(* too many digits, need exactly 12 *)
match Sid.of_string "S-1-0xC01DC01DB100D-17-01" with
| Error e ->
- let expect = "Invalid SID: error parsing SID [S-1-0xC01DC01DB100D-17-01] \
- at position 18, grammar mandates at least one subauthority"
+ let expect = "input malformed: subauthority list failed “strict” \
+ validation (count=0)"
in
assert_equal
~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)