751 lines
29 KiB
OCaml
751 lines
29 KiB
OCaml
type _ s = Bytes : Bytes.t s | String : String.t s | Bigstring : bigstring s
|
|
|
|
and bigstring =
|
|
(char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
|
|
|
|
let title :
|
|
type a k.
|
|
[ `HMAC | `HMAC_feed | `Digest ] -> k Digestif.hash -> a s -> string =
|
|
fun computation hash input ->
|
|
let pp_computation ppf = function
|
|
| `HMAC -> Fmt.string ppf "hmac"
|
|
| `HMAC_feed -> Fmt.string ppf "hmac_feed"
|
|
| `Digest -> Fmt.string ppf "digest" in
|
|
let pp_hash : type k. k Digestif.hash Fmt.t =
|
|
fun ppf -> function
|
|
| Digestif.MD5 -> Fmt.string ppf "md5"
|
|
| Digestif.SHA1 -> Fmt.string ppf "sha1"
|
|
| Digestif.RMD160 -> Fmt.string ppf "rmd160"
|
|
| Digestif.SHA224 -> Fmt.string ppf "sha224"
|
|
| Digestif.SHA256 -> Fmt.string ppf "sha256"
|
|
| Digestif.SHA384 -> Fmt.string ppf "sha384"
|
|
| Digestif.SHA512 -> Fmt.string ppf "sha512"
|
|
| Digestif.SHA3_224 -> Fmt.string ppf "sha3_224"
|
|
| Digestif.SHA3_256 -> Fmt.string ppf "sha3_256"
|
|
| Digestif.KECCAK_256 -> Fmt.string ppf "keccak_256"
|
|
| Digestif.SHA3_384 -> Fmt.string ppf "sha3_384"
|
|
| Digestif.SHA3_512 -> Fmt.string ppf "sha3_512"
|
|
| Digestif.WHIRLPOOL -> Fmt.string ppf "whirlpool"
|
|
| Digestif.BLAKE2B -> Fmt.string ppf "blake2b"
|
|
| Digestif.BLAKE2S -> Fmt.string ppf "blake2s" in
|
|
let pp_input : type a. a s Fmt.t =
|
|
fun ppf -> function
|
|
| Bytes -> Fmt.string ppf "bytes"
|
|
| String -> Fmt.string ppf "string"
|
|
| Bigstring -> Fmt.string ppf "bigstring" in
|
|
Fmt.str "%a:%a:%a" pp_computation computation pp_hash hash pp_input input
|
|
|
|
let bytes = Bytes
|
|
let string = String
|
|
let bigstring = Bigstring
|
|
|
|
let test_hmac :
|
|
type k a. a s -> k Digestif.hash -> string -> a -> k Digestif.t -> unit =
|
|
fun kind hash key input expect ->
|
|
let title = title `HMAC hash kind in
|
|
let test_hash = Alcotest.testable (Digestif.pp hash) (Digestif.equal hash) in
|
|
match kind with
|
|
| Bytes ->
|
|
let result = Digestif.hmaci_bytes hash ~key (fun f -> f input) in
|
|
Alcotest.(check test_hash) title expect result
|
|
| String ->
|
|
let result = Digestif.hmaci_string hash ~key (fun f -> f input) in
|
|
Alcotest.(check test_hash) title expect result
|
|
| Bigstring ->
|
|
let result = Digestif.hmaci_bigstring hash ~key (fun f -> f input) in
|
|
Alcotest.(check test_hash) title expect result
|
|
|
|
let test_hmac_feed :
|
|
type k a. a s -> k Digestif.hash -> string -> a -> k -> unit =
|
|
fun kind hash key input expect ->
|
|
let title = title `HMAC_feed hash kind in
|
|
let module H = (val Digestif.module_of hash) in
|
|
let test_hash = Alcotest.testable H.pp H.equal in
|
|
let hmac_ctx = H.hmac_init ~key in
|
|
let total_len =
|
|
match kind with
|
|
| Bytes -> Bytes.length input
|
|
| String -> String.length input
|
|
| Bigstring -> Bigarray.Array1.dim input in
|
|
let rec loop hmac_ctx off =
|
|
if off = total_len
|
|
then hmac_ctx
|
|
else
|
|
let len = min (total_len - off) 16 in
|
|
let hmac_ctx =
|
|
match kind with
|
|
| Bytes -> H.hmac_feed_bytes hmac_ctx ~off ~len input
|
|
| String -> H.hmac_feed_string hmac_ctx ~off ~len input
|
|
| Bigstring -> H.hmac_feed_bigstring hmac_ctx ~off ~len input in
|
|
loop hmac_ctx (off + len) in
|
|
Alcotest.check test_hash title expect (H.hmac_get (loop hmac_ctx 0))
|
|
|
|
let test_digest : type k a. a s -> k Digestif.hash -> a -> k Digestif.t -> unit
|
|
=
|
|
fun kind hash input expect ->
|
|
let title = title `Digest hash kind in
|
|
let test_hash = Alcotest.testable (Digestif.pp hash) (Digestif.equal hash) in
|
|
match kind with
|
|
| Bytes ->
|
|
let result = Digestif.digesti_bytes hash (fun f -> f input) in
|
|
Alcotest.(check test_hash) title expect result
|
|
| String ->
|
|
let result = Digestif.digesti_string hash (fun f -> f input) in
|
|
Alcotest.(check test_hash) title expect result
|
|
| Bigstring ->
|
|
let result = Digestif.digesti_bigstring hash (fun f -> f input) in
|
|
Alcotest.(check test_hash) title expect result
|
|
|
|
let make_hmac :
|
|
type a k.
|
|
name:string ->
|
|
a s ->
|
|
k Digestif.hash ->
|
|
string ->
|
|
a ->
|
|
k Digestif.t ->
|
|
unit Alcotest.test_case =
|
|
fun ~name kind hash key input expect ->
|
|
(name, `Quick, fun () -> test_hmac kind hash key input expect)
|
|
|
|
let make_hmac_feed :
|
|
type a k.
|
|
name:string ->
|
|
a s ->
|
|
k Digestif.hash ->
|
|
string ->
|
|
a ->
|
|
k ->
|
|
unit Alcotest.test_case =
|
|
fun ~name kind hash key input expect ->
|
|
(name, `Quick, fun () -> test_hmac_feed kind hash key input expect)
|
|
|
|
let make_digest :
|
|
type a k.
|
|
name:string ->
|
|
a s ->
|
|
k Digestif.hash ->
|
|
a ->
|
|
k Digestif.t ->
|
|
unit Alcotest.test_case =
|
|
fun ~name kind hash input expect ->
|
|
(name, `Quick, fun () -> test_digest kind hash input expect)
|
|
|
|
let combine a b c =
|
|
let rec aux r a b c =
|
|
match (a, b, c) with
|
|
| xa :: ra, xb :: rb, xc :: rc -> aux ((xa, xb, xc) :: r) ra rb rc
|
|
| [], [], [] -> List.rev r
|
|
| _ -> raise (Invalid_argument "combine") in
|
|
aux [] a b c
|
|
|
|
let makes ~name kind hash keys inputs expects =
|
|
List.map
|
|
(fun (key, input, expect) -> make_hmac ~name kind hash key input expect)
|
|
(combine keys inputs expects)
|
|
|
|
let makes' ~name kind hash keys inputs expects =
|
|
List.map
|
|
(fun (key, input, expect) ->
|
|
make_hmac_feed ~name kind hash key input expect)
|
|
(combine keys inputs expects)
|
|
|
|
let to_bigstring s =
|
|
let ln = Bytes.length s in
|
|
let bi = Bigarray.Array1.create Bigarray.Char Bigarray.c_layout ln in
|
|
for i = 0 to ln - 1 do
|
|
bi.{i} <- Bytes.get s i
|
|
done ;
|
|
bi
|
|
|
|
let split3 lst =
|
|
let rec go (ax, ay, az) = function
|
|
| (x, y, z) :: r -> go (x :: ax, y :: ay, z :: az) r
|
|
| [] -> (List.rev ax, List.rev ay, List.rev az) in
|
|
go ([], [], []) lst
|
|
|
|
let keys_by, keys_st, keys_bi =
|
|
[
|
|
"Salut"; "Jefe"; "Lorenzo"; "Le son qui fait plaiz'";
|
|
"La c'est un peu chaud en vrai";
|
|
]
|
|
|> List.map (fun s ->
|
|
(Bytes.unsafe_of_string s, s, to_bigstring (Bytes.unsafe_of_string s)))
|
|
|> split3
|
|
|
|
let inputs_by, inputs_st, inputs_bi =
|
|
[
|
|
"Hi There"; "what do ya want for nothing?";
|
|
"C'est Lolo je bois de l'Ice Tea quand j'suis fonsde";
|
|
"Mes pecs dansent le flamenco, Lolo l'empereur du sale, dans le deal on \
|
|
m'surnomme Joe La Crapule";
|
|
"Y'a un pack de douze a cote du cadavre dans le coffre. Pourquoi t'etais \
|
|
Charlie mais t'etais pas Jean-Pierre Coffe. Ca sniffe tellement la coke, \
|
|
mes crottes de nez c'est d'la MD. J'deteste juste les keufs, j'aime bien \
|
|
les obeses et les pedes. Mamene finira dans le dico'. J'ai qu'un reuf: le \
|
|
poto Rico. Ca rotte-ca l'argent des clodos. C'est moi qu'ecrit tous les \
|
|
pornos. Cite-moi en controle de philo'. Toutes les miss grimpent aux \
|
|
rideaux.";
|
|
]
|
|
|> List.map (fun s ->
|
|
(Bytes.unsafe_of_string s, s, to_bigstring (Bytes.unsafe_of_string s)))
|
|
|> split3
|
|
|
|
let results_md5 =
|
|
[
|
|
"689e721d493b6eeea482947be736c808"; "750c783e6ab0b503eaa86e310a5db738";
|
|
"1cdd24eef6163afee7adc7c53dd6c9df"; "0316ebcad933675e84a81850e24d55b2";
|
|
"9ee938a2659d546ccc2e5993601964eb";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.md5)
|
|
|
|
let results_sha1 =
|
|
[
|
|
"b0a6490a6fcb9479a7aa2306ecb56730d6225dba";
|
|
"effcdf6ae5eb2fa2d27416d5f184df9c259a7c79";
|
|
"d80589525b1cc9f5e5ffd48ffd73d710ac89a3f1";
|
|
"0a5212b295e11a1de5c71873e70ce54f45119516";
|
|
"deaf6465e5945a0d04cba439c628ee9f47b95aef";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.sha1)
|
|
|
|
let results_sha224 =
|
|
[
|
|
"9a26f1380aae8c580441676891765c8a647ddf16a7d12fa427090901";
|
|
"a30e01098bc6dbbf45690f3a7e9e6d0f8bbea2a39e6148008fd05e44";
|
|
"b94a09654fc749ae6cb21c7765bf4938ff9af03e13d83fbf23342ce7";
|
|
"7c66e4c7297a22ca80e2e1db9774afea64b1e086be366d2da3e6bc83";
|
|
"438dc3311243cd54cc7ee24c9aac8528a1750abc595f06e68a331d2a";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.sha224)
|
|
|
|
let results_sha256, results_sha256' =
|
|
let raw_results_sha256 =
|
|
[
|
|
"2178f5f21b4311607bf9347bcde5f6552edb9ec5aa13b954d53de2fbfd8b75de";
|
|
"5bdcc146bf60754e6a042426089575c75a003f089d2739839dec58b964ec3843";
|
|
"aa36cd61caddefe26b07ba1d3d07ea978ed575c9d1f921837dff9f73e019713e";
|
|
"a7c8b53d68678a8e6e4d403c6b97cf0f82c4ef7b835c41039c0a73aa4d627d05";
|
|
"b2a83b628f7e0da71c3879b81075775072d0d35935c62cc6c5a79b337ccccca1";
|
|
] in
|
|
( List.map (Digestif.of_hex Digestif.sha256) raw_results_sha256,
|
|
List.map Digestif.SHA256.of_hex raw_results_sha256 )
|
|
|
|
let results_sha384 =
|
|
[
|
|
"43e75797c1d875c5e5e7e90d0525061703d6b95b6137461566c2d067304458e62c144bbe12c0b741dcfaa38f7d41575e";
|
|
"af45d2e376484031617f78d2b58a6b1b9c7ef464f5a01b47e42ec3736322445e8e2240ca5e69e2c78b3239ecfab21649";
|
|
"bd3b5c82edcd0f206aadff7aa89dbbc3a7655844ffc9f8f9fa17c90eb36b13ec7828fba7252c3f5d90cff666ea44d557";
|
|
"16461c2a44877c69fb38e4dce2edc822d68517917fc84d252de64132bd43c7cbe3310b7e8661741b7728000e8abf51e0";
|
|
"2c3751d1dc792344514928fad94672a256cf2f66344e4df96b0cc4cc3f6800aa5a628e9becf5f65672e1acf013284893";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.sha384)
|
|
|
|
let results_sha512 =
|
|
[
|
|
"5f26752be4a1282646ed8c6a611d4c621e22e3fa96e9e6bc9e19a86deaacf0315151c46f779c3184632ab5793e2ddcb2ff87ca11cc886130f033364b08aef4e2";
|
|
"164b7a7bfcf819e2e395fbe73b56e0a387bd64222e831fd610270cd7ea2505549758bf75c05a994a6d034f65f8f0e6fdcaeab1a34d4a6b4b636e070a38bce737";
|
|
"c2f2077f538171d7c6cbee0c94948f82987117a50229fb0b48a534e3c63553a9a9704cdb460c597c8b46b631e49c22a9d2d46bded40f8a77652f754ec725e351";
|
|
"89d7284e89642ec195f7a8ef098ef4e411fa3df17a07724cf13033bc6b7863968aad449cee973df9b92800d803ba3e14244231a86253cfacd1de882a542e945f";
|
|
"f6ecfca37d2abcff4b362f1919629e784c4b618af77e1061bb992c11d7f518716f5df5978b0a1455d68ceeb10ced9251306d2f26181407be76a219d48c36b592";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.sha512)
|
|
|
|
let results_sha3_224 =
|
|
[
|
|
"27d199d761adfa5530313acdf7e1680fbdea09236ac6395b43c4a0e6";
|
|
"7fdb8dd88bd2f60d1b798634ad386811c2cfc85bfaf5d52bbace5e66";
|
|
"179895b711ca2bebf420a2e7255564d4cb2217ea3ac8b2d45f29d127";
|
|
"5bc718d440729ba7d857543eed04cbec3374eb835da33e99f8e0561f";
|
|
"0f44044cd2cb5a02ec3b7dff4367c54a1ace6cb7d602e005684aee7c";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.sha3_224)
|
|
|
|
let results_sha3_256 =
|
|
[
|
|
"bb25b6f7672dab6734313c8c63aab800b2c451c81833509c1afdb986be9bdea3";
|
|
"c7d4072e788877ae3596bbb0da73b887c9171f93095b294ae857fbe2645e1ba5";
|
|
"f58a4c9641f87ead6c16525906857f5fce149bb822c4fe7a2abcaebe823d9e0f";
|
|
"1dcc5f9bcfb9fa35349d51c40672b2bd971afc32f9cf5e478ec442d6d90be4ce";
|
|
"8d1de07fd2312402f94d061a88b02dc1e0173e9d89750284b78d2bb004e9d3c1";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.sha3_256)
|
|
|
|
let results_keccak_256 =
|
|
[
|
|
"0dbf49d1c2d4625f87592309b3c7ceb2c1a2194dc866bb21be7ac6abb733f0f1";
|
|
"aa9aed448c7abc8b5e326ffa6a01cdedf7b4b831881468c044ba8dd4566369a1";
|
|
"7fce3f69adac930d657ce6998d6ad5ee102b5e7560e6690b4ca855e5d4c268a0";
|
|
"c6cf40deda9a1028823641235499c9b1891c6e2ab7d2bfa9db06890ce8bc855e";
|
|
"8af5e3a5ebc1a9927d43765c85ca455de007e357ea250ae3ed65b55765d3252a";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.keccak_256)
|
|
|
|
let results_sha3_384 =
|
|
[
|
|
"fddae4c273e970a5f530cc737b15c1f0546caf0900e29fdf0ce57512a4c6898ca38931d1d3d9827cf16712c52da814e6";
|
|
"f1101f8cbf9766fd6764d2ed61903f21ca9b18f57cf3e1a23ca13508a93243ce48c045dc007f26a21b3f5e0e9df4c20a";
|
|
"ba546a5edbd7cdf49f2669553241e9867af842eb508432e8191d64282a9bb6e856311be49c8e673d72f212d446d0bee9";
|
|
"f8d65fe91fe24a009263e9aee0267c48cafbe422b899a76763eb7ec095b6f0293033a504925a345ec70a3d984f98540d";
|
|
"2485a07f2b1585572d492db2dcfffcc30a35e019ad6490af3bef94e514b66f90913fb11a9a365e42d2d03e3cad28b847";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.sha3_384)
|
|
|
|
let results_sha3_512 =
|
|
[
|
|
"c2f4417c4dbc86cea2054beb755029c29c8dbed7781595fc9d5222214538a6975afc23f2f9e96683d33f547ea0df897bd1ca766fbb2c4ea674b9b9484e9e782a";
|
|
"5a4bfeab6166427c7a3647b747292b8384537cdb89afb3bf5665e4c5e709350b287baec921fd7ca0ee7a0c31d022a95e1fc92ba9d77df883960275beb4e62024";
|
|
"967c75d948f8b1efc263c4581287186500bf38daecda304fe68f34dacd622f299218ad47a4a112db5eedd5c8a30b03fefa17d20ddc3a735848f08fdc2d7ae592";
|
|
"ba3d37e455183ac5a9af109512d97bcc5e34daa5e10796625db8661519a4027b2cf89d282302bd8a620b8813ee98f781a9388e4f479e189899d820c1dcd50b8c";
|
|
"ce4a9d6e2b98b7fbb9ea668cd21b18c361d1d929fc6914192069b8c2672682a36ece8a6de07b17d4448afbc701b460264994ae9c79f26cfdd14a8fdc108d62a1";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.sha3_512)
|
|
|
|
let results_whirlpool =
|
|
[
|
|
"1174a4781245c2c78435b68bd0eb5e462f66a455ccfde94f61be594f9db841e7f4e85ba740f31dfd89186724f953cbd454451e987c608958dc9b563fd9594776";
|
|
"3d595ccd1d4f4cfd045af53ba7d5c8283fee6ded6eaf1269071b6b4ea64800056b5077c6a942cfa1221bd4e5aed791276e5dd46a407d2b8007163d3e7cd1de66";
|
|
"7af46cc6bb193d7958bd55a91509c99570cbd233d48a8fbf05207017040e27671024a21fad3877ecd2a309fc13c403ea8e83c6423ab8d695b654dbf6a1d2e8ee";
|
|
"a8646f7e371a1f9de1169d21de9a59ff2a32c73617c9b73708a226081b9316e81442e793e094c41a89e79705f1832c22e0cd3ac93d3b68a6842ddf35169908ae";
|
|
"b80dc14932e92fda0ba7f09e1db20d514633d15c2b89ad96a96198f4f751f2acf34e4fe0c9e2d13c4efaf7082c0871584b8dde7a367703d6fdf4f400a52f9432";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.whirlpool)
|
|
|
|
let results_blake2b =
|
|
[
|
|
"aba2eef053923ba3a671b54244580ca7c8dfa9c487431c3437e1a8504e166ed894778045a5c6a314fadee110a5254f6f370e9db1d3093a62e0448a5e91b1d4c6";
|
|
"6ff884f8ddc2a6586b3c98a4cd6ebdf14ec10204b6710073eb5865ade37a2643b8807c1335d107ecdb9ffeaeb6828c4625ba172c66379efcd222c2de11727ab4";
|
|
"42aadab231ff4edbdad29a18262bbb6ba74cf0850f40b64a92dc62a92608a65f06af850aa1988cd1e379cf9cc9a8f64d61125d7b3def292ae57e537bc202e812";
|
|
"4abf562dc64f4062ea59ae9b4e2061a7a6c1a75af74b3663fd05aa4437420b8deea657e395a7dbac02aef7b7d70dc8b8a8db99aa8db028961a5ee66bac22b0f0";
|
|
"69f9e4236cd0c50204e4f8b86dc1751d37cc195835e9db25c9b366f41e1d86cdeec6a8702dfed1bc0ed0d6a1e2c5af275c331ec91f884c979021fb64021915de";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.blake2b)
|
|
|
|
let results_rmd160 =
|
|
[
|
|
"65b3cb3360881842a0d454bd6e7bc1bfe838b384";
|
|
"dda6c0213a485a9e24f4742064a7f033b43c4069";
|
|
"f071dcd2514fd89de78a5a2db1128dfa3e54d503";
|
|
"bda5511e63389385218a8d902a70f2d8dc4dc074";
|
|
"6c2486f169432281b6d71ae5b6765239c3cc1ea6";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.rmd160)
|
|
|
|
let results_blake2s =
|
|
[
|
|
"5bb23bbe41678b23e6d38881d2515fdf5df253dd2e9a80075ea759c93e1bca3a";
|
|
"90b6281e2f3038c9056af0b4a7e763cae6fe5d9eb4386a0ec95237890c104ff0";
|
|
"5d0064cb2848ab5dc948876a6be3e5685301a744735c25858c0bd283a7940eb7";
|
|
"6903efd2383b13adaa985d00ca271ccb420ab8f953841081c9c15a2dfebf866c";
|
|
"b8e167de23a5f136dc26bf06da0d724ebf7310903c2f702403b66810a230d622";
|
|
]
|
|
|> List.map (Digestif.of_hex Digestif.blake2s)
|
|
|
|
module BLAKE2 = struct
|
|
let input_blake2b_file = "../blake2b.test"
|
|
let input_blake2s_file = "../blake2s.test"
|
|
|
|
let fold_s f a s =
|
|
let r = ref a in
|
|
String.iter (fun x -> r := f !r x) s ;
|
|
!r
|
|
|
|
let of_hex len hex =
|
|
let code x =
|
|
match x with
|
|
| '0' .. '9' -> Char.code x - 48
|
|
| 'A' .. 'F' -> Char.code x - 55
|
|
| 'a' .. 'z' -> Char.code x - 87
|
|
| _ -> raise (Invalid_argument "of_hex") in
|
|
let wsp = function ' ' | '\t' | '\r' | '\n' -> true | _ -> false in
|
|
fold_s
|
|
(fun (res, i, acc) -> function
|
|
| chr when wsp chr -> (res, i, acc)
|
|
| chr ->
|
|
match (acc, code chr) with
|
|
| None, x -> (res, i, Some (x lsl 4))
|
|
| Some y, x ->
|
|
Bytes.set res i (Char.unsafe_chr (x lor y)) ;
|
|
(res, succ i, None))
|
|
(Bytes.create len, 0, None)
|
|
hex
|
|
|> (function
|
|
| _, _, Some _ -> invalid_arg "of_hex"
|
|
| res, i, _ ->
|
|
if i = len
|
|
then res
|
|
else (
|
|
for i = i to len - 1 do
|
|
Bytes.set res i '\000'
|
|
done ;
|
|
res))
|
|
|> Bytes.unsafe_to_string
|
|
|
|
let parse kind ic =
|
|
ignore @@ input_line ic ;
|
|
ignore @@ input_line ic ;
|
|
let rec loop state acc =
|
|
match (state, input_line ic) with
|
|
| `In, line ->
|
|
let i = ref "" in
|
|
Scanf.sscanf line "in:\t%s" (fun v ->
|
|
i := of_hex (String.length v / 2) v) ;
|
|
loop (`Key !i) acc
|
|
| `Key i, line -> (
|
|
let k = ref None in
|
|
Scanf.sscanf line "key:\t%s" (fun v ->
|
|
k := Some (Digestif.to_raw_string kind (Digestif.of_hex kind v))) ;
|
|
match !k with
|
|
| Some k -> loop (`Hash (i, (k :> string))) acc
|
|
| None -> loop `In acc)
|
|
| `Hash (i, k), line -> (
|
|
let h = ref None in
|
|
Scanf.sscanf line "hash:\t%s" (fun v ->
|
|
h := Some (Digestif.of_hex kind v)) ;
|
|
match !h with
|
|
| Some h -> loop (`Res (i, k, h)) acc
|
|
| None -> loop `In acc)
|
|
| `Res v, "" -> loop `In (v :: acc)
|
|
| `Res v, _ ->
|
|
(* avoid malformed line *)
|
|
loop (`Res v) acc
|
|
| exception End_of_file -> List.rev acc in
|
|
loop `In []
|
|
|
|
let test_mac :
|
|
type k a.
|
|
a s ->
|
|
k Digestif.hash ->
|
|
(module Digestif.MAC) ->
|
|
string ->
|
|
a ->
|
|
k Digestif.t ->
|
|
unit =
|
|
fun kind hash (module Mac) key input expect ->
|
|
let title = title `HMAC hash kind in
|
|
let check (result : Mac.t) =
|
|
Alcotest.(check string)
|
|
title
|
|
(Digestif.to_raw_string hash expect)
|
|
(Obj.magic result)
|
|
(* XXX(dinosaure): ok, this is really bad but I'm lazy to keep type
|
|
equality on [Mac] - extend interface and play with [with type t = t]
|
|
anywhere. *) in
|
|
match kind with
|
|
| Bytes -> check @@ Mac.maci_bytes ~key (fun f -> f input)
|
|
| String -> check @@ Mac.maci_string ~key (fun f -> f input)
|
|
| Bigstring -> check @@ Mac.maci_bigstring ~key (fun f -> f input)
|
|
|
|
let make_keyed_blake m ~name kind hash key input expect =
|
|
(name, `Quick, fun () -> test_mac kind hash m key input expect)
|
|
|
|
let tests m kind filename =
|
|
let ic = open_in filename in
|
|
let tests = parse kind ic in
|
|
close_in ic ;
|
|
List.map
|
|
(fun (input, key, expect) ->
|
|
make_keyed_blake m ~name:"blake2{b,s}" string kind key input expect)
|
|
tests
|
|
|
|
let tests_blake2s =
|
|
tests (module Digestif.BLAKE2S.Keyed) Digestif.blake2s input_blake2s_file
|
|
|
|
let tests_blake2b =
|
|
tests (module Digestif.BLAKE2B.Keyed) Digestif.blake2b input_blake2b_file
|
|
end
|
|
|
|
module RMD160 = struct
|
|
let inputs =
|
|
[
|
|
""; "a"; "abc"; "message digest"; "abcdefghijklmnopqrstuvwxyz";
|
|
"abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopq";
|
|
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789";
|
|
"12345678901234567890123456789012345678901234567890123456789012345678901234567890";
|
|
]
|
|
|
|
let expects =
|
|
[
|
|
"9c1185a5c5e9fc54612808977ee8f548b2258d31";
|
|
"0bdc9d2d256b3ee9daae347be6f4dc835a467ffe";
|
|
"8eb208f7e05d987a9b044a8e98c6b087f15a0bfc";
|
|
"5d0689ef49d2fae572b881b123a85ffa21595f36";
|
|
"f71c27109c692c1b56bbdceb5b9d2865b3708dbc";
|
|
"12a053384a9c0c88e405a06c27dcf49ada62eb2b";
|
|
"b0e20b6e3116640286ed3a87a5713079b21f5189";
|
|
"9b752e45573d4b39f4dbd3323cab82bf63326bfb";
|
|
]
|
|
|
|
let million : expect:Digestif.RMD160.t Digestif.t -> unit Alcotest.test_case =
|
|
fun ~expect ->
|
|
let iter n f =
|
|
let rec go = function
|
|
| 0 -> ()
|
|
| n ->
|
|
f "a" ;
|
|
go (n - 1) in
|
|
go n in
|
|
let result = Digestif.digesti_string Digestif.rmd160 (iter 1_000_000) in
|
|
let test_hash =
|
|
Alcotest.testable Digestif.(pp rmd160) Digestif.(equal rmd160) in
|
|
( "give me a million",
|
|
`Slow,
|
|
fun () -> Alcotest.(check test_hash) "rmd160" expect result )
|
|
|
|
let tests =
|
|
let expect_million =
|
|
Digestif.of_hex Digestif.rmd160 "52783243c1697bdbe16d37f97f68f08325dc1528"
|
|
in
|
|
List.map
|
|
(fun (input, expect) ->
|
|
make_digest ~name:"rmd160" string Digestif.rmd160 input expect)
|
|
(List.combine inputs (List.map Digestif.(of_hex rmd160) expects))
|
|
@ [ million ~expect:expect_million ]
|
|
end
|
|
|
|
let str = Alcotest.testable (fun ppf -> Fmt.pf ppf "%S") String.equal
|
|
|
|
let blake2s_spe digest_size =
|
|
Alcotest.test_case (Fmt.str "BLAKE2S (digest-size: %d)" digest_size) `Quick
|
|
@@ fun () ->
|
|
let module Hash = Digestif.Make_BLAKE2S (struct
|
|
let digest_size = digest_size
|
|
end) in
|
|
Fmt.epr ">>> Use digest_string\n%!" ;
|
|
let hash0 = Hash.digest_string "" in
|
|
Fmt.epr ">>> Use feed_string\n%!" ;
|
|
let hash1 = Hash.get (Hash.feed_string Hash.empty "") in
|
|
let raw_hash0 = Hash.to_raw_string hash0 in
|
|
let raw_hash1 = Hash.to_raw_string hash1 in
|
|
Alcotest.(check int) "raw length" digest_size (String.length raw_hash0) ;
|
|
Alcotest.(check int) "raw length" digest_size (String.length raw_hash1) ;
|
|
let hash = Alcotest.testable Hash.pp Hash.equal in
|
|
Alcotest.(check hash) "hash" hash0 hash1 ;
|
|
Alcotest.(check str) "raw hash" raw_hash0 raw_hash1
|
|
|
|
let blake2b_spe digest_size =
|
|
Alcotest.test_case (Fmt.str "BLAKE2B (digest-size: %d)" digest_size) `Quick
|
|
@@ fun () ->
|
|
let module Hash = Digestif.Make_BLAKE2B (struct
|
|
let digest_size = digest_size
|
|
end) in
|
|
let hash0 = Hash.digest_string "" in
|
|
let hash1 = Hash.get (Hash.feed_string Hash.empty "") in
|
|
let raw_hash0 = Hash.to_raw_string hash0 in
|
|
let raw_hash1 = Hash.to_raw_string hash1 in
|
|
Alcotest.(check int) "raw length" digest_size (String.length raw_hash0) ;
|
|
Alcotest.(check int) "raw length" digest_size (String.length raw_hash1) ;
|
|
let hash = Alcotest.testable Hash.pp Hash.equal in
|
|
Alcotest.(check hash) "hash" hash0 hash1 ;
|
|
Alcotest.(check str) "raw hash" raw_hash0 raw_hash1
|
|
|
|
type kind = V : 'a Digestif.hash -> kind
|
|
|
|
let ( <.> ) f g x = f (g x)
|
|
|
|
let code x =
|
|
match x with
|
|
| '0' .. '9' -> Char.code x - Char.code '0'
|
|
| 'A' .. 'F' -> Char.code x - Char.code 'A' + 10
|
|
| 'a' .. 'f' -> Char.code x - Char.code 'a' + 10
|
|
| _ -> Fmt.invalid_arg "of_hex: %02X" (Char.code x)
|
|
|
|
let decode chr1 chr2 = Char.chr ((code chr1 lsl 4) lor code chr2)
|
|
|
|
let of_hex hex =
|
|
let offset = ref 0 in
|
|
let rec go have_first idx =
|
|
if !offset + idx >= String.length hex
|
|
then '\x00'
|
|
else
|
|
match hex.[!offset + idx] with
|
|
| ' ' | '\t' | '\r' | '\n' ->
|
|
incr offset ;
|
|
go have_first idx
|
|
| chr2 when have_first -> chr2
|
|
| chr1 ->
|
|
incr offset ;
|
|
let chr2 = go true idx in
|
|
if chr2 <> '\x00'
|
|
then decode chr1 chr2
|
|
else invalid_arg "of_hex: odd number of hex characters" in
|
|
String.init (String.length hex / 2) (go false)
|
|
|
|
let sha3_of_name str =
|
|
match Astring.String.cut ~sep:":" str with
|
|
| None -> Fmt.invalid_arg "Invalid line: %S" str
|
|
| Some (_name, value) -> (
|
|
let value = Astring.String.trim value in
|
|
match value with
|
|
| "SHA3-224" -> V Digestif.sha3_224
|
|
| "SHA3-256" -> V Digestif.sha3_256
|
|
| "SHA3-384" -> V Digestif.sha3_384
|
|
| "SHA3-512" -> V Digestif.sha3_512
|
|
| v -> Fmt.invalid_arg "Invalid kind of hash: %s" v)
|
|
|
|
let parse_field str =
|
|
match Astring.String.cut ~sep:":" str with
|
|
| Some (_key, v) -> Astring.String.trim v
|
|
| None -> Fmt.invalid_arg "Invalid line: %S" str
|
|
|
|
let empty = "\"\""
|
|
|
|
let sha3_vector_tests filename =
|
|
Alcotest.test_case filename `Quick @@ fun () ->
|
|
let ic = open_in filename in
|
|
let _algorithm_type = input_line ic in
|
|
let _source = input_line ic in
|
|
let (V hash) = sha3_of_name (input_line ic) in
|
|
let rec go () =
|
|
try
|
|
let comment = parse_field (input_line ic) in
|
|
let message = parse_field (input_line ic) in
|
|
Fmt.epr ">>> %S.\n%!" comment ;
|
|
Fmt.epr ">>> %S.\n%!" (if message = empty then "" else of_hex message) ;
|
|
let digest = (Digestif.of_hex hash <.> parse_field <.> input_line) ic in
|
|
let _verify = input_line ic in
|
|
let result =
|
|
if message = empty
|
|
then Digestif.digest_string hash ""
|
|
else Digestif.digest_string hash (of_hex message) in
|
|
Alcotest.(check (testable (Digestif.pp hash) (Digestif.equal hash)))
|
|
comment digest result ;
|
|
go ()
|
|
with End_of_file -> () in
|
|
go () ;
|
|
close_in ic
|
|
|
|
let keccak_vector_tests filename =
|
|
Alcotest.test_case filename `Quick @@ fun () ->
|
|
let ic = open_in filename in
|
|
let _algorithm_type = input_line ic in
|
|
let _name = input_line ic in
|
|
let hash = Digestif.keccak_256 in
|
|
let rec go () =
|
|
try
|
|
let comment = parse_field (input_line ic) in
|
|
let message = parse_field (input_line ic) in
|
|
let digest = (Digestif.of_hex hash <.> parse_field <.> input_line) ic in
|
|
let _verify = input_line ic in
|
|
let result =
|
|
if message = empty
|
|
then Digestif.digest_string hash ""
|
|
else Digestif.digest_string hash (of_hex message) in
|
|
Alcotest.(check (testable (Digestif.pp hash) (Digestif.equal hash)))
|
|
comment digest result ;
|
|
go ()
|
|
with End_of_file -> () in
|
|
go () ;
|
|
close_in ic
|
|
|
|
let tests () =
|
|
Alcotest.run "digestif"
|
|
[
|
|
("md5", makes ~name:"md5" bytes Digestif.md5 keys_st inputs_by results_md5);
|
|
( "md5 (bigstring)",
|
|
makes ~name:"md5" bigstring Digestif.md5 keys_st inputs_bi results_md5
|
|
);
|
|
( "sha1",
|
|
makes ~name:"sha1" bytes Digestif.sha1 keys_st inputs_by results_sha1 );
|
|
( "sha1 (bigstring)",
|
|
makes ~name:"sha1" bigstring Digestif.sha1 keys_st inputs_bi
|
|
results_sha1 );
|
|
( "sha224",
|
|
makes ~name:"sha224" bytes Digestif.sha224 keys_st inputs_by
|
|
results_sha224 );
|
|
( "sha224 (bigstring)",
|
|
makes ~name:"sha224" bigstring Digestif.sha224 keys_st inputs_bi
|
|
results_sha224 );
|
|
( "sha256",
|
|
makes ~name:"sha256" bytes Digestif.sha256 keys_st inputs_by
|
|
results_sha256 );
|
|
( "sha256 (bigstring)",
|
|
makes ~name:"sha256" bigstring Digestif.sha256 keys_st inputs_bi
|
|
results_sha256 );
|
|
( "sha256 (feed bytes)",
|
|
makes' ~name:"sha256" bytes Digestif.sha256 keys_st inputs_by
|
|
results_sha256' );
|
|
( "sha384",
|
|
makes ~name:"sha384" bytes Digestif.sha384 keys_st inputs_by
|
|
results_sha384 );
|
|
( "sha384 (bigstring)",
|
|
makes ~name:"sha384" bigstring Digestif.sha384 keys_st inputs_bi
|
|
results_sha384 );
|
|
( "sha512",
|
|
makes ~name:"sha512" bytes Digestif.sha512 keys_st inputs_by
|
|
results_sha512 );
|
|
( "sha512 (bigstring)",
|
|
makes ~name:"sha512" bigstring Digestif.sha512 keys_st inputs_bi
|
|
results_sha512 );
|
|
( "sha3_224",
|
|
makes ~name:"sha3_224" bytes Digestif.sha3_224 keys_st inputs_by
|
|
results_sha3_224 );
|
|
( "sha3_224 (bigstring)",
|
|
makes ~name:"sha3_224" bigstring Digestif.sha3_224 keys_st inputs_bi
|
|
results_sha3_224 );
|
|
( "sha3_256",
|
|
makes ~name:"sha3_256" bytes Digestif.sha3_256 keys_st inputs_by
|
|
results_sha3_256 );
|
|
( "sha3_256 (bigstring)",
|
|
makes ~name:"sha3_256" bigstring Digestif.sha3_256 keys_st inputs_bi
|
|
results_sha3_256 );
|
|
( "keccak_256",
|
|
makes ~name:"keccak_256" bytes Digestif.keccak_256 keys_st inputs_by
|
|
results_keccak_256 );
|
|
( "keccak_256 (bigstring)",
|
|
makes ~name:"keccak_256" bigstring Digestif.keccak_256 keys_st inputs_bi
|
|
results_keccak_256 );
|
|
( "sha3_384",
|
|
makes ~name:"sha3_384" bytes Digestif.sha3_384 keys_st inputs_by
|
|
results_sha3_384 );
|
|
( "sha3_384 (bigstring)",
|
|
makes ~name:"sha3_384" bigstring Digestif.sha3_384 keys_st inputs_bi
|
|
results_sha3_384 );
|
|
( "sha3_512",
|
|
makes ~name:"sha3_512" bytes Digestif.sha3_512 keys_st inputs_by
|
|
results_sha3_512 );
|
|
( "sha3_512 (bigstring)",
|
|
makes ~name:"sha3_512" bigstring Digestif.sha3_512 keys_st inputs_bi
|
|
results_sha3_512 );
|
|
( "whirlpool",
|
|
makes ~name:"whirlpool" bytes Digestif.whirlpool keys_st inputs_by
|
|
results_whirlpool );
|
|
( "whirlpool (bigstring)",
|
|
makes ~name:"whirlpool" bigstring Digestif.whirlpool keys_st inputs_bi
|
|
results_whirlpool );
|
|
( "blake2b",
|
|
makes ~name:"blake2b" bytes Digestif.blake2b keys_st inputs_by
|
|
results_blake2b );
|
|
( "blake2b (bigstring)",
|
|
makes ~name:"blake2b" bigstring Digestif.blake2b keys_st inputs_bi
|
|
results_blake2b );
|
|
( "rmd160",
|
|
makes ~name:"rmd160" bytes Digestif.rmd160 keys_st inputs_by
|
|
results_rmd160 );
|
|
( "rmd160 (bigstring)",
|
|
makes ~name:"rmd160" bigstring Digestif.rmd160 keys_st inputs_bi
|
|
results_rmd160 );
|
|
( "blake2s",
|
|
makes ~name:"blake2s" bytes Digestif.blake2s keys_st inputs_by
|
|
results_blake2s );
|
|
( "blake2s (bigstring)",
|
|
makes ~name:"blake2s" bigstring Digestif.blake2s keys_st inputs_bi
|
|
results_blake2s );
|
|
("blake2s (keyed, input file)", BLAKE2.tests_blake2s);
|
|
("blake2b (keyed, input file)", BLAKE2.tests_blake2b);
|
|
( "blake2s (specialization)",
|
|
[ blake2s_spe 32; blake2s_spe 8; blake2s_spe 16 ] );
|
|
( "blake2b (specialization)",
|
|
[ blake2b_spe 32; blake2b_spe 64; blake2b_spe 16 ] );
|
|
("ripemd160", RMD160.tests);
|
|
( "sha3 (vector tests)",
|
|
[
|
|
sha3_vector_tests "../sha3_224_fips_202.txt";
|
|
sha3_vector_tests "../sha3_256_fips_202.txt";
|
|
sha3_vector_tests "../sha3_384_fips_202.txt";
|
|
sha3_vector_tests "../sha3_512_fips_202.txt";
|
|
keccak_vector_tests "../keccak_256.txt";
|
|
] );
|
|
]
|
|
|
|
let () = tests ()
|