summaryrefslogtreecommitdiff
path: root/sid.ml
diff options
context:
space:
mode:
Diffstat (limited to 'sid.ml')
-rw-r--r--sid.ml78
1 files changed, 69 insertions, 9 deletions
diff --git a/sid.ml b/sid.ml
index 38c97f2..a696237 100644
--- a/sid.ml
+++ b/sid.ml
@@ -55,6 +55,11 @@ module StringFmt = struct
let is_digit c = '0' <= c && c <= '9'
+ let is_xdigit c =
+ '0' <= c && c <= '9'
+ || 'a' <= c && c <= 'f'
+ || 'A' <= c && c <= 'F'
+
let read_decimal_string f s p =
let n = String.length s in
assert (p < n);
@@ -76,6 +81,56 @@ module StringFmt = struct
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;
+ p + ident_auth_hexlen,
+ U64.of_string (Bytes.unsafe_to_string b)
+
+ let ident_auth_decimal s p =
+ let p, ia = read_decimal_u64 s p in
+ if ia >= ident_auth_hexmin then
+ raise
+ (Invalid_argument
+ (Printf.sprintf
+ "input malformed: identifier authority from 2³² on must \
+ be hex-encoded (value=%s)"
+ (U64.to_string ia))) else
+ p, ia
+
+ let read_ident_auth s p =
+ let r = String.length s - p in
+ if r < ident_auth_hexlen then ident_auth_decimal s p else (* hex can’t fit *)
+ match s.[p], s.[p+1] with
+ | '0', 'x' ->
+ (let p, ia = read_ident_auth_hex s p in
+ if ia < ident_auth_hexmin 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
+ p, ia)
+ | _ -> ident_auth_decimal s p
+
(*
* The spec ([MS-DTYP]):
*
@@ -94,7 +149,7 @@ module StringFmt = struct
expect_char s '1' 2;
expect_char s '-' 3;
let p = 4 in
- let p, ia = read_decimal_u64 s p in
+ let p, ia = read_ident_auth s p in
if ia > max_ident_auth then
raise (Invalid_argument
(Printf.sprintf
@@ -122,8 +177,19 @@ module StringFmt = struct
with Invalid_argument e -> Error e;
end
+ let ident_auth_blank = "0x000000000000"
+
let fmt_ident_auth b ia =
- Buffer.add_string b (U64.to_string ia)
+ if U64.compare ia ident_auth_hexmin < 0 then
+ Buffer.add_string b (U64.to_string ia)
+ else begin
+ let iax = U64.to_string_hex ia in
+ let niax = String.length iax in
+ let pad = ident_auth_hexlen - 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)))
+ end
let fmt_sub_auths b sas =
Array.iter
@@ -201,13 +267,7 @@ module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
"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 ia = U64.of_bytes_big_endian b 0 |> U64.logand max_ident_auth in
let sas = Array.make nsa (U32.zero)
and read_u32 =
match endian with