Merge pull request #1154 from hannesm/next-3.7

Next 3.7

CHANGES.md

@@ -1,3 +1,9 @@
+### v3.7.7 (2020-05-18)
+
+* handle errors from Bos.OS.Cmd.run_out
+* use PREFIX if defined (no need to call "opam config var prefix")
+* adapt to conduit 2.2.0, tls 0.12, mirage-crypto 0.7.0 changes
+
 ### v3.7.6 (2020-03-18)
 
 * fix conduit with 3.7.5 changes (#1086, @hannesm)

lib/mirage.mli

@@ -419,7 +419,7 @@ val generic_stackv4:
 type resolver
 val resolver: resolver typ
 val resolver_dns:
-  ?ns:Ipaddr.V4.t -> ?ns_port:int -> ?random:random impl -> ?mclock:mclock impl -> stackv4 impl -> resolver impl
+  ?ns:Ipaddr.V4.t -> ?ns_port:int -> ?random:random impl -> ?time:time impl -> ?mclock:mclock impl -> stackv4 impl -> resolver impl
 val resolver_unix_system: resolver impl
 
 (** {2 Syslog configuration} *)

lib/mirage_configure.ml

@@ -63,9 +63,9 @@ let find_git () =
   Bos.OS.Dir.current () >>= fun cwd ->
   find cwd None >>= fun subdir ->
   let git_branch = Bos.Cmd.(v "git" % "rev-parse" % "--abbrev-ref" % "HEAD") in
-  Bos.OS.Cmd.(run_out git_branch |> out_string) >>= fun (branch, _) ->
+  Bos.OS.Cmd.(run_out git_branch |> out_string |> success) >>= fun branch ->
   let git_remote = Bos.Cmd.(v "git" % "remote" % "get-url" % "origin") in
-  Bos.OS.Cmd.(run_out git_remote |> out_string) >>| fun (git_url, _) ->
+  Bos.OS.Cmd.(run_out git_remote |> out_string |> success) >>| fun git_url ->
   subdir, branch, git_url
 
 let configure_opam ~name info =

lib/mirage_impl_conduit_connector.ml

@@ -5,7 +5,7 @@ open Mirage_impl_stackv4
 type conduit_connector = Conduit_connector
 let conduit_connector = Type Conduit_connector
 
-let pkg = package ~min:"2.0.2" ~max:"3.0.0" "conduit-mirage"
+let pkg = package ~min:"2.2.0" ~max:"3.0.0" "conduit-mirage"
 
 let tcp_conduit_connector = impl @@ object
     inherit base_configurable
@@ -25,7 +25,7 @@ let tls_conduit_connector = impl @@ object
     method module_name = "Conduit_mirage"
     method! packages =
       Mirage_key.pure [
-        package ~min:"0.11.0" ~max:"0.12.0" "tls-mirage" ;
+        package ~min:"0.12.0" ~max:"0.13.0" "tls-mirage" ;
         pkg
       ]
     method! connect _ _ _ = "Lwt.return Conduit_mirage.with_tls"

lib/mirage_impl_misc.ml

@@ -40,7 +40,9 @@ let query_ocamlfind ?(recursive = false) ?(format="%p") ?predicates libs =
 
 let opam_prefix =
   let cmd = Bos.Cmd.(v "opam" % "config" % "var" % "prefix") in
-  lazy (Bos.OS.Cmd.run_out cmd |> Bos.OS.Cmd.out_string >>| fst)
+  lazy (match Sys.getenv_opt "PREFIX" with
+      | Some x -> Ok x
+      | None -> Bos.OS.Cmd.(run_out cmd |> out_string |> success))
 
 (* Invoke pkg-config and return output if successful. *)
 let pkg_config pkgs args =
@@ -58,7 +60,7 @@ let pkg_config pkgs args =
   in
   Bos.OS.Env.set_var var (Some value) >>= fun () ->
   let cmd = Bos.Cmd.(v "pkg-config" % pkgs %% of_list args) in
-  Bos.OS.Cmd.run_out cmd |> Bos.OS.Cmd.out_string >>| fun (data, _) ->
+  Bos.OS.Cmd.(run_out cmd |> out_string |> success) >>| fun data ->
   String.cuts ~sep:" " ~empty:false data
 
 (* Implement something similar to the @name/file extended names of findlib. *)

lib/mirage_impl_random.ml

@@ -1,28 +1,25 @@
 open Functoria
-open Mirage_impl_misc
+open Mirage_impl_mclock
+open Mirage_impl_time
 
 type random = RANDOM
 let random = Type RANDOM
 
 let random_conf = object
   inherit base_configurable
-  method ty = random
+  method ty = time @-> mclock @-> random
   method name = "random"
-  method module_name = "Mirage_crypto_rng"
+  method module_name = "Mirage_crypto_rng_mirage.Make"
   method! keys = [ Mirage_key.(abstract prng) ]
   method! packages =
-    Mirage_key.(if_ is_unix)
-      [ package ~sublibs:["unix"] "mirage-crypto-rng" ]
-      [ package "mirage-crypto-entropy" ]
-  method! connect i _ _ =
-    match get_target i with
-    | #Mirage_key.mode_unix ->
-      "Lwt.return (Mirage_crypto_rng_unix.initialize ())"
-    | _ ->
-      (* here we could use the boot argument (--prng) to select the RNG! *)
-      "Mirage_crypto_entropy.initialize (module Mirage_crypto_rng.Fortuna)"
+    Mirage_key.pure [
+      package ~sublibs:["mirage"] ~min:"0.7.0" "mirage-crypto-rng"
+    ]
+  method! connect _i modname _ =
+    (* here we could use the boot argument (--prng) to select the RNG! *)
+    Fmt.strf "%s.initialize (module Mirage_crypto_rng.Fortuna)" modname
 end
 
-let default_random = impl random_conf
+let default_random = impl random_conf $ default_time $ default_monotonic_clock
 
 let nocrypto = Functoria_app.noop

lib/mirage_impl_resolver.ml

@@ -4,6 +4,7 @@ open Mirage_impl_misc
 open Mirage_impl_mclock
 open Mirage_impl_stackv4
 open Mirage_impl_random
+open Mirage_impl_time
 open Rresult
 
 type resolver = Resolver
@@ -28,14 +29,14 @@ let resolver_unix_system = impl @@ object
 
 let resolver_dns_conf ~ns ~ns_port = impl @@ object
     inherit base_configurable
-    method ty = random @-> mclock @-> stackv4 @-> resolver
+    method ty = random @-> time @-> mclock @-> stackv4 @-> resolver
     method name = "resolver"
     method module_name = "Resolver_mirage.Make_with_stack"
     method! packages =
       Key.pure [ Mirage_impl_conduit_connector.pkg ]
     method! keys = [ Key.abstract ns ; Key.abstract ns_port ]
     method! connect _ modname = function
-      | [ _r ; _t ; stack ] ->
+      | [ _r ; _t ; _m ; stack ] ->
         Fmt.strf
           "let ns = %a in@;\
            let ns_port = %a in@;\
@@ -45,8 +46,8 @@ let resolver_dns_conf ~ns ~ns_port = impl @@ object
       | _ -> failwith (connect_err "resolver" 3)
   end
 
-let resolver_dns ?ns ?ns_port ?(random = default_random) ?(mclock = default_monotonic_clock) stack =
+let resolver_dns ?ns ?ns_port ?(random = default_random) ?(time = default_time) ?(mclock = default_monotonic_clock) stack =
   let ns = Key.resolver ?default:ns ()
   and ns_port = Key.resolver_port ?default:ns_port ()
   in
-  resolver_dns_conf ~ns ~ns_port $ random $ mclock $ stack
+  resolver_dns_conf ~ns ~ns_port $ random $ time $ mclock $ stack

lib/mirage_impl_resolver.mli

@@ -6,6 +6,7 @@ val resolver_dns :
      ?ns:Ipaddr.V4.t
   -> ?ns_port:int
   -> ?random:Mirage_impl_random.random Functoria.impl
+  -> ?time:Mirage_impl_time.time Functoria.impl
   -> ?mclock:Mirage_impl_mclock.mclock Functoria.impl
   -> Mirage_impl_stackv4.stackv4 Functoria.impl
   -> resolver Functoria.impl

lib/mirage_link.ml

@@ -44,15 +44,15 @@ let link info name target _target_debug =
     in
     let out = name ^ ".xen" in
     let uname_cmd = Bos.Cmd.(v "uname" % "-m") in
-    Bos.OS.Cmd.(run_out uname_cmd |> out_string) >>= fun (machine, _) ->
+    Bos.OS.Cmd.(run_out uname_cmd |> out_string |> success) >>= fun machine ->
     if String.is_prefix ~affix:"arm" machine then begin
       (* On ARM:
          - we must convert the ELF image to an ARM boot executable zImage,
            while on x86 we leave it as it is.
          - we need to link libgcc.a (otherwise we get undefined references to:
            __aeabi_dcmpge, __aeabi_dadd, ...) *)
       let libgcc_cmd = Bos.Cmd.(v "gcc" % "-print-libgcc-file-name") in
-      Bos.OS.Cmd.(run_out libgcc_cmd |> out_string) >>= fun (libgcc, _) ->
+      Bos.OS.Cmd.(run_out libgcc_cmd |> out_string |> success) >>= fun libgcc ->
       let elf = name ^ ".elf" in
       let link = Bos.Cmd.(linker % libgcc % "-o" % elf) in
       Log.info (fun m -> m "linking with %a" Bos.Cmd.pp link);