open OUnit module U64 = Stdint.Uint64 module U32 = Stdint.Uint32 (* 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 [| Uint32.zero ; Uint32.one ; Uint32.of_int 2 ; Uint32.of_int 3 ; Uint32.of_int 4 ; Uint32.of_int 5 ; Uint32.of_int 6 ; Uint32.of_int 7 ; Uint32.of_int 8 ; Uint32.of_int 9 ; Uint32.of_int 10 ; Uint32.of_int 11 ; Uint32.of_int 12 ; Uint32.of_int 13 ; Uint32.of_int 14 |] Uint64.one ) let create_ok () = let w = Sid.WellKnown.everyone and s = match Sid.create ~sa:[| Stdint.Uint32.zero |] Stdint.Uint64.one with | None -> assert_failure "Sid.create failed for S-1-0" | Some s -> s in assert_bool (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string w)) (Sid.equal s w) let create_fail () = let sas = Array.make 16 Stdint.Uint32.one in match Sid.create ~sa:sas Stdint.Uint64.zero with | None -> () | Some s -> assert_failure ("Sid.create succeeded on invalid sa array") let unwrap_of_string s = match Sid.of_string s with | Error e -> assert_failure (Printf.sprintf "error parsing assumed well-formed sid [%s]: %s" s e) | Ok r -> r let sf_parse_ok () = let s = unwrap_of_string "S-1-1-0" and z = Stdint.((Sid.create_unsafe [| Uint32.zero |] Uint64.one)) 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 sf_parse_empty_fail () = match Sid.of_string "" with | Ok _ -> assert_failure "unexpectedly parsed the empty string" | Error e -> assert_equal e "Invalid SID: ‘’ too short to be a SID in string format" let sf_parse_junk_fail () = match Sid.of_string "not a sid" with | Ok _ -> assert_failure "unexpectedly parsed junk inputs as SID" | Error e -> assert_equal e "Invalid SID [not a sid]: expected ‘S’ at position 0, found ‘n’" let sf_parse_ia_junk_fail () = match Sid.of_string "S-I-3-3-7" with | Ok _ -> assert_failure "unexpectedly parsed junk inputs as SID" | Error e -> assert_equal e "Invalid SID [S-I-3-3-7]: expected ‘1’ at position 2, found ‘I’" let sf_parse_trailing_ok () = let s = unwrap_of_string "S-1-0-0-" in assert_equal (Sid.to_string s) "S-1-0-0" let sf_parse_maxint_ok () = let s = unwrap_of_string (Printf.sprintf "S-1-281474976710655-%s-%s" (U32.to_string U32.max_int) (U32.to_string U32.max_int)) in assert_equal (Sid.to_string s) "S-1-281474976710655-4294967295-4294967295" let sf_parse_oobia_fail () = match Sid.of_string (Printf.sprintf "S-1-%s-42" (U64.to_string U64.max_int)) with | Ok _ -> assert_failure "unexpectedly parsed the out of bounds subauth" | Error e -> assert_equal e "Invalid SID: identifier authority cannot fit 6 B \ (281474976710655)" let sf_parse_oobsa_fail () = match Sid.of_string (Printf.sprintf "S-1-42-%s" (U64.to_string U64.max_int)) with | Ok _ -> assert_failure "unexpectedly parsed the out of bounds subauth" | Error e -> assert_equal e "Invalid SID: error parsing subauth at position 7, \ (err: Uint32.of_string)" let sf_parse_long_ok () = let s = unwrap_of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14" and l = max_sid in assert_bool (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string l)) (Sid.equal s l) let sf_parse_too_long_ok () = (* must ignore trailing subauths *) let s1 = unwrap_of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15" and s2 = unwrap_of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15-16-17" and l = max_sid in assert_bool (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s1) (Sid.to_string l)) (Sid.equal s1 l); assert_bool (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s2) (Sid.to_string l)) (Sid.equal s2 l) let pr_encode_null_ok () = let x = Sid.WellKnown.null |> Sid.PacketRep.encode |> Xxd.xxd_of_bytes ~blocklen:2 in let expect = "0101 0000 0000 0000 0000 0000" in (* vvcc iiii iiii iiii ssss ssss *) assert_equal ~msg:(Printf.sprintf "[%s] ≠ [%s]" x expect) x expect let pr_encode_be_ok () = let sid = "S-1-0-42" in let sle = unwrap_of_string sid |> Sid.PacketRep.encode |> Xxd.xxd_of_bytes ~blocklen:2 and sbe = unwrap_of_string sid |> Sid.PacketRep.encode ~endian:Big |> Xxd.xxd_of_bytes ~blocklen:2 in let expect_le = "0101 0000 0000 0000 2a00 0000" and expect_be = "0101 0000 0000 0000 0000 002a" in (* vvcc iiii iiii iiii ssss ssss *) assert_equal ~msg:(Printf.sprintf "[%s] ≠ [%s]" sle expect_le) sle expect_le; assert_equal ~msg:(Printf.sprintf "[%s] ≠ [%s]" sbe expect_be) sbe expect_be let pr_encode_all_ok () = let x = Sid.WellKnown.everyone |> Sid.PacketRep.encode |> Xxd.xxd_of_bytes ~blocklen:2 in let expect = "0101 0000 0000 0001 0000 0000" in (* vvcc iiii iiii iiii ssss ssss *) assert_equal ~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_be_ok () = let sid = unwrap_of_string "S-1-1-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15" and sle = match Xxd.bytes_of_xxd "010f 0000 0000 0001 \ 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" |> Sid.PacketRep.decode with | Ok s -> s | Error e -> assert_failure (Printf.sprintf "error decoding SID: %s" e) and sbe = match Xxd.bytes_of_xxd "010f 0000 0000 0001 \ 0000 0001 0000 0002 0000 0003 0000 0004 \ 0000 0005 0000 0006 0000 0007 0000 0008 \ 0000 0009 0000 000a 0000 000b 0000 000c \ 0000 000d 0000 000e 0000 000f" |> Sid.PacketRep.decode ~endian:Big with | Ok s -> s | Error e -> assert_failure (Printf.sprintf "error decoding SID: %s" e) in assert_bool (Printf.sprintf "le: [%s] ≠ [%s]" (Sid.to_string sid) (Sid.to_string sle)) (Sid.equal sid sle); assert_bool (Printf.sprintf "be: [%s] ≠ [%s]" (Sid.to_string sid) (Sid.to_string sbe)) (Sid.equal sid sbe) 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 ; "parse-junk-fail" >:: sf_parse_junk_fail ; "parse-ia-junk-fail" >:: sf_parse_ia_junk_fail ; "parse-trailing-ok" >:: sf_parse_trailing_ok ; "parse-maxint-ok" >:: sf_parse_maxint_ok ; "parse-oobia-fail" >:: sf_parse_oobia_fail ; "parse-oobsa-fail" >:: sf_parse_oobsa_fail ; "parse-long-ok" >:: sf_parse_long_ok ; "parse-too-long-ok" >:: sf_parse_too_long_ok ] let packet_rep_test = "packet-rep" >::: [ "encode-null-ok" >:: pr_encode_null_ok ; "encode-all-ok" >:: pr_encode_all_ok ; "encode-be-ok" >:: pr_encode_be_ok ; "decode-all-ok" >:: pr_decode_all_ok ; "decode-be-ok" >:: pr_decode_be_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 () = ignore (run_test_tt_main string_format_test); ignore (run_test_tt_main packet_rep_test )