anil.recoil.org
forked from
gazagnaire.org/ocaml-crypto
upstream: https://github.com/mirage/mirage-crypto
use defunctorised version of the rng (#257)
* add next generation mirage-crypto-rng-mirage
* Defunctorise mirage-crypto-rng-mirage, use mirage-sleep and mirage-mtime instead
* fix test
* adapt to mirage how it'll be in the future (no functor)
authored by
Hannes Mehnert
and committed by
GitHub
d99682c3
0a7e5727
+2
-4
mirage-crypto-rng-mirage.opam
+2
-4
mirage-crypto-rng-mirage.opam
···
20
20
"logs"
21
21
"lwt" {>= "4.0.0"}
22
22
"mirage-runtime" {>= "3.8.0"}
23
-
"mirage-time" {>= "2.0.0"}
24
-
"mirage-clock" {>= "3.0.0"}
23
+
"mirage-sleep" {>= "4.0.0"}
24
+
"mirage-mtime" {>= "4.0.0"}
25
25
"mirage-unix" {with-test & >= "5.0.0"}
26
-
"mirage-time-unix" {with-test & >= "2.0.0"}
27
-
"mirage-clock-unix" {with-test & >= "3.0.0"}
28
26
"ohex" {with-test & >= "0.2.0"}
29
27
]
30
28
description: """
+2
-2
mirage/config.ml
+2
-2
mirage/config.ml
+25
-27
mirage/unikernel.ml
+25
-27
mirage/unikernel.ml
···
1
-
module Main (R : Mirage_crypto_rng_mirage.S) = struct
2
-
let start _r =
3
-
Logs.info (fun m -> m "using Fortuna, entropy sources: %a"
4
-
Fmt.(list ~sep:(any ", ") Mirage_crypto_rng.Entropy.pp_source)
5
-
(Mirage_crypto_rng.Entropy.sources ())) ;
6
-
Logs.info (fun m -> m "64 byte random:@ %a" (Ohex.pp_hexdump ())
7
-
(R.generate 64)) ;
8
-
let n = Bytes.(unsafe_to_string (create 32)) in
9
-
let key = Mirage_crypto.Chacha20.of_secret n
10
-
and nonce = Bytes.(unsafe_to_string (create 12))
11
-
in
12
-
Logs.info (fun m -> m "Chacha20/Poly1305 of 32*0, key 32*0, nonce 12*0: %a"
13
-
(Ohex.pp_hexdump ())
14
-
(Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce n));
15
-
let key = Mirage_crypto_pk.Rsa.generate ~bits:4096 () in
16
-
let signature =
17
-
Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key (`Message n)
18
-
in
19
-
let verified =
20
-
let key = Mirage_crypto_pk.Rsa.pub_of_priv key in
21
-
let hashp = function `SHA256 -> true | _ -> false in
22
-
Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Message n)
23
-
in
24
-
Logs.info (fun m -> m "Generated a RSA key of %d bits (sign + verify %B)"
25
-
(Mirage_crypto_pk.Rsa.priv_bits key) verified);
26
-
Lwt.return_unit
27
-
end
1
+
let start () =
2
+
Logs.info (fun m -> m "using Fortuna, entropy sources: %a"
3
+
Fmt.(list ~sep:(any ", ") Mirage_crypto_rng.Entropy.pp_source)
4
+
(Mirage_crypto_rng.Entropy.sources ())) ;
5
+
Logs.info (fun m -> m "64 byte random:@ %a" (Ohex.pp_hexdump ())
6
+
(Mirage_crypto_rng.generate 64)) ;
7
+
let n = Bytes.(unsafe_to_string (create 32)) in
8
+
let key = Mirage_crypto.Chacha20.of_secret n
9
+
and nonce = Bytes.(unsafe_to_string (create 12))
10
+
in
11
+
Logs.info (fun m -> m "Chacha20/Poly1305 of 32*0, key 32*0, nonce 12*0: %a"
12
+
(Ohex.pp_hexdump ())
13
+
(Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce n));
14
+
let key = Mirage_crypto_pk.Rsa.generate ~bits:4096 () in
15
+
let signature =
16
+
Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key (`Message n)
17
+
in
18
+
let verified =
19
+
let key = Mirage_crypto_pk.Rsa.pub_of_priv key in
20
+
let hashp = function `SHA256 -> true | _ -> false in
21
+
Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Message n)
22
+
in
23
+
Logs.info (fun m -> m "Generated a RSA key of %d bits (sign + verify %B)"
24
+
(Mirage_crypto_pk.Rsa.priv_bits key) verified);
25
+
Lwt.return_unit
+1
-1
rng/mirage/dune
+1
-1
rng/mirage/dune
+37
-56
rng/mirage/mirage_crypto_rng_mirage.ml
+37
-56
rng/mirage/mirage_crypto_rng_mirage.ml
···
27
27
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28
28
*)
29
29
30
-
module type S = sig
31
-
type g = Mirage_crypto_rng.g
32
-
module Entropy :
33
-
sig
34
-
type source = Mirage_crypto_rng.Entropy.source
35
-
val sources : unit -> source list
36
-
val pp_source : Format.formatter -> source -> unit
37
-
val register_source : string -> source
38
-
end
39
-
40
-
val generate_into : ?g:g -> bytes -> ?off:int -> int -> unit
41
-
val generate : ?g:g -> int -> string
42
-
43
-
val accumulate : g option -> Entropy.source -> [`Acc of string -> unit]
44
-
end
45
-
46
30
let src = Logs.Src.create "mirage-crypto-rng-mirage" ~doc:"Mirage crypto RNG mirage"
47
31
module Log = (val Logs.src_log src : Logs.LOG)
48
32
49
-
module Make (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) = struct
50
-
include Mirage_crypto_rng
33
+
open Mirage_crypto_rng
51
34
52
-
let rdrand_task delta =
53
-
match Entropy.cpu_rng with
54
-
| Error `Not_supported -> ()
55
-
| Ok cpu_rng ->
56
-
let open Lwt.Infix in
57
-
let rdrand = cpu_rng None in
58
-
Lwt.async (fun () ->
59
-
let rec one () =
60
-
rdrand ();
61
-
T.sleep_ns delta >>=
62
-
one
63
-
in
64
-
one ())
35
+
let rdrand_task delta =
36
+
match Entropy.cpu_rng with
37
+
| Error `Not_supported -> ()
38
+
| Ok cpu_rng ->
39
+
let open Lwt.Infix in
40
+
let rdrand = cpu_rng None in
41
+
Lwt.async (fun () ->
42
+
let rec one () =
43
+
rdrand ();
44
+
Mirage_sleep.ns delta >>=
45
+
one
46
+
in
47
+
one ())
65
48
66
-
let bootstrap_functions () =
67
-
[ Entropy.bootstrap ; Entropy.bootstrap ;
68
-
Entropy.whirlwind_bootstrap ; Entropy.bootstrap ]
49
+
let bootstrap_functions () =
50
+
Entropy.[ bootstrap ; bootstrap ; whirlwind_bootstrap ; bootstrap ]
69
51
70
-
let running = ref false
52
+
let running = ref false
71
53
72
-
let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) =
73
-
if !running then
74
-
Lwt.fail_with "entropy collection already running"
75
-
else begin
76
-
(try
77
-
let _ = default_generator () in
78
-
Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \
79
-
been set, check that this call is intentional");
80
-
with
81
-
No_default_generator -> ());
82
-
running := true;
83
-
let seed =
84
-
List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat ""
85
-
in
86
-
let rng = create ?g ~seed ~time:M.elapsed_ns rng in
87
-
set_default_generator rng;
88
-
rdrand_task sleep;
89
-
Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None);
90
-
Lwt.return_unit
91
-
end
92
-
end
54
+
let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) =
55
+
if !running then
56
+
Lwt.fail_with "entropy collection already running"
57
+
else begin
58
+
(try
59
+
let _ = default_generator () in
60
+
Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \
61
+
been set, check that this call is intentional");
62
+
with
63
+
No_default_generator -> ());
64
+
running := true;
65
+
let seed =
66
+
List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat ""
67
+
in
68
+
let rng = create ?g ~seed ~time:Mirage_mtime.elapsed_ns rng in
69
+
set_default_generator rng;
70
+
rdrand_task sleep;
71
+
Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None);
72
+
Lwt.return_unit
73
+
end
+7
-46
rng/mirage/mirage_crypto_rng_mirage.mli
+7
-46
rng/mirage/mirage_crypto_rng_mirage.mli
···
26
26
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27
27
*)
28
28
29
-
module type S = sig
30
-
type g = Mirage_crypto_rng.g
31
-
(** A generator (PRNG) with its state. *)
32
-
33
-
(** Entropy sources and collection *)
34
-
module Entropy :
35
-
sig
36
-
(** Entropy sources. *)
37
-
type source = Mirage_crypto_rng.Entropy.source
38
-
39
-
val sources : unit -> source list
40
-
(** [sources ()] returns the list of available sources. *)
41
-
42
-
val pp_source : Format.formatter -> source -> unit
43
-
(** [pp_source ppf source] pretty-prints the entropy [source] on [ppf]. *)
44
-
45
-
val register_source : string -> source
46
-
(** [register_source name] registers [name] as entropy source. *)
47
-
end
48
-
49
-
val generate_into : ?g:g -> bytes -> ?off:int -> int -> unit
50
-
(** [generate_into ~g buf ~off len] invokes
51
-
{{!Generator.generate_into}generate_into} on [g] or
52
-
{{!generator}default generator}. The random data is put into [buf] starting
53
-
at [off] (defaults to 0) with [len] bytes. *)
54
-
55
-
val generate : ?g:g -> int -> string
56
-
(** Invoke {!generate_into} on [g] or {{!generator}default generator} and a
57
-
freshly allocated string. *)
58
-
59
-
val accumulate : g option -> Entropy.source -> [`Acc of string -> unit]
60
-
(** [accumulate g source] is a function [data -> unit] to feed entropy to the
61
-
RNG. This is useful if your system has a special entropy source. *)
62
-
end
63
-
64
-
module Make (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) : sig
65
-
include S
66
-
67
-
val initialize :
68
-
?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t
69
-
(** [initialize ~g ~sleep generator] sets the default generator to the
70
-
[generator] and sets up periodic entropy feeding for that rng. This
71
-
function fails ([Lwt.fail]) if it is called a second time. The argument
72
-
[~sleep] is measured in ns, and used as sleep between cpu assisted random
73
-
number collection. It defaults to one second. *)
74
-
end
29
+
val initialize :
30
+
?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t
31
+
(** [initialize ~g ~sleep generator] sets the default generator to the
32
+
[generator] and sets up periodic entropy feeding for that rng. This
33
+
function fails ([Lwt.fail]) if it is called a second time. The argument
34
+
[~sleep] is measured in ns, and used as sleep between cpu assisted random
35
+
number collection. It defaults to one second. *)
+1
-2
tests/dune
+1
-2
tests/dune
···
28
28
(name test_entropy_collection)
29
29
(modules test_entropy_collection)
30
30
(package mirage-crypto-rng-mirage)
31
-
(libraries mirage-crypto-rng-mirage mirage-unix mirage-time-unix
32
-
mirage-clock-unix duration ohex))
31
+
(libraries mirage-crypto-rng-mirage mirage-unix duration ohex))
33
32
34
33
(test
35
34
(name test_entropy)
+1
-3
tests/test_entropy_collection.ml
+1
-3
tests/test_entropy_collection.ml
···
23
23
let pools = 1
24
24
end
25
25
26
-
module E = Mirage_crypto_rng_mirage.Make(Time)(Mclock)
27
-
28
26
let with_entropy act =
29
-
E.initialize (module Printing_rng) >>= fun () ->
27
+
Mirage_crypto_rng_mirage.initialize (module Printing_rng) >>= fun () ->
30
28
Format.printf "entropy sources: %a@,%!"
31
29
(fun ppf -> List.iter (fun x ->
32
30
Mirage_crypto_rng.Entropy.pp_source ppf x;