From f688fc06a61ec52e5fcd536faa2df1c94074a129 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Thu, 16 Jan 2025 14:19:48 +0100 Subject: [PATCH 1/4] add next generation mirage-crypto-rng-mirage --- mirage-crypto-rng-mirage2.opam | 31 ++++++++++ rng/mirage2/dune | 5 ++ rng/mirage2/mirage_crypto_rng_mirage.ml | 73 ++++++++++++++++++++++++ rng/mirage2/mirage_crypto_rng_mirage.mli | 35 ++++++++++++ 4 files changed, 144 insertions(+) create mode 100644 mirage-crypto-rng-mirage2.opam create mode 100644 rng/mirage2/dune create mode 100644 rng/mirage2/mirage_crypto_rng_mirage.ml create mode 100644 rng/mirage2/mirage_crypto_rng_mirage.mli diff --git a/mirage-crypto-rng-mirage2.opam b/mirage-crypto-rng-mirage2.opam new file mode 100644 index 00000000..5a83ec06 --- /dev/null +++ b/mirage-crypto-rng-mirage2.opam @@ -0,0 +1,31 @@ +opam-version: "2.0" +homepage: "https://github.com/mirage/mirage-crypto" +dev-repo: "git+https://github.com/mirage/mirage-crypto.git" +bug-reports: "https://github.com/mirage/mirage-crypto/issues" +doc: "https://mirage.github.io/mirage-crypto/doc" +authors: ["David Kaloper " "Hannes Mehnert " ] +maintainer: "Hannes Mehnert " +license: "BSD-2-Clause" +synopsis: "Entropy collection for a cryptographically secure PRNG" + +build: [ ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs ] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] + +depends: [ + "ocaml" {>= "4.13.0"} + "dune" {>= "2.7"} + "mirage-crypto-rng" {=version} + "duration" + "logs" + "lwt" {>= "4.0.0"} + "mirage-runtime" {>= "3.8.0"} + "mirage-sleep" {>= "4.0.0"} + "mirage-mtime" {>= "4.0.0"} + "mirage-unix" {with-test & >= "5.0.0"} + "ohex" {with-test & >= "0.2.0"} +] +description: """ +Mirage-crypto-rng-mirage provides entropy collection code for the RNG. +""" +x-maintenance-intent: [ "(latest)" ] diff --git a/rng/mirage2/dune b/rng/mirage2/dune new file mode 100644 index 00000000..4ac7ba7e --- /dev/null +++ b/rng/mirage2/dune @@ -0,0 +1,5 @@ +(library + (name mirage_crypto_rng_mirage) + (public_name mirage-crypto-rng-mirage2) + (libraries lwt mirage-runtime mirage-crypto-rng mirage-sleep mirage-mtime + duration logs)) diff --git a/rng/mirage2/mirage_crypto_rng_mirage.ml b/rng/mirage2/mirage_crypto_rng_mirage.ml new file mode 100644 index 00000000..1d824710 --- /dev/null +++ b/rng/mirage2/mirage_crypto_rng_mirage.ml @@ -0,0 +1,73 @@ +(* + * Copyright (c) 2014 Hannes Mehnert + * Copyright (c) 2014 Anil Madhavapeddy + * Copyright (c) 2014-2016 David Kaloper Meršinjak + * Copyright (c) 2015 Citrix Systems Inc + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * * Redistributions of source code must retain the above copyright notice, this + * list of conditions and the following disclaimer. + * + * * Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +let src = Logs.Src.create "mirage-crypto-rng-mirage" ~doc:"Mirage crypto RNG mirage" +module Log = (val Logs.src_log src : Logs.LOG) + +open Mirage_crypto_rng + +let rdrand_task delta = + match Entropy.cpu_rng with + | Error `Not_supported -> () + | Ok cpu_rng -> + let open Lwt.Infix in + let rdrand = cpu_rng None in + Lwt.async (fun () -> + let rec one () = + rdrand (); + Mirage_sleep.ns delta >>= + one + in + one ()) + +let bootstrap_functions () = + Entropy.[ bootstrap ; bootstrap ; whirlwind_bootstrap ; bootstrap ] + +let running = ref false + +let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) = + if !running then + Lwt.fail_with "entropy collection already running" + else begin + (try + let _ = default_generator () in + Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \ + been set, check that this call is intentional"); + with + No_default_generator -> ()); + running := true; + let seed = + List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat "" + in + let rng = create ?g ~seed ~time:Mirage_mtime.elapsed_ns rng in + set_default_generator rng; + rdrand_task sleep; + Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None); + Lwt.return_unit + end diff --git a/rng/mirage2/mirage_crypto_rng_mirage.mli b/rng/mirage2/mirage_crypto_rng_mirage.mli new file mode 100644 index 00000000..25e748c2 --- /dev/null +++ b/rng/mirage2/mirage_crypto_rng_mirage.mli @@ -0,0 +1,35 @@ +(* + * Copyright (c) 2014 Hannes Mehnert + * Copyright (c) 2014 Anil Madhavapeddy + * Copyright (c) 2014-2016 David Kaloper Meršinjak + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * * Redistributions of source code must retain the above copyright notice, this + * list of conditions and the following disclaimer. + * + * * Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" + * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE + * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR + * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER + * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, + * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE + * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +val initialize : + ?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t +(** [initialize ~g ~sleep generator] sets the default generator to the + [generator] and sets up periodic entropy feeding for that rng. This + function fails ([Lwt.fail]) if it is called a second time. The argument + [~sleep] is measured in ns, and used as sleep between cpu assisted random + number collection. It defaults to one second. *) From 1980b9688539ee6f16671e27544beb3a6a0ba356 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 5 Feb 2025 15:33:37 +0100 Subject: [PATCH 2/4] Defunctorise mirage-crypto-rng-mirage, use mirage-sleep and mirage-mtime instead --- mirage-crypto-rng-mirage.opam | 6 +- mirage-crypto-rng-mirage2.opam | 31 -------- rng/mirage/dune | 2 +- rng/mirage/mirage_crypto_rng_mirage.ml | 93 ++++++++++-------------- rng/mirage/mirage_crypto_rng_mirage.mli | 53 ++------------ rng/mirage2/dune | 5 -- rng/mirage2/mirage_crypto_rng_mirage.ml | 73 ------------------- rng/mirage2/mirage_crypto_rng_mirage.mli | 35 --------- 8 files changed, 47 insertions(+), 251 deletions(-) delete mode 100644 mirage-crypto-rng-mirage2.opam delete mode 100644 rng/mirage2/dune delete mode 100644 rng/mirage2/mirage_crypto_rng_mirage.ml delete mode 100644 rng/mirage2/mirage_crypto_rng_mirage.mli diff --git a/mirage-crypto-rng-mirage.opam b/mirage-crypto-rng-mirage.opam index 5eeb665f..5a83ec06 100644 --- a/mirage-crypto-rng-mirage.opam +++ b/mirage-crypto-rng-mirage.opam @@ -20,11 +20,9 @@ depends: [ "logs" "lwt" {>= "4.0.0"} "mirage-runtime" {>= "3.8.0"} - "mirage-time" {>= "2.0.0"} - "mirage-clock" {>= "3.0.0"} + "mirage-sleep" {>= "4.0.0"} + "mirage-mtime" {>= "4.0.0"} "mirage-unix" {with-test & >= "5.0.0"} - "mirage-time-unix" {with-test & >= "2.0.0"} - "mirage-clock-unix" {with-test & >= "3.0.0"} "ohex" {with-test & >= "0.2.0"} ] description: """ diff --git a/mirage-crypto-rng-mirage2.opam b/mirage-crypto-rng-mirage2.opam deleted file mode 100644 index 5a83ec06..00000000 --- a/mirage-crypto-rng-mirage2.opam +++ /dev/null @@ -1,31 +0,0 @@ -opam-version: "2.0" -homepage: "https://github.com/mirage/mirage-crypto" -dev-repo: "git+https://github.com/mirage/mirage-crypto.git" -bug-reports: "https://github.com/mirage/mirage-crypto/issues" -doc: "https://mirage.github.io/mirage-crypto/doc" -authors: ["David Kaloper " "Hannes Mehnert " ] -maintainer: "Hannes Mehnert " -license: "BSD-2-Clause" -synopsis: "Entropy collection for a cryptographically secure PRNG" - -build: [ ["dune" "subst"] {dev} - ["dune" "build" "-p" name "-j" jobs ] - ["dune" "runtest" "-p" name "-j" jobs] {with-test} ] - -depends: [ - "ocaml" {>= "4.13.0"} - "dune" {>= "2.7"} - "mirage-crypto-rng" {=version} - "duration" - "logs" - "lwt" {>= "4.0.0"} - "mirage-runtime" {>= "3.8.0"} - "mirage-sleep" {>= "4.0.0"} - "mirage-mtime" {>= "4.0.0"} - "mirage-unix" {with-test & >= "5.0.0"} - "ohex" {with-test & >= "0.2.0"} -] -description: """ -Mirage-crypto-rng-mirage provides entropy collection code for the RNG. -""" -x-maintenance-intent: [ "(latest)" ] diff --git a/rng/mirage/dune b/rng/mirage/dune index 5cf928af..7f4851b8 100644 --- a/rng/mirage/dune +++ b/rng/mirage/dune @@ -1,5 +1,5 @@ (library (name mirage_crypto_rng_mirage) (public_name mirage-crypto-rng-mirage) - (libraries lwt mirage-runtime mirage-crypto-rng mirage-time mirage-clock + (libraries lwt mirage-runtime mirage-crypto-rng mirage-sleep mirage-mtime duration logs)) diff --git a/rng/mirage/mirage_crypto_rng_mirage.ml b/rng/mirage/mirage_crypto_rng_mirage.ml index bc846a38..1d824710 100644 --- a/rng/mirage/mirage_crypto_rng_mirage.ml +++ b/rng/mirage/mirage_crypto_rng_mirage.ml @@ -27,66 +27,47 @@ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -module type S = sig - type g = Mirage_crypto_rng.g - module Entropy : - sig - type source = Mirage_crypto_rng.Entropy.source - val sources : unit -> source list - val pp_source : Format.formatter -> source -> unit - val register_source : string -> source - end - - val generate_into : ?g:g -> bytes -> ?off:int -> int -> unit - val generate : ?g:g -> int -> string - - val accumulate : g option -> Entropy.source -> [`Acc of string -> unit] -end - let src = Logs.Src.create "mirage-crypto-rng-mirage" ~doc:"Mirage crypto RNG mirage" module Log = (val Logs.src_log src : Logs.LOG) -module Make (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) = struct - include Mirage_crypto_rng +open Mirage_crypto_rng - let rdrand_task delta = - match Entropy.cpu_rng with - | Error `Not_supported -> () - | Ok cpu_rng -> - let open Lwt.Infix in - let rdrand = cpu_rng None in - Lwt.async (fun () -> - let rec one () = - rdrand (); - T.sleep_ns delta >>= - one - in - one ()) +let rdrand_task delta = + match Entropy.cpu_rng with + | Error `Not_supported -> () + | Ok cpu_rng -> + let open Lwt.Infix in + let rdrand = cpu_rng None in + Lwt.async (fun () -> + let rec one () = + rdrand (); + Mirage_sleep.ns delta >>= + one + in + one ()) - let bootstrap_functions () = - [ Entropy.bootstrap ; Entropy.bootstrap ; - Entropy.whirlwind_bootstrap ; Entropy.bootstrap ] +let bootstrap_functions () = + Entropy.[ bootstrap ; bootstrap ; whirlwind_bootstrap ; bootstrap ] - let running = ref false +let running = ref false - let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) = - if !running then - Lwt.fail_with "entropy collection already running" - else begin - (try - let _ = default_generator () in - Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \ - been set, check that this call is intentional"); - with - No_default_generator -> ()); - running := true; - let seed = - List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat "" - in - let rng = create ?g ~seed ~time:M.elapsed_ns rng in - set_default_generator rng; - rdrand_task sleep; - Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None); - Lwt.return_unit - end -end +let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) = + if !running then + Lwt.fail_with "entropy collection already running" + else begin + (try + let _ = default_generator () in + Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \ + been set, check that this call is intentional"); + with + No_default_generator -> ()); + running := true; + let seed = + List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat "" + in + let rng = create ?g ~seed ~time:Mirage_mtime.elapsed_ns rng in + set_default_generator rng; + rdrand_task sleep; + Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None); + Lwt.return_unit + end diff --git a/rng/mirage/mirage_crypto_rng_mirage.mli b/rng/mirage/mirage_crypto_rng_mirage.mli index d085b367..25e748c2 100644 --- a/rng/mirage/mirage_crypto_rng_mirage.mli +++ b/rng/mirage/mirage_crypto_rng_mirage.mli @@ -26,49 +26,10 @@ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. *) -module type S = sig - type g = Mirage_crypto_rng.g - (** A generator (PRNG) with its state. *) - - (** Entropy sources and collection *) - module Entropy : - sig - (** Entropy sources. *) - type source = Mirage_crypto_rng.Entropy.source - - val sources : unit -> source list - (** [sources ()] returns the list of available sources. *) - - val pp_source : Format.formatter -> source -> unit - (** [pp_source ppf source] pretty-prints the entropy [source] on [ppf]. *) - - val register_source : string -> source - (** [register_source name] registers [name] as entropy source. *) - end - - val generate_into : ?g:g -> bytes -> ?off:int -> int -> unit - (** [generate_into ~g buf ~off len] invokes - {{!Generator.generate_into}generate_into} on [g] or - {{!generator}default generator}. The random data is put into [buf] starting - at [off] (defaults to 0) with [len] bytes. *) - - val generate : ?g:g -> int -> string - (** Invoke {!generate_into} on [g] or {{!generator}default generator} and a - freshly allocated string. *) - - val accumulate : g option -> Entropy.source -> [`Acc of string -> unit] - (** [accumulate g source] is a function [data -> unit] to feed entropy to the - RNG. This is useful if your system has a special entropy source. *) -end - -module Make (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) : sig - include S - - val initialize : - ?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t - (** [initialize ~g ~sleep generator] sets the default generator to the - [generator] and sets up periodic entropy feeding for that rng. This - function fails ([Lwt.fail]) if it is called a second time. The argument - [~sleep] is measured in ns, and used as sleep between cpu assisted random - number collection. It defaults to one second. *) -end +val initialize : + ?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t +(** [initialize ~g ~sleep generator] sets the default generator to the + [generator] and sets up periodic entropy feeding for that rng. This + function fails ([Lwt.fail]) if it is called a second time. The argument + [~sleep] is measured in ns, and used as sleep between cpu assisted random + number collection. It defaults to one second. *) diff --git a/rng/mirage2/dune b/rng/mirage2/dune deleted file mode 100644 index 4ac7ba7e..00000000 --- a/rng/mirage2/dune +++ /dev/null @@ -1,5 +0,0 @@ -(library - (name mirage_crypto_rng_mirage) - (public_name mirage-crypto-rng-mirage2) - (libraries lwt mirage-runtime mirage-crypto-rng mirage-sleep mirage-mtime - duration logs)) diff --git a/rng/mirage2/mirage_crypto_rng_mirage.ml b/rng/mirage2/mirage_crypto_rng_mirage.ml deleted file mode 100644 index 1d824710..00000000 --- a/rng/mirage2/mirage_crypto_rng_mirage.ml +++ /dev/null @@ -1,73 +0,0 @@ -(* - * Copyright (c) 2014 Hannes Mehnert - * Copyright (c) 2014 Anil Madhavapeddy - * Copyright (c) 2014-2016 David Kaloper Meršinjak - * Copyright (c) 2015 Citrix Systems Inc - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * * Redistributions of source code must retain the above copyright notice, this - * list of conditions and the following disclaimer. - * - * * Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE - * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE - * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR - * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, - * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -let src = Logs.Src.create "mirage-crypto-rng-mirage" ~doc:"Mirage crypto RNG mirage" -module Log = (val Logs.src_log src : Logs.LOG) - -open Mirage_crypto_rng - -let rdrand_task delta = - match Entropy.cpu_rng with - | Error `Not_supported -> () - | Ok cpu_rng -> - let open Lwt.Infix in - let rdrand = cpu_rng None in - Lwt.async (fun () -> - let rec one () = - rdrand (); - Mirage_sleep.ns delta >>= - one - in - one ()) - -let bootstrap_functions () = - Entropy.[ bootstrap ; bootstrap ; whirlwind_bootstrap ; bootstrap ] - -let running = ref false - -let initialize (type a) ?g ?(sleep = Duration.of_sec 1) (rng : a generator) = - if !running then - Lwt.fail_with "entropy collection already running" - else begin - (try - let _ = default_generator () in - Log.warn (fun m -> m "Mirage_crypto_rng.default_generator has already \ - been set, check that this call is intentional"); - with - No_default_generator -> ()); - running := true; - let seed = - List.mapi (fun i f -> f i) (bootstrap_functions ()) |> String.concat "" - in - let rng = create ?g ~seed ~time:Mirage_mtime.elapsed_ns rng in - set_default_generator rng; - rdrand_task sleep; - Mirage_runtime.at_enter_iter (Entropy.timer_accumulator None); - Lwt.return_unit - end diff --git a/rng/mirage2/mirage_crypto_rng_mirage.mli b/rng/mirage2/mirage_crypto_rng_mirage.mli deleted file mode 100644 index 25e748c2..00000000 --- a/rng/mirage2/mirage_crypto_rng_mirage.mli +++ /dev/null @@ -1,35 +0,0 @@ -(* - * Copyright (c) 2014 Hannes Mehnert - * Copyright (c) 2014 Anil Madhavapeddy - * Copyright (c) 2014-2016 David Kaloper Meršinjak - * All rights reserved. - * - * Redistribution and use in source and binary forms, with or without - * modification, are permitted provided that the following conditions are met: - * - * * Redistributions of source code must retain the above copyright notice, this - * list of conditions and the following disclaimer. - * - * * Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * - * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" - * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE - * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE - * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE - * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL - * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR - * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER - * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, - * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE - * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -val initialize : - ?g:'a -> ?sleep:int64 -> 'a Mirage_crypto_rng.generator -> unit Lwt.t -(** [initialize ~g ~sleep generator] sets the default generator to the - [generator] and sets up periodic entropy feeding for that rng. This - function fails ([Lwt.fail]) if it is called a second time. The argument - [~sleep] is measured in ns, and used as sleep between cpu assisted random - number collection. It defaults to one second. *) From ba454b2abfb18bdb3054ca1a9390c9384983a33b Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 5 Feb 2025 16:00:40 +0100 Subject: [PATCH 3/4] fix test --- tests/dune | 3 +-- tests/test_entropy_collection.ml | 4 +--- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/tests/dune b/tests/dune index b6be7ac6..18892a3e 100644 --- a/tests/dune +++ b/tests/dune @@ -28,8 +28,7 @@ (name test_entropy_collection) (modules test_entropy_collection) (package mirage-crypto-rng-mirage) - (libraries mirage-crypto-rng-mirage mirage-unix mirage-time-unix - mirage-clock-unix duration ohex)) + (libraries mirage-crypto-rng-mirage mirage-unix duration ohex)) (test (name test_entropy) diff --git a/tests/test_entropy_collection.ml b/tests/test_entropy_collection.ml index bed653b2..fa0bcfb0 100644 --- a/tests/test_entropy_collection.ml +++ b/tests/test_entropy_collection.ml @@ -23,10 +23,8 @@ module Printing_rng = struct let pools = 1 end -module E = Mirage_crypto_rng_mirage.Make(Time)(Mclock) - let with_entropy act = - E.initialize (module Printing_rng) >>= fun () -> + Mirage_crypto_rng_mirage.initialize (module Printing_rng) >>= fun () -> Format.printf "entropy sources: %a@,%!" (fun ppf -> List.iter (fun x -> Mirage_crypto_rng.Entropy.pp_source ppf x; From dbee8a36181993ed48bfed8e926fbf8b8715616d Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 5 Feb 2025 16:50:14 +0100 Subject: [PATCH 4/4] adapt to mirage how it'll be in the future (no functor) --- mirage/config.ml | 4 ++-- mirage/unikernel.ml | 52 ++++++++++++++++++++++----------------------- 2 files changed, 27 insertions(+), 29 deletions(-) diff --git a/mirage/config.ml b/mirage/config.ml index 21647e63..d0982110 100644 --- a/mirage/config.ml +++ b/mirage/config.ml @@ -9,7 +9,7 @@ let main = package "ohex" ; ] in - main ~packages "Unikernel.Main" (random @-> job) + main ~packages "Unikernel" job let () = - register "crypto-test" [main $ default_random] + register "crypto-test" [main] diff --git a/mirage/unikernel.ml b/mirage/unikernel.ml index cd5cfac3..4deaaa15 100644 --- a/mirage/unikernel.ml +++ b/mirage/unikernel.ml @@ -1,27 +1,25 @@ -module Main (R : Mirage_crypto_rng_mirage.S) = struct - let start _r = - Logs.info (fun m -> m "using Fortuna, entropy sources: %a" - Fmt.(list ~sep:(any ", ") Mirage_crypto_rng.Entropy.pp_source) - (Mirage_crypto_rng.Entropy.sources ())) ; - Logs.info (fun m -> m "64 byte random:@ %a" (Ohex.pp_hexdump ()) - (R.generate 64)) ; - let n = Bytes.(unsafe_to_string (create 32)) in - let key = Mirage_crypto.Chacha20.of_secret n - and nonce = Bytes.(unsafe_to_string (create 12)) - in - Logs.info (fun m -> m "Chacha20/Poly1305 of 32*0, key 32*0, nonce 12*0: %a" - (Ohex.pp_hexdump ()) - (Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce n)); - let key = Mirage_crypto_pk.Rsa.generate ~bits:4096 () in - let signature = - Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key (`Message n) - in - let verified = - let key = Mirage_crypto_pk.Rsa.pub_of_priv key in - let hashp = function `SHA256 -> true | _ -> false in - Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Message n) - in - Logs.info (fun m -> m "Generated a RSA key of %d bits (sign + verify %B)" - (Mirage_crypto_pk.Rsa.priv_bits key) verified); - Lwt.return_unit -end +let start () = + Logs.info (fun m -> m "using Fortuna, entropy sources: %a" + Fmt.(list ~sep:(any ", ") Mirage_crypto_rng.Entropy.pp_source) + (Mirage_crypto_rng.Entropy.sources ())) ; + Logs.info (fun m -> m "64 byte random:@ %a" (Ohex.pp_hexdump ()) + (Mirage_crypto_rng.generate 64)) ; + let n = Bytes.(unsafe_to_string (create 32)) in + let key = Mirage_crypto.Chacha20.of_secret n + and nonce = Bytes.(unsafe_to_string (create 12)) + in + Logs.info (fun m -> m "Chacha20/Poly1305 of 32*0, key 32*0, nonce 12*0: %a" + (Ohex.pp_hexdump ()) + (Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce n)); + let key = Mirage_crypto_pk.Rsa.generate ~bits:4096 () in + let signature = + Mirage_crypto_pk.Rsa.PKCS1.sign ~hash:`SHA256 ~key (`Message n) + in + let verified = + let key = Mirage_crypto_pk.Rsa.pub_of_priv key in + let hashp = function `SHA256 -> true | _ -> false in + Mirage_crypto_pk.Rsa.PKCS1.verify ~hashp ~key ~signature (`Message n) + in + Logs.info (fun m -> m "Generated a RSA key of %d bits (sign + verify %B)" + (Mirage_crypto_pk.Rsa.priv_bits key) verified); + Lwt.return_unit