Skip to content
Permalink

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also or learn more about diff comparisons.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also . Learn more about diff comparisons here.
base repository: mirage/mirage
Failed to load repositories. Confirm that selected base ref is valid, then try again.
Loading
base: d440fd68588e
Choose a base ref
...
head repository: mirage/mirage
Failed to load repositories. Confirm that selected head ref is valid, then try again.
Loading
compare: 72d1a5182800
Choose a head ref
  • 2 commits
  • 1 file changed
  • 2 contributors

Commits on Oct 2, 2016

  1. Copy the full SHA
    201c64d View commit details
  2. Merge pull request #605 from hannesm/fix_rng

    shuffle around to add a dependency to nocrypto_entropy to nocrypto_rng
    avsm authored Oct 2, 2016
    Copy the full SHA
    72d1a51 View commit details
Showing with 52 additions and 50 deletions.
  1. +52 −50 lib/mirage.ml
102 changes: 52 additions & 50 deletions lib/mirage.ml
Original file line number Diff line number Diff line change
@@ -113,13 +113,65 @@ end

let stdlib_random = impl stdlib_random_conf


(* This is to check that entropy is a dependency if "tls" is in
the package array. *)
let enable_entropy, is_entropy_enabled =
let r = ref false in
let f () = r := true in
let g () = !r in
(f, g)

let check_entropy libs =
Cmd.OCamlfind.query ~recursive:true libs
>>| List.exists ((=) "nocrypto")
>>= fun is_needed ->
if is_needed && not (is_entropy_enabled ()) then
Log.error
"The \"nocrypto\" library is loaded but entropy is not enabled!@ \
Please enable the entropy by adding a dependency to the nocrypto \
device. You can do so by adding ~deps:[abstract nocrypto] \
to the arguments of Mirage.foreign."
else R.ok ()

let nocrypto = impl @@ object
inherit base_configurable
method ty = job
method name = "nocrypto"
method module_name = "Nocrypto_entropy"

method packages =
Key.match_ Key.(value target) @@ function
| `Xen ->
["nocrypto"; "mirage-entropy-xen"; "zarith-xen"]
| `Virtio | `Ukvm ->
["nocrypto"; "mirage-entropy-solo5"; "zarith-freestanding"]
| `Unix | `MacOSX -> ["nocrypto"]

method libraries =
Key.match_ Key.(value target) @@ function
| `Xen -> ["nocrypto.xen"]
| `Virtio | `Ukvm -> ["nocrypto.solo5"]
| `Unix | `MacOSX -> ["nocrypto.lwt"]

method configure _ = R.ok (enable_entropy ())
method connect i _ _ =
let s = match Key.(get (Info.context i) target) with
| `Xen | `Virtio | `Ukvm -> "Nocrypto_entropy_mirage.initialize ()"
| `Unix | `MacOSX -> "Nocrypto_entropy_lwt.initialize ()"
in
Fmt.strf "%s >|= fun x -> `Ok x" s

end

let nocrypto_random_conf = object
inherit base_configurable
method ty = random
method name = "random"
method module_name = "Nocrypto.Rng"
method packages = Key.pure ["nocrypto"]
method libraries = Key.pure ["nocrypto"]
method deps = [abstract nocrypto]
end

let nocrypto_random = impl nocrypto_random_conf
@@ -826,56 +878,6 @@ let generic_stackv4
(direct_stackv4_with_default_ipv4 ?group tap)
)

(* This is to check that entropy is a dependency if "tls" is in
the package array. *)
let enable_entropy, is_entropy_enabled =
let r = ref false in
let f () = r := true in
let g () = !r in
(f, g)

let check_entropy libs =
Cmd.OCamlfind.query ~recursive:true libs
>>| List.exists ((=) "nocrypto")
>>= fun is_needed ->
if is_needed && not (is_entropy_enabled ()) then
Log.error
"The \"nocrypto\" library is loaded but entropy is not enabled!@ \
Please enable the entropy by adding a dependency to the nocrypto \
device. You can do so by adding ~deps:[abstract nocrypto] \
to the arguments of Mirage.foreign."
else R.ok ()

let nocrypto = impl @@ object
inherit base_configurable
method ty = job
method name = "nocrypto"
method module_name = "Nocrypto_entropy"

method packages =
Key.match_ Key.(value target) @@ function
| `Xen ->
["nocrypto"; "mirage-entropy-xen"; "zarith-xen"]
| `Virtio | `Ukvm ->
["nocrypto"; "mirage-entropy-solo5"; "zarith-freestanding"]
| `Unix | `MacOSX -> ["nocrypto"]

method libraries =
Key.match_ Key.(value target) @@ function
| `Xen -> ["nocrypto.xen"]
| `Virtio | `Ukvm -> ["nocrypto.solo5"]
| `Unix | `MacOSX -> ["nocrypto.lwt"]

method configure _ = R.ok (enable_entropy ())
method connect i _ _ =
let s = match Key.(get (Info.context i) target) with
| `Xen | `Virtio | `Ukvm -> "Nocrypto_entropy_mirage.initialize ()"
| `Unix | `MacOSX -> "Nocrypto_entropy_lwt.initialize ()"
in
Fmt.strf "%s >|= fun x -> `Ok x" s

end

type conduit_connector = Conduit_connector
let conduit_connector = Type Conduit_connector