222 lines
6.6 KiB
OCaml
222 lines
6.6 KiB
OCaml
|
module By = Digestif_by
|
||
|
|
module Bi = Digestif_bi
|
||
|
|
|
||
|
|
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 ( + ) = Int32.add
|
||
|
|
let rol32 a n = (a lsl n) lor (a lsr (32 - n))
|
||
|
|
end
|
||
|
|
|
||
|
|
module Int64 = struct
|
||
|
|
include Int64
|
||
|
|
|
||
|
|
let ( land ) = Int64.logand
|
||
|
|
let ( lsl ) = Int64.shift_left
|
||
|
|
end
|
||
|
|
|
||
|
|
module type S = sig
|
||
|
|
type ctx
|
||
|
|
type kind = [ `SHA1 ]
|
||
|
|
|
||
|
|
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 Unsafe : S = struct
|
||
|
|
type kind = [ `SHA1 ]
|
||
|
|
type ctx = { mutable size : int64; b : Bytes.t; h : int32 array }
|
||
|
|
|
||
|
|
let dup ctx = { size = ctx.size; b = By.copy ctx.b; h = Array.copy ctx.h }
|
||
|
|
|
||
|
|
let init () =
|
||
|
|
let b = By.make 64 '\x00' in
|
||
|
|
{
|
||
|
|
size = 0L;
|
||
|
|
b;
|
||
|
|
h = [| 0x67452301l; 0xefcdab89l; 0x98badcfel; 0x10325476l; 0xc3d2e1f0l |];
|
||
|
|
}
|
||
|
|
|
||
|
|
let f1 x y z = Int32.(z lxor (x land (y lxor z)))
|
||
|
|
let f2 x y z = Int32.(x lxor y lxor z)
|
||
|
|
let f3 x y z = Int32.((x land y) + (z land (x lxor y)))
|
||
|
|
let f4 = f2
|
||
|
|
let k1 = 0x5a827999l
|
||
|
|
let k2 = 0x6ed9eba1l
|
||
|
|
let k3 = 0x8f1bbcdcl
|
||
|
|
let k4 = 0xca62c1d6l
|
||
|
|
|
||
|
|
let sha1_do_chunk :
|
||
|
|
type a. be32_to_cpu:(a -> int -> int32) -> ctx -> a -> int -> unit =
|
||
|
|
fun ~be32_to_cpu ctx buf off ->
|
||
|
|
let a = ref ctx.h.(0) in
|
||
|
|
let b = ref ctx.h.(1) in
|
||
|
|
let c = ref ctx.h.(2) in
|
||
|
|
let d = ref ctx.h.(3) in
|
||
|
|
let e = ref ctx.h.(4) in
|
||
|
|
let w = Array.make 16 0l in
|
||
|
|
let m i =
|
||
|
|
let ( && ) a b = a land b in
|
||
|
|
let ( -- ) a b = a - b in
|
||
|
|
let v =
|
||
|
|
Int32.(
|
||
|
|
rol32
|
||
|
|
(w.(i && 0x0F)
|
||
|
|
lxor w.((i -- 14) && 0x0F)
|
||
|
|
lxor w.((i -- 8) && 0x0F)
|
||
|
|
lxor w.((i -- 3) && 0x0F))
|
||
|
|
1) in
|
||
|
|
w.(i land 0x0F) <- v ;
|
||
|
|
w.(i land 0x0F) in
|
||
|
|
let round a b c d e f k w =
|
||
|
|
(e := Int32.(!e + rol32 !a 5 + f !b !c !d + k + w)) ;
|
||
|
|
b := Int32.(rol32 !b 30) in
|
||
|
|
for i = 0 to 15 do
|
||
|
|
w.(i) <- be32_to_cpu buf (off + (i * 4))
|
||
|
|
done ;
|
||
|
|
round a b c d e f1 k1 w.(0) ;
|
||
|
|
round e a b c d f1 k1 w.(1) ;
|
||
|
|
round d e a b c f1 k1 w.(2) ;
|
||
|
|
round c d e a b f1 k1 w.(3) ;
|
||
|
|
round b c d e a f1 k1 w.(4) ;
|
||
|
|
round a b c d e f1 k1 w.(5) ;
|
||
|
|
round e a b c d f1 k1 w.(6) ;
|
||
|
|
round d e a b c f1 k1 w.(7) ;
|
||
|
|
round c d e a b f1 k1 w.(8) ;
|
||
|
|
round b c d e a f1 k1 w.(9) ;
|
||
|
|
round a b c d e f1 k1 w.(10) ;
|
||
|
|
round e a b c d f1 k1 w.(11) ;
|
||
|
|
round d e a b c f1 k1 w.(12) ;
|
||
|
|
round c d e a b f1 k1 w.(13) ;
|
||
|
|
round b c d e a f1 k1 w.(14) ;
|
||
|
|
round a b c d e f1 k1 w.(15) ;
|
||
|
|
round e a b c d f1 k1 (m 16) ;
|
||
|
|
round d e a b c f1 k1 (m 17) ;
|
||
|
|
round c d e a b f1 k1 (m 18) ;
|
||
|
|
round b c d e a f1 k1 (m 19) ;
|
||
|
|
round a b c d e f2 k2 (m 20) ;
|
||
|
|
round e a b c d f2 k2 (m 21) ;
|
||
|
|
round d e a b c f2 k2 (m 22) ;
|
||
|
|
round c d e a b f2 k2 (m 23) ;
|
||
|
|
round b c d e a f2 k2 (m 24) ;
|
||
|
|
round a b c d e f2 k2 (m 25) ;
|
||
|
|
round e a b c d f2 k2 (m 26) ;
|
||
|
|
round d e a b c f2 k2 (m 27) ;
|
||
|
|
round c d e a b f2 k2 (m 28) ;
|
||
|
|
round b c d e a f2 k2 (m 29) ;
|
||
|
|
round a b c d e f2 k2 (m 30) ;
|
||
|
|
round e a b c d f2 k2 (m 31) ;
|
||
|
|
round d e a b c f2 k2 (m 32) ;
|
||
|
|
round c d e a b f2 k2 (m 33) ;
|
||
|
|
round b c d e a f2 k2 (m 34) ;
|
||
|
|
round a b c d e f2 k2 (m 35) ;
|
||
|
|
round e a b c d f2 k2 (m 36) ;
|
||
|
|
round d e a b c f2 k2 (m 37) ;
|
||
|
|
round c d e a b f2 k2 (m 38) ;
|
||
|
|
round b c d e a f2 k2 (m 39) ;
|
||
|
|
round a b c d e f3 k3 (m 40) ;
|
||
|
|
round e a b c d f3 k3 (m 41) ;
|
||
|
|
round d e a b c f3 k3 (m 42) ;
|
||
|
|
round c d e a b f3 k3 (m 43) ;
|
||
|
|
round b c d e a f3 k3 (m 44) ;
|
||
|
|
round a b c d e f3 k3 (m 45) ;
|
||
|
|
round e a b c d f3 k3 (m 46) ;
|
||
|
|
round d e a b c f3 k3 (m 47) ;
|
||
|
|
round c d e a b f3 k3 (m 48) ;
|
||
|
|
round b c d e a f3 k3 (m 49) ;
|
||
|
|
round a b c d e f3 k3 (m 50) ;
|
||
|
|
round e a b c d f3 k3 (m 51) ;
|
||
|
|
round d e a b c f3 k3 (m 52) ;
|
||
|
|
round c d e a b f3 k3 (m 53) ;
|
||
|
|
round b c d e a f3 k3 (m 54) ;
|
||
|
|
round a b c d e f3 k3 (m 55) ;
|
||
|
|
round e a b c d f3 k3 (m 56) ;
|
||
|
|
round d e a b c f3 k3 (m 57) ;
|
||
|
|
round c d e a b f3 k3 (m 58) ;
|
||
|
|
round b c d e a f3 k3 (m 59) ;
|
||
|
|
round a b c d e f4 k4 (m 60) ;
|
||
|
|
round e a b c d f4 k4 (m 61) ;
|
||
|
|
round d e a b c f4 k4 (m 62) ;
|
||
|
|
round c d e a b f4 k4 (m 63) ;
|
||
|
|
round b c d e a f4 k4 (m 64) ;
|
||
|
|
round a b c d e f4 k4 (m 65) ;
|
||
|
|
round e a b c d f4 k4 (m 66) ;
|
||
|
|
round d e a b c f4 k4 (m 67) ;
|
||
|
|
round c d e a b f4 k4 (m 68) ;
|
||
|
|
round b c d e a f4 k4 (m 69) ;
|
||
|
|
round a b c d e f4 k4 (m 70) ;
|
||
|
|
round e a b c d f4 k4 (m 71) ;
|
||
|
|
round d e a b c f4 k4 (m 72) ;
|
||
|
|
round c d e a b f4 k4 (m 73) ;
|
||
|
|
round b c d e a f4 k4 (m 74) ;
|
||
|
|
round a b c d e f4 k4 (m 75) ;
|
||
|
|
round e a b c d f4 k4 (m 76) ;
|
||
|
|
round d e a b c f4 k4 (m 77) ;
|
||
|
|
round c d e a b f4 k4 (m 78) ;
|
||
|
|
round b c d e a f4 k4 (m 79) ;
|
||
|
|
ctx.h.(0) <- Int32.add ctx.h.(0) !a ;
|
||
|
|
ctx.h.(1) <- Int32.add ctx.h.(1) !b ;
|
||
|
|
ctx.h.(2) <- Int32.add ctx.h.(2) !c ;
|
||
|
|
ctx.h.(3) <- Int32.add ctx.h.(3) !d ;
|
||
|
|
ctx.h.(4) <- Int32.add ctx.h.(4) !e ;
|
||
|
|
()
|
||
|
|
|
||
|
|
let feed :
|
||
|
|
type a.
|
||
|
|
blit:(a -> int -> By.t -> int -> int -> unit) ->
|
||
|
|
be32_to_cpu:(a -> int -> int32) ->
|
||
|
|
ctx ->
|
||
|
|
a ->
|
||
|
|
int ->
|
||
|
|
int ->
|
||
|
|
unit =
|
||
|
|
fun ~blit ~be32_to_cpu ctx buf off len ->
|
||
|
|
let idx = ref Int64.(to_int (ctx.size land 0x3FL)) in
|
||
|
|
let len = ref len in
|
||
|
|
let off = ref off in
|
||
|
|
let to_fill = 64 - !idx in
|
||
|
|
ctx.size <- Int64.add ctx.size (Int64.of_int !len) ;
|
||
|
|
if !idx <> 0 && !len >= to_fill
|
||
|
|
then (
|
||
|
|
blit buf !off ctx.b !idx to_fill ;
|
||
|
|
sha1_do_chunk ~be32_to_cpu:By.be32_to_cpu ctx ctx.b 0 ;
|
||
|
|
len := !len - to_fill ;
|
||
|
|
off := !off + to_fill ;
|
||
|
|
idx := 0) ;
|
||
|
|
while !len >= 64 do
|
||
|
|
sha1_do_chunk ~be32_to_cpu ctx buf !off ;
|
||
|
|
len := !len - 64 ;
|
||
|
|
off := !off + 64
|
||
|
|
done ;
|
||
|
|
if !len <> 0 then blit buf !off ctx.b !idx !len ;
|
||
|
|
()
|
||
|
|
|
||
|
|
let unsafe_feed_bytes = feed ~blit:By.blit ~be32_to_cpu:By.be32_to_cpu
|
||
|
|
|
||
|
|
let unsafe_feed_bigstring =
|
||
|
|
feed ~blit:By.blit_from_bigstring ~be32_to_cpu:Bi.be32_to_cpu
|
||
|
|
|
||
|
|
let unsafe_get ctx =
|
||
|
|
let index = Int64.(to_int (ctx.size land 0x3FL)) in
|
||
|
|
let padlen = if index < 56 then 56 - index else 64 + 56 - index in
|
||
|
|
let padding = By.init padlen (function 0 -> '\x80' | _ -> '\x00') in
|
||
|
|
let bits = By.create 8 in
|
||
|
|
By.cpu_to_be64 bits 0 Int64.(ctx.size lsl 3) ;
|
||
|
|
unsafe_feed_bytes ctx padding 0 padlen ;
|
||
|
|
unsafe_feed_bytes ctx bits 0 8 ;
|
||
|
|
let res = By.create (5 * 4) in
|
||
|
|
for i = 0 to 4 do
|
||
|
|
By.cpu_to_be32 res (i * 4) ctx.h.(i)
|
||
|
|
done ;
|
||
|
|
res
|
||
|
|
end
|