Merge pull request #276 from talex5/update-deps

Update dependencies and remove capnp-rpc-mirage

Makefile

@@ -3,7 +3,7 @@
 default: test build-fuzz
 
 all:
-	dune build @install test/test.exe test-lwt/test_lwt.exe test-bin/calc.exe test-mirage/test_mirage.exe
+	dune build @install test/test.exe test-lwt/test_lwt.exe test-bin/calc.exe
 	rm -rf _build/_tests
 	dune runtest --no-buffer -j 1
 
@@ -19,7 +19,7 @@ clean:
 
 test:
 	rm -rf _build/_tests
-	dune build test/test.exe test-lwt/test_lwt.exe test-bin/calc.exe test-mirage/test_mirage.exe test-bin/echo/echo_bench.exe @install
+	dune build test/test.exe test-lwt/test_lwt.exe test-bin/calc.exe test-bin/echo/echo_bench.exe @install
 	#./_build/default/test/test.bc test core -ev 36
 	#./_build/default/test-lwt/test.bc test lwt -ev 3
 	dune build @runtest --no-buffer -j 1

README.md

@@ -38,7 +38,6 @@ See [LICENSE.md](LICENSE.md) for details.
   * [How can I release other resources when my service is released?](#how-can-i-release-other-resources-when-my-service-is-released)
   * [Is there an interactive version I can use for debugging?](#is-there-an-interactive-version-i-can-use-for-debugging)
   * [Can I set up a direct 2-party connection over a pre-existing channel?](#can-i-set-up-a-direct-2-party-connection-over-a-pre-existing-channel)
-  * [How can I use this with Mirage?](#how-can-i-use-this-with-mirage)
 * [Contributing](#contributing)
   * [Conceptual model](#conceptual-model)
   * [Building](#building)
@@ -108,8 +107,6 @@ The code is split into several packages:
 - `capnp-rpc-unix` adds helper functions for parsing command-line arguments and setting up connections over Unix sockets.
   The tests in `test-lwt` test this by sending Cap'n Proto messages over a Unix-domain socket.
 
-- `capnp-rpc-mirage` is an alternative to `-unix` that works with [Mirage][] unikernels.
-
 **Libraries** that consume or provide Cap'n Proto services should normally depend only on `capnp-rpc-lwt`,
 since they shouldn't care whether the services they use are local or accessed over some kind of network.
 
@@ -912,8 +909,8 @@ let () =
     let root_sr = Capnp_rpc_unix.Vat.import vat root_uri |> or_fail in
     Sturdy_ref.with_cap_exn root_sr @@ fun root ->
     Logger.log root "Message from Admin" >>= fun () ->
-    let for_alice = Logger.sub root "alice" in
-    let for_bob = Logger.sub root "bob" in
+    Capability.with_ref (Logger.sub root "alice") @@ fun for_alice ->
+    Capability.with_ref (Logger.sub root "bob") @@ fun for_bob ->
     Logger.log for_alice "Message from Alice" >>= fun () ->
     Logger.log for_bob "Message from Bob"
   end
@@ -942,9 +939,10 @@ the admin can request the sturdy ref like this:
 <!-- $MDX include,file=examples/sturdy-refs-3/main.ml,part=save -->
 ```ocaml
     (* The admin creates a logger for Alice and saves it: *)
-    let for_alice = Logger.sub root "alice" in
-    Persistence.save_exn for_alice >>= fun uri ->
-    Capnp_rpc_unix.Cap_file.save_uri uri "alice.cap" |> or_fail;
+    Capability.with_ref (Logger.sub root "alice") (fun for_alice ->
+        Persistence.save_exn for_alice >|= fun uri ->
+        Capnp_rpc_unix.Cap_file.save_uri uri "alice.cap" |> or_fail
+      ) >>= fun () ->
     (* Alice uses it: *)
     run_client "alice.cap"
 ```
@@ -1356,58 +1354,6 @@ parent: application: Waiting for child to exit...
 parent: application: Done
 ```
 
-### How can I use this with Mirage?
-
-Note: `capnp` uses the `stdint` library, which has C stubs and
-[might need patching](https://github.com/mirage/mirage/issues/885) to work with the Xen backend.
-<https://github.com/ocaml/ocaml/pull/1201#issuecomment-333941042> explains why OCaml doesn't have unsigned integer support.
-
-Here is a suitable `config.ml`:
-
-<!-- $MDX skip -->
-```ocaml
-open Mirage
-
-let main =
-  foreign
-    ~packages:[package "capnp-rpc-mirage"; package "mirage-dns"]
-    "Unikernel.Make" (random @-> mclock @-> stackv4 @-> job)
-
-let stack = generic_stackv4 default_network
-
-let () =
-  register "test" [main $ default_random $ default_monotonic_clock $ stack]
-```
-
-This should work as the `unikernel.ml`:
-
-<!-- $MDX skip -->
-```ocaml
-open Lwt.Infix
-
-open Capnp_rpc_lwt
-
-module Make (R : Mirage_random.S) (C : Mirage_clock.MCLOCK) (Stack : Mirage_stack.V4) = struct
-  module Mirage_capnp = Capnp_rpc_mirage.Make (R) (C) (Stack)
-
-  let secret_key = `Ephemeral
-
-  let listen_address = `TCP 7000
-  let public_address = `TCP ("localhost", 7000)
-
-  let start () () stack =
-    let dns = Mirage.Network.Dns.create stack in
-    let net = Mirage_capnp.network ~dns stack in
-    let config = Mirage_capnp.Vat_config.create ~secret_key ~public_address listen_address in
-    let service_id = Mirage_capnp.Vat_config.derived_id config "main" in
-    let restore = Restorer.single service_id Echo.local in
-    Mirage_capnp.serve net config ~restore >>= fun vat ->
-    let uri = Mirage_capnp.Vat.sturdy_uri vat service_id in
-    Logs.app (fun f -> f "Main service: %a" Uri.pp_hum uri);
-    Lwt.wait () |> fst
-end
-```
-
 ## Contributing
 
 ### Conceptual model
@@ -1543,7 +1489,6 @@ We should also test with some malicious vats (that don't follow the protocol cor
 [E Reference Mechanics]: http://www.erights.org/elib/concurrency/refmech.html
 [pycapnp]: http://jparyani.github.io/pycapnp/
 [Persistence API]: https://github.com/capnproto/capnproto/blob/master/c%2B%2B/src/capnp/persistent.capnp
-[Mirage]: https://mirage.io/
 [ocaml-ci]: https://github.com/ocurrent/ocaml-ci
 [api]: https://mirage.github.io/capnp-rpc/
 [NETWORK]: https://mirage.github.io/capnp-rpc/capnp-rpc-net/Capnp_rpc_net/S/module-type-NETWORK/index.html

capnp-rpc-net.opam

@@ -21,18 +21,18 @@ depends: [
   "logs"
   "asetmap"
   "cstruct" {>= "6.0.0"}
-  "mirage-flow" {>= "2.0.0"}
-  "tls" {>= "0.13.1"}
+  "mirage-flow" {>= "4.0.2"}
+  "tls" {>= "1.0.2"}
   "base64" {>= "3.0.0"}
   "uri" {>= "1.6.0"}
   "ptime"
   "prometheus" {>= "0.5"}
   "asn1-combinators" {>= "0.2.0"}
-  "x509" {>= "0.15.0"}
+  "x509" {>= "1.0.3"}
   "tls-mirage"
   "dune" {>= "3.0"}
-  "mirage-crypto"
-  "mirage-crypto-rng"
+  "mirage-crypto" {>= "1.1.0"}
+  "mirage-crypto-rng" {>= "1.1.0"}
 ]
 build: [
   ["dune" "build" "-p" name "-j" jobs]

capnp-rpc-net/auth.ml

@@ -47,7 +47,7 @@ module Digest = struct
   let of_certificate cert : t =
     let hash = default_hash in
     let digest = X509.Public_key.fingerprint ~hash (X509.Certificate.public_key cert) in
-    `Fingerprint (hash, Cstruct.to_string digest)
+    `Fingerprint (hash, digest)
 
   let add_to_uri t uri =
     match t with
@@ -76,9 +76,8 @@ module Digest = struct
   let authenticator = function
     | `Insecure -> None
     | `Fingerprint (hash, digest) ->
-      let hash = (hash :> Mirage_crypto.Hash.hash) in
-      let fingerprint = Cstruct.of_string digest in
-      Some (X509.Authenticator.server_key_fingerprint ~hash ~fingerprint ~time:(fun _ -> None))
+      let hash = (hash :> Digestif.hash') in
+      Some (X509.Authenticator.key_fingerprint ~hash ~fingerprint:digest ~time:(fun _ -> None))
 
   module Map = Map.Make(struct
       type nonrec t = t
@@ -98,12 +97,14 @@ module Secret_key = struct
   let tls_server_config t = t.tls_server_config
 
   let tls_client_config t ~authenticator =
-    Tls.Config.client ~certificates:t.certificates ~authenticator ()
+    match Tls.Config.client ~certificates:t.certificates ~authenticator () with
+    | Ok x -> x
+    | Error (`Msg msg) -> Fmt.failwith "tls_client_config: %s" msg
 
   let digest ?(hash=default_hash) t =
-    let nc_hash = (hash :> Mirage_crypto.Hash.hash) in
+    let nc_hash = (hash :> Digestif.hash') in
     let pub = X509.Private_key.public t.priv in
-    let value = X509.Public_key.fingerprint ~hash:nc_hash pub |> Cstruct.to_string in
+    let value = X509.Public_key.fingerprint ~hash:nc_hash pub in
     `Fingerprint (hash, value)
 
   let pp_fingerprint hash f t =
@@ -139,8 +140,9 @@ module Secret_key = struct
        if we later need to resolve a sturdy ref hosted at the client, we can
        reuse this connection. *)
     let authenticator ?ip:_ ~host:_ _ = Ok None in
-    let tls_server_config = Tls.Config.server ~certificates ~authenticator () in
-    { priv; certificates; tls_server_config }
+    match Tls.Config.server ~certificates ~authenticator () with
+    | Ok tls_server_config -> { priv; certificates; tls_server_config }
+    | Error (`Msg m) -> Fmt.failwith "Invalid TLS configuration: %s" m
 
   let generate () =
     Log.info (fun f -> f "Generating new private key...");
@@ -150,10 +152,10 @@ module Secret_key = struct
     t
 
   let of_pem_data data =
-    match X509.Private_key.decode_pem (Cstruct.of_string data) with
+    match X509.Private_key.decode_pem data with
     | Ok priv -> of_priv priv
     | Error (`Msg msg) -> Fmt.failwith "Failed to parse secret key!@ %s" msg
 
   let to_pem_data t =
-    X509.Private_key.encode_pem t.priv |> Cstruct.to_string
+    X509.Private_key.encode_pem t.priv
 end

capnp-rpc-net/restorer.ml

@@ -8,18 +8,18 @@ module Id = struct
   type t = string
 
   let generate () =
-    Mirage_crypto_rng.generate 20 |> Cstruct.to_string
+    Mirage_crypto_rng.generate 20
 
   let public x = x
 
   let derived ~secret name =
-    Mirage_crypto.Hash.mac `SHA256 ~key:(Cstruct.of_string secret) (Cstruct.of_string name)
-    |> Cstruct.to_string
+    Digestif.SHA256.hmac_string ~key:secret name
+    |> Digestif.SHA256.to_raw_string
 
   let digest alg t =
-    let alg = (alg :> Mirage_crypto.Hash.hash) in
-    Mirage_crypto.Hash.digest alg (Cstruct.of_string t)
-    |> Cstruct.to_string
+    let alg = (alg :> Digestif.hash') in
+    let module H = (val Digestif.module_of_hash' alg : Digestif.S) in
+    H.digest_string t |> H.to_raw_string
 
   let to_string x = x
 
@@ -64,10 +64,10 @@ let none : t = fun _ ->
 let single id cap =
   let cap = Cast.cap_to_raw cap in
   (* Hash the ID to prevent timing attacks. *)
-  let id = Mirage_crypto.Hash.digest `SHA256 (Cstruct.of_string id) in
+  let id = Digestif.SHA256.digest_string id |> Digestif.SHA256.to_raw_string in
   fun requested_id ->
-    let requested_id = Mirage_crypto.Hash.digest `SHA256 (Cstruct.of_string requested_id) in
-    if Cstruct.equal id requested_id then (
+    let requested_id = Digestif.SHA256.digest_string requested_id |> Digestif.SHA256.to_raw_string in
+    if String.equal id requested_id then (
       Core_types.inc_ref cap;
       Lwt.return (Ok cap)
     ) else Lwt.return unknown_service_id
@@ -80,7 +80,7 @@ module Table = struct
     | Manual of Core_types.cap          (* We hold a ref on the cap *)
 
   type t = {
-    hash : Mirage_crypto.Hash.hash;
+    hash : Digestif.hash';
     cache : (digest, entry) Hashtbl.t;
     load : Id.t -> digest -> resolution Lwt.t;
     make_sturdy : Id.t -> Uri.t;
@@ -131,7 +131,7 @@ module Table = struct
         )
 
   let of_loader (type l) (module L : LOADER with type t = l) loader =
-    let hash = (L.hash loader :> Mirage_crypto.Hash.hash) in
+    let hash = (L.hash loader :> Digestif.hash') in
     let cache = Hashtbl.create 53 in
     let rec load id digest =
       let sr : Private.Capnp_core.sturdy_ref = object

examples/sturdy-refs-2/main.ml

@@ -33,8 +33,8 @@ let () =
     let root_sr = Capnp_rpc_unix.Vat.import vat root_uri |> or_fail in
     Sturdy_ref.with_cap_exn root_sr @@ fun root ->
     Logger.log root "Message from Admin" >>= fun () ->
-    let for_alice = Logger.sub root "alice" in
-    let for_bob = Logger.sub root "bob" in
+    Capability.with_ref (Logger.sub root "alice") @@ fun for_alice ->
+    Capability.with_ref (Logger.sub root "bob") @@ fun for_bob ->
     Logger.log for_alice "Message from Alice" >>= fun () ->
     Logger.log for_bob "Message from Bob"
   end

examples/sturdy-refs-3/logger.ml

@@ -23,11 +23,13 @@ let rec local ~services sr label =
       let id = Capnp_rpc_net.Restorer.Id.generate () in
       let sr = Capnp_rpc_net.Restorer.Table.sturdy_ref services id in
       let sub = local ~services sr (Printf.sprintf "%s/%s" label sub_label) in
-      Capnp_rpc_net.Restorer.Table.add services id sub;
       let response, results = Service.Response.create Results.init_pointer in
       Results.logger_set results (Some sub);
-      Capability.dec_ref sub;
+      Capnp_rpc_net.Restorer.Table.add services id sub; (* Takes ownership of [sub] *)
       Service.return response
+
+    method! pp f =
+      Fmt.pf f "Logger(%s)" label
   end
 
 module Logger = Api.Client.Logger

examples/sturdy-refs-3/main.ml

@@ -14,10 +14,11 @@ let or_fail = function
   | Ok x -> x
   | Error (`Msg m) -> failwith m
 
-let start_server () =
+let start_server ~switch () =
   let config = Capnp_rpc_unix.Vat_config.create ~secret_key listen_address in
   let make_sturdy = Capnp_rpc_unix.Vat_config.sturdy_uri config in
   let services = Restorer.Table.create make_sturdy in
+  Lwt_switch.add_hook (Some switch) (fun () -> Restorer.Table.clear services; Lwt.return_unit);
   let restore = Restorer.of_table services in
   (* $MDX part-begin=root *)
   let root_id = Capnp_rpc_unix.Vat_config.derived_id config "root" in
@@ -27,27 +28,30 @@ let start_server () =
   in
   (* $MDX part-end *)
   Restorer.Table.add services root_id root;
-  Capnp_rpc_unix.serve config ~restore >|= fun _vat ->
+  Capnp_rpc_unix.serve ~switch config ~restore >|= fun _vat ->
   Capnp_rpc_unix.Vat_config.sturdy_uri config root_id
 
 let run_client cap_file =
-  let vat = Capnp_rpc_unix.client_only_vat () in
+  Lwt_switch.with_switch @@ fun switch ->
+  let vat = Capnp_rpc_unix.client_only_vat ~switch () in
   let sr = Capnp_rpc_unix.Cap_file.load vat cap_file |> or_fail in
   Sturdy_ref.with_cap_exn sr @@ fun for_alice ->
   Logger.log for_alice "Message from Alice"
 
 let () =
   Lwt_main.run begin
-    start_server () >>= fun root_uri ->
-    let vat = Capnp_rpc_unix.client_only_vat () in
+    Lwt_switch.with_switch @@ fun switch ->
+    start_server ~switch () >>= fun root_uri ->
+    let vat = Capnp_rpc_unix.client_only_vat ~switch () in
     let root_sr = Capnp_rpc_unix.Vat.import vat root_uri |> or_fail in
     Sturdy_ref.with_cap_exn root_sr @@ fun root ->
     Logger.log root "Message from Admin" >>= fun () ->
     (* $MDX part-begin=save *)
     (* The admin creates a logger for Alice and saves it: *)
-    let for_alice = Logger.sub root "alice" in
-    Persistence.save_exn for_alice >>= fun uri ->
-    Capnp_rpc_unix.Cap_file.save_uri uri "alice.cap" |> or_fail;
+    Capability.with_ref (Logger.sub root "alice") (fun for_alice ->
+        Persistence.save_exn for_alice >|= fun uri ->
+        Capnp_rpc_unix.Cap_file.save_uri uri "alice.cap" |> or_fail
+      ) >>= fun () ->
     (* Alice uses it: *)
     run_client "alice.cap"
     (* $MDX part-end *)

examples/sturdy-refs-4/logger.ml

@@ -31,6 +31,9 @@ let local ~persist_new sr label =
         Capability.dec_ref logger;
         Ok response
 (* $MDX part-end *)
+
+    method! pp f =
+      Fmt.pf f "Logger(%s)" label
   end
 
 module Logger = Api.Client.Logger