summaryrefslogtreecommitdiff
path: root/sid.ml
diff options
context:
space:
mode:
Diffstat (limited to 'sid.ml')
-rw-r--r--sid.ml76
1 files changed, 51 insertions, 25 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 *)