From dc64a36abd3ec66505d1807859dccc9f890ae850 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 5 Feb 2025 15:33:37 +0100 Subject: [PATCH] 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. *)