swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity
mte/unikernel/duniverse/digestif/src-ocaml/baijiu_rmd160.ml
swrup 2f3113f55d
2025-11-11 02:07:51 +01:00

371 lines
11 KiB
OCaml
Raw Blame History

module By = Digestif_by
module Bi = Digestif_bi
module type S = sig
type ctx
type kind = [ `RMD160 ]
val init : unit -> ctx
val unsafe_feed_bytes : ctx -> By.t -> int -> int -> unit
val unsafe_feed_bigstring : ctx -> Bi.t -> int -> int -> unit
val unsafe_get : ctx -> By.t
val dup : ctx -> ctx
end
module Int32 = struct
include Int32
let ( lsl ) = Int32.shift_left
let ( lsr ) = Int32.shift_right_logical
let ( asr ) = Int32.shift_right
let ( lor ) = Int32.logor
let ( lxor ) = Int32.logxor
let ( land ) = Int32.logand
let lnot = Int32.lognot
let ( + ) = Int32.add
let rol32 a n = (a lsl n) lor (a lsr (32 - n))
let ror32 a n = (a lsr n) lor (a lsl (32 - n))
end
module Int64 = struct
include Int64
let ( land ) = Int64.logand
let ( lsl ) = Int64.shift_left
end
module Unsafe : S = struct
type kind = [ `RMD160 ]
type ctx = { s : int32 array; mutable n : int; h : int32 array; b : Bytes.t }
let dup ctx =
{ s = Array.copy ctx.s; n = ctx.n; h = Array.copy ctx.h; b = By.copy ctx.b }
let init () =
let b = By.make 64 '\x00' in
{
s = [| 0l; 0l |];
n = 0;
b;
h = [| 0x67452301l; 0xefcdab89l; 0x98badcfel; 0x10325476l; 0xc3d2e1f0l |];
}
let f x y z = Int32.(x lxor y lxor z)
let g x y z = Int32.(x land y lor (lnot x land z))
let h x y z = Int32.(x lor lnot y lxor z)
let i x y z = Int32.(x land z lor (y land lnot z))
let j x y z = Int32.(x lxor (y lor lnot z))
let ff a b c d e x s =
let open Int32 in
a := !a + f !b !c !d + x ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let gg a b c d e x s =
let open Int32 in
a := !a + g !b !c !d + x + 0x5a827999l ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let hh a b c d e x s =
let open Int32 in
a := !a + h !b !c !d + x + 0x6ed9eba1l ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let ii a b c d e x s =
let open Int32 in
a := !a + i !b !c !d + x + 0x8f1bbcdcl ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let jj a b c d e x s =
let open Int32 in
a := !a + j !b !c !d + x + 0xa953fd4el ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let fff a b c d e x s =
let open Int32 in
a := !a + f !b !c !d + x ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let ggg a b c d e x s =
let open Int32 in
a := !a + g !b !c !d + x + 0x7a6d76e9l ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let hhh a b c d e x s =
let open Int32 in
a := !a + h !b !c !d + x + 0x6d703ef3l ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let iii a b c d e x s =
let open Int32 in
a := !a + i !b !c !d + x + 0x5c4dd124l ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let jjj a b c d e x s =
let open Int32 in
a := !a + j !b !c !d + x + 0x50a28be6l ;
a := rol32 !a s + !e ;
c := rol32 !c 10
let rmd160_do_chunk :
type a. le32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit =
fun ~le32_to_cpu ctx buff off ->
let aa, bb, cc, dd, ee, aaa, bbb, ccc, ddd, eee =
( ref ctx.h.(0),
ref ctx.h.(1),
ref ctx.h.(2),
ref ctx.h.(3),
ref ctx.h.(4),
ref ctx.h.(0),
ref ctx.h.(1),
ref ctx.h.(2),
ref ctx.h.(3),
ref ctx.h.(4) ) in
let w = Array.make 16 0l in
for i = 0 to 15 do
w.(i) <- le32_to_cpu buff (off + (i * 4))
done ;
ff aa bb cc dd ee w.(0) 11 ;
ff ee aa bb cc dd w.(1) 14 ;
ff dd ee aa bb cc w.(2) 15 ;
ff cc dd ee aa bb w.(3) 12 ;
ff bb cc dd ee aa w.(4) 5 ;
ff aa bb cc dd ee w.(5) 8 ;
ff ee aa bb cc dd w.(6) 7 ;
ff dd ee aa bb cc w.(7) 9 ;
ff cc dd ee aa bb w.(8) 11 ;
ff bb cc dd ee aa w.(9) 13 ;
ff aa bb cc dd ee w.(10) 14 ;
ff ee aa bb cc dd w.(11) 15 ;
ff dd ee aa bb cc w.(12) 6 ;
ff cc dd ee aa bb w.(13) 7 ;
ff bb cc dd ee aa w.(14) 9 ;
ff aa bb cc dd ee w.(15) 8 ;
gg ee aa bb cc dd w.(7) 7 ;
gg dd ee aa bb cc w.(4) 6 ;
gg cc dd ee aa bb w.(13) 8 ;
gg bb cc dd ee aa w.(1) 13 ;
gg aa bb cc dd ee w.(10) 11 ;
gg ee aa bb cc dd w.(6) 9 ;
gg dd ee aa bb cc w.(15) 7 ;
gg cc dd ee aa bb w.(3) 15 ;
gg bb cc dd ee aa w.(12) 7 ;
gg aa bb cc dd ee w.(0) 12 ;
gg ee aa bb cc dd w.(9) 15 ;
gg dd ee aa bb cc w.(5) 9 ;
gg cc dd ee aa bb w.(2) 11 ;
gg bb cc dd ee aa w.(14) 7 ;
gg aa bb cc dd ee w.(11) 13 ;
gg ee aa bb cc dd w.(8) 12 ;
hh dd ee aa bb cc w.(3) 11 ;
hh cc dd ee aa bb w.(10) 13 ;
hh bb cc dd ee aa w.(14) 6 ;
hh aa bb cc dd ee w.(4) 7 ;
hh ee aa bb cc dd w.(9) 14 ;
hh dd ee aa bb cc w.(15) 9 ;
hh cc dd ee aa bb w.(8) 13 ;
hh bb cc dd ee aa w.(1) 15 ;
hh aa bb cc dd ee w.(2) 14 ;
hh ee aa bb cc dd w.(7) 8 ;
hh dd ee aa bb cc w.(0) 13 ;
hh cc dd ee aa bb w.(6) 6 ;
hh bb cc dd ee aa w.(13) 5 ;
hh aa bb cc dd ee w.(11) 12 ;
hh ee aa bb cc dd w.(5) 7 ;
hh dd ee aa bb cc w.(12) 5 ;
ii cc dd ee aa bb w.(1) 11 ;
ii bb cc dd ee aa w.(9) 12 ;
ii aa bb cc dd ee w.(11) 14 ;
ii ee aa bb cc dd w.(10) 15 ;
ii dd ee aa bb cc w.(0) 14 ;
ii cc dd ee aa bb w.(8) 15 ;
ii bb cc dd ee aa w.(12) 9 ;
ii aa bb cc dd ee w.(4) 8 ;
ii ee aa bb cc dd w.(13) 9 ;
ii dd ee aa bb cc w.(3) 14 ;
ii cc dd ee aa bb w.(7) 5 ;
ii bb cc dd ee aa w.(15) 6 ;
ii aa bb cc dd ee w.(14) 8 ;
ii ee aa bb cc dd w.(5) 6 ;
ii dd ee aa bb cc w.(6) 5 ;
ii cc dd ee aa bb w.(2) 12 ;
jj bb cc dd ee aa w.(4) 9 ;
jj aa bb cc dd ee w.(0) 15 ;
jj ee aa bb cc dd w.(5) 5 ;
jj dd ee aa bb cc w.(9) 11 ;
jj cc dd ee aa bb w.(7) 6 ;
jj bb cc dd ee aa w.(12) 8 ;
jj aa bb cc dd ee w.(2) 13 ;
jj ee aa bb cc dd w.(10) 12 ;
jj dd ee aa bb cc w.(14) 5 ;
jj cc dd ee aa bb w.(1) 12 ;
jj bb cc dd ee aa w.(3) 13 ;
jj aa bb cc dd ee w.(8) 14 ;
jj ee aa bb cc dd w.(11) 11 ;
jj dd ee aa bb cc w.(6) 8 ;
jj cc dd ee aa bb w.(15) 5 ;
jj bb cc dd ee aa w.(13) 6 ;
jjj aaa bbb ccc ddd eee w.(5) 8 ;
jjj eee aaa bbb ccc ddd w.(14) 9 ;
jjj ddd eee aaa bbb ccc w.(7) 9 ;
jjj ccc ddd eee aaa bbb w.(0) 11 ;
jjj bbb ccc ddd eee aaa w.(9) 13 ;
jjj aaa bbb ccc ddd eee w.(2) 15 ;
jjj eee aaa bbb ccc ddd w.(11) 15 ;
jjj ddd eee aaa bbb ccc w.(4) 5 ;
jjj ccc ddd eee aaa bbb w.(13) 7 ;
jjj bbb ccc ddd eee aaa w.(6) 7 ;
jjj aaa bbb ccc ddd eee w.(15) 8 ;
jjj eee aaa bbb ccc ddd w.(8) 11 ;
jjj ddd eee aaa bbb ccc w.(1) 14 ;
jjj ccc ddd eee aaa bbb w.(10) 14 ;
jjj bbb ccc ddd eee aaa w.(3) 12 ;
jjj aaa bbb ccc ddd eee w.(12) 6 ;
iii eee aaa bbb ccc ddd w.(6) 9 ;
iii ddd eee aaa bbb ccc w.(11) 13 ;
iii ccc ddd eee aaa bbb w.(3) 15 ;
iii bbb ccc ddd eee aaa w.(7) 7 ;
iii aaa bbb ccc ddd eee w.(0) 12 ;
iii eee aaa bbb ccc ddd w.(13) 8 ;
iii ddd eee aaa bbb ccc w.(5) 9 ;
iii ccc ddd eee aaa bbb w.(10) 11 ;
iii bbb ccc ddd eee aaa w.(14) 7 ;
iii aaa bbb ccc ddd eee w.(15) 7 ;
iii eee aaa bbb ccc ddd w.(8) 12 ;
iii ddd eee aaa bbb ccc w.(12) 7 ;
iii ccc ddd eee aaa bbb w.(4) 6 ;
iii bbb ccc ddd eee aaa w.(9) 15 ;
iii aaa bbb ccc ddd eee w.(1) 13 ;
iii eee aaa bbb ccc ddd w.(2) 11 ;
hhh ddd eee aaa bbb ccc w.(15) 9 ;
hhh ccc ddd eee aaa bbb w.(5) 7 ;
hhh bbb ccc ddd eee aaa w.(1) 15 ;
hhh aaa bbb ccc ddd eee w.(3) 11 ;
hhh eee aaa bbb ccc ddd w.(7) 8 ;
hhh ddd eee aaa bbb ccc w.(14) 6 ;
hhh ccc ddd eee aaa bbb w.(6) 6 ;
hhh bbb ccc ddd eee aaa w.(9) 14 ;
hhh aaa bbb ccc ddd eee w.(11) 12 ;
hhh eee aaa bbb ccc ddd w.(8) 13 ;
hhh ddd eee aaa bbb ccc w.(12) 5 ;
hhh ccc ddd eee aaa bbb w.(2) 14 ;
hhh bbb ccc ddd eee aaa w.(10) 13 ;
hhh aaa bbb ccc ddd eee w.(0) 13 ;
hhh eee aaa bbb ccc ddd w.(4) 7 ;
hhh ddd eee aaa bbb ccc w.(13) 5 ;
ggg ccc ddd eee aaa bbb w.(8) 15 ;
ggg bbb ccc ddd eee aaa w.(6) 5 ;
ggg aaa bbb ccc ddd eee w.(4) 8 ;
ggg eee aaa bbb ccc ddd w.(1) 11 ;
ggg ddd eee aaa bbb ccc w.(3) 14 ;
ggg ccc ddd eee aaa bbb w.(11) 14 ;
ggg bbb ccc ddd eee aaa w.(15) 6 ;
ggg aaa bbb ccc ddd eee w.(0) 14 ;
ggg eee aaa bbb ccc ddd w.(5) 6 ;
ggg ddd eee aaa bbb ccc w.(12) 9 ;
ggg ccc ddd eee aaa bbb w.(2) 12 ;
ggg bbb ccc ddd eee aaa w.(13) 9 ;
ggg aaa bbb ccc ddd eee w.(9) 12 ;
ggg eee aaa bbb ccc ddd w.(7) 5 ;
ggg ddd eee aaa bbb ccc w.(10) 15 ;
ggg ccc ddd eee aaa bbb w.(14) 8 ;
fff bbb ccc ddd eee aaa w.(12) 8 ;
fff aaa bbb ccc ddd eee w.(15) 5 ;
fff eee aaa bbb ccc ddd w.(10) 12 ;
fff ddd eee aaa bbb ccc w.(4) 9 ;
fff ccc ddd eee aaa bbb w.(1) 12 ;
fff bbb ccc ddd eee aaa w.(5) 5 ;
fff aaa bbb ccc ddd eee w.(8) 14 ;
fff eee aaa bbb ccc ddd w.(7) 6 ;
fff ddd eee aaa bbb ccc w.(6) 8 ;
fff ccc ddd eee aaa bbb w.(2) 13 ;
fff bbb ccc ddd eee aaa w.(13) 6 ;
fff aaa bbb ccc ddd eee w.(14) 5 ;
fff eee aaa bbb ccc ddd w.(0) 15 ;
fff ddd eee aaa bbb ccc w.(3) 13 ;
fff ccc ddd eee aaa bbb w.(9) 11 ;
fff bbb ccc ddd eee aaa w.(11) 11 ;
let open Int32 in
ddd := !ddd + !cc + ctx.h.(1) ;
(* final result for h[0]. *)
ctx.h.(1) <- ctx.h.(2) + !dd + !eee ;
ctx.h.(2) <- ctx.h.(3) + !ee + !aaa ;
ctx.h.(3) <- ctx.h.(4) + !aa + !bbb ;
ctx.h.(4) <- ctx.h.(0) + !bb + !ccc ;
ctx.h.(0) <- !ddd ;
()
exception Leave
let feed :
type a.
le32_to_cpu:(a -> int -> int32) ->
blit:(a -> int -> By.t -> int -> int -> unit) ->
ctx ->
a ->
int ->
int ->
unit =
fun ~le32_to_cpu ~blit ctx buf off len ->
let t = ref ctx.s.(0) in
let off = ref off in
let len = ref len in
ctx.s.(0) <- Int32.add !t (Int32.of_int (!len lsl 3)) ;
if ctx.s.(0) < !t then ctx.s.(1) <- Int32.(ctx.s.(1) + 1l) ;
ctx.s.(1) <- Int32.add ctx.s.(1) (Int32.of_int (!len lsr 29)) ;
try
if ctx.n <> 0
then (
let t = 64 - ctx.n in
if !len < t
then (
blit buf !off ctx.b ctx.n !len ;
ctx.n <- ctx.n + !len ;
raise Leave) ;
blit buf !off ctx.b ctx.n t ;
rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ;
off := !off + t ;
len := !len - t) ;
while !len >= 64 do
rmd160_do_chunk ~le32_to_cpu ctx buf !off ;
off := !off + 64 ;
len := !len - 64
done ;
blit buf !off ctx.b 0 !len ;
ctx.n <- !len
with Leave -> ()
let unsafe_feed_bytes ctx buf off len =
feed ~blit:By.blit ~le32_to_cpu:By.le32_to_cpu ctx buf off len
let unsafe_feed_bigstring ctx buf off len =
feed ~blit:By.blit_from_bigstring ~le32_to_cpu:Bi.le32_to_cpu ctx buf off
len
let unsafe_get ctx =
let i = ref (ctx.n + 1) in
let res = By.create (5 * 4) in
By.set ctx.b ctx.n '\x80' ;
if !i > 56
then (
By.fill ctx.b !i (64 - !i) '\x00' ;
rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ;
i := 0) ;
By.fill ctx.b !i (56 - !i) '\x00' ;
By.cpu_to_le32 ctx.b 56 ctx.s.(0) ;
By.cpu_to_le32 ctx.b 60 ctx.s.(1) ;
rmd160_do_chunk ~le32_to_cpu:By.le32_to_cpu ctx ctx.b 0 ;
for i = 0 to 4 do
By.cpu_to_le32 res (i * 4) ctx.h.(i)
done ;
res
end
Reference in a new issue View git blame Copy permalink