Merge pull request #240 from tmcgilchrist/updates

Update to latest X509 and DNS APIs.

CHANGES.md

@@ -1,7 +1,7 @@
 ### current
 
 - Fix Fmt deprecation warnings (@tmcgilchrist #239)
-
+- Update to latest X509 and DNS APIs. (@tmcgilchrist #240)
 
 ### v1.2
 

capnp-rpc-mirage.opam

@@ -16,7 +16,7 @@ depends: [
   "astring" {with-test}
   "fmt" {>= "0.8.7"}
   "logs"
-  "dns-client" {>= "5.0.0" & < "6.0.0"}
+  "dns-client" {>= "6.0.0"}
   "tls-mirage"
   "mirage-stack" {>= "2.2.0"}
   "arp" {>= "2.3.0" & with-test}

capnp-rpc-net.opam

@@ -28,7 +28,7 @@ depends: [
   "ptime"
   "prometheus" {>= "0.5"}
   "asn1-combinators" {>= "0.2.0"}
-  "x509" {>= "0.13.0" & < "0.15.0"}
+  "x509" {>= "0.15.0"}
   "tls-mirage"
   "dune" {>= "2.0"}
   "mirage-crypto"

capnp-rpc-net/auth.ml

@@ -77,12 +77,8 @@ module Digest = struct
     | `Insecure -> None
     | `Fingerprint (hash, digest) ->
       let hash = (hash :> Mirage_crypto.Hash.hash) in
-      (* todo: [server_key_fingerprint] insists on checking the DN, so this must match
-         the one in [Secret_key.x509]. Maybe we should make our own authenticator in case
-         other implementations use other names. *)
-      let domain = Domain_name.of_string_exn "capnp" |> Domain_name.host_exn in
-      let fingerprints = [domain, Cstruct.of_string digest] in
-      Some (X509.Authenticator.server_key_fingerprint ~hash ~fingerprints ~time:(fun _ ->None))
+      let fingerprint = Cstruct.of_string digest in
+      Some (X509.Authenticator.server_key_fingerprint ~hash ~fingerprint ~time:(fun _ -> None))
 
   module Map = Map.Make(struct
       type nonrec t = t
@@ -142,7 +138,7 @@ module Secret_key = struct
        we allow any client to connect. We just want to know they key so that
        if we later need to resolve a sturdy ref hosted at the client, we can
        reuse this connection. *)
-    let authenticator ~host:_ _ = Ok None in
+    let authenticator ?ip:_ ~host:_ _ = Ok None in
     let tls_server_config = Tls.Config.server ~certificates ~authenticator () in
     { priv; certificates; tls_server_config }
 

mirage/capnp_rpc_mirage.ml

@@ -4,10 +4,10 @@ module Log = Capnp_rpc.Debug.Log
 
 module Location = Network.Location
 
-module Make (R : Mirage_random.S) (T : Mirage_time.S) (C : Mirage_clock.MCLOCK) (Stack : Mirage_stack.V4V6) = struct
+module Make (R : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) (P : Mirage_clock.PCLOCK) (Stack : Mirage_stack.V4V6) = struct
 
-  module Dns = Dns_client_mirage.Make(R)(T)(C)(Stack)
-  module Network = Network.Make(R)(T)(C)(Stack)
+  module Dns = Dns_client_mirage.Make(R)(T)(M)(P)(Stack)
+  module Network = Network.Make(R)(T)(M)(P)(Stack)
   module Vat_config = Vat_config.Make(Network)
   module Vat_network = Capnp_rpc_net.Networking(Network)(Stack.TCP)
 

mirage/capnp_rpc_mirage.mli

@@ -4,10 +4,10 @@ open Capnp_rpc_net
 
 module Location = Network.Location
 
-module Make (R : Mirage_random.S) (T : Mirage_time.S) (C : Mirage_clock.MCLOCK) (Stack : Mirage_stack.V4V6) : sig
+module Make (R : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) (P : Mirage_clock.PCLOCK) (Stack : Mirage_stack.V4V6) : sig
   include Capnp_rpc_net.VAT_NETWORK with
     type flow = Stack.TCP.flow and
-    module Network = Network.Make(R)(T)(C)(Stack)
+    module Network = Network.Make(R)(T)(M)(P)(Stack)
 
   module Vat_config : sig
     module Listen_address : sig

mirage/network.ml

@@ -17,9 +17,9 @@ module Location = struct
   let equal = ( = )
 end
 
-module Make  (R : Mirage_random.S) (T : Mirage_time.S) (C : Mirage_clock.MCLOCK) (Stack : Mirage_stack.V4V6) = struct
+module Make  (R : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) (P : Mirage_clock.PCLOCK) (Stack : Mirage_stack.V4V6) = struct
 
-  module Dns = Dns_client_mirage.Make(R)(T)(C)(Stack)
+  module Dns = Dns_client_mirage.Make(R)(T)(M)(P)(Stack)
   module Tls_wrapper = Capnp_rpc_net.Tls_wrapper.Make(Stack.TCP)
 
   module Address = struct

mirage/network.mli

@@ -13,9 +13,9 @@ module Location : sig
   (** [tcp ~host port] is [`TCP (host, port)]. *)
 end
 
-module Make (R : Mirage_random.S) (T : Mirage_time.S) (C : Mirage_clock.MCLOCK) (Stack : Mirage_stack.V4V6) : sig
+module Make (R : Mirage_random.S) (T : Mirage_time.S) (M : Mirage_clock.MCLOCK) (P : Mirage_clock.PCLOCK) (Stack : Mirage_stack.V4V6) : sig
 
-  module Dns : module type of Dns_client_mirage.Make(R)(T)(C)(Stack)
+  module Dns : module type of Dns_client_mirage.Make(R)(T)(M)(P)(Stack)
 
   type t = {
     stack : Stack.t;

test-mirage/test_mirage.ml

@@ -5,13 +5,19 @@ open Examples
 
 module Time = struct
   let sleep_ns ns = Lwt_unix.sleep (Duration.to_f ns)
-end 
+end
 
 module Clock = struct
   let period_ns () = None
   let elapsed_ns () = 0L
 end
 
+module PClock = struct
+  let now_d_ps () = (0, 0L)
+  let current_tz_offset_s () = None
+  let period_d_ps () = None
+end
+
 module Random = struct
   type g = unit
 
@@ -45,7 +51,7 @@ module Stack = struct
     Icmp.connect i4 >>= fun icmp ->
     connect v e a i icmp u t
 end
-module Mirage = Capnp_rpc_mirage.Make(Random)(Time)(Clock)(Stack)
+module Mirage = Capnp_rpc_mirage.Make(Random)(Time)(Clock)(PClock)(Stack)
 module Vat = Mirage.Vat
 
 type cs = {