Merge pull request #479 from talex5/eio

Update to Eio 0.12

eio/tests/fuzz.ml

@@ -156,7 +156,12 @@ end = struct
         );
         aux ()
     in
-    aux()
+    try
+      aux()
+    with Eio.Io (Eio.Net.E Connection_reset _, _) ->
+      (* Due to #452, if we get told that the receiver will no longer send, then
+         we can't send either. *)
+      assert !(t.receiver_closed)
 
   let run_recv_thread t =
     let recv = Promise.await_exn t.receiver in
@@ -291,15 +296,15 @@ let main client_message server_message quickstart actions =
       ~receiver:server_flow
       ~sender_closed:client_closed
       ~receiver_closed:server_closed
-      ~transmit:client_socket#transmit
+      ~transmit:(Mock_socket.transmit client_socket)
       To_server client_message in
   let to_client =
     Path.create
       ~sender:server_flow
       ~receiver:client_flow
       ~sender_closed:server_closed
       ~receiver_closed:client_closed
-      ~transmit:server_socket#transmit
+      ~transmit:(Mock_socket.transmit server_socket)
       To_client server_message
   in
   Fiber.all [
@@ -309,4 +314,6 @@ let main client_message server_message quickstart actions =
   ]
 
 let () =
+  Logs.set_level (Some Warning);
+  Logs.set_reporter (Logs_fmt.reporter ());
   Crowbar.(add_test ~name:"random ops" [bytes; bytes; bool; list action] main)

eio/tests/mock_socket.ml

@@ -1,52 +1,86 @@
+open Eio.Std
+
 module W = Eio.Buf_write
 
 let src = Logs.Src.create "mock-socket" ~doc:"Test socket"
 module Log = (val Logs.src_log src : Logs.LOG)
 
 type transmit_amount = [`Bytes of int | `Drain]
 
-type socket = < Eio.Flow.two_way; transmit : transmit_amount -> unit >
-
-let create ~to_peer ~from_peer label =
-  object
-    inherit Eio.Flow.two_way
-
-    val output_sizes = Eio.Stream.create max_int
-
-    method transmit x =
-      Eio.Stream.add output_sizes x
-
-    method copy src =
-      try
-        while true do
-          let rec write = function
-            | 0 -> ()
-            | size ->
-              let buf = Cstruct.create size in
-              let got = Eio.Flow.single_read src buf in
-              W.cstruct to_peer (Cstruct.sub buf 0 got);
-              Log.info (fun f -> f "%s: wrote %d bytes to network" label got);
-              write (size - got)
-          in
-          match Eio.Stream.take output_sizes with
-          | `Drain -> Eio.Stream.add output_sizes `Drain; write 4096
-          | `Bytes n -> write n
-        done
-      with End_of_file -> ()
-
-    method read_into buf =
-      let batch = W.await_batch from_peer in
-      let got, _ = Cstruct.fillv ~src:batch ~dst:buf in
-      Log.info (fun f -> f "%s: read %d bytes from network" label got);
-      W.shift from_peer got;
-      got
-
-    method shutdown = function
-      | `Send -> 
-        Log.info (fun f -> f "%s: close writer" label);
-        W.close to_peer
-      | _ -> failwith "Not implemented"
-  end
+type ty = [`Mock_tls | Eio.Flow.two_way_ty]
+type t = ty r
+
+let rec takev len = function
+  | [] -> []
+  | x :: xs ->
+    if len = 0 then []
+    else if Cstruct.length x >= len then [Cstruct.sub x 0 len]
+    else x :: takev (len - Cstruct.length x) xs
+
+module Impl = struct
+  type t = {
+    to_peer : W.t;
+    from_peer : W.t;
+    label : string;
+    output_sizes : transmit_amount Eio.Stream.t;
+  }
+
+  let create ~to_peer ~from_peer label = {
+    to_peer;
+    from_peer;
+    label;
+    output_sizes = Eio.Stream.create max_int;
+  }
+
+  let transmit t x =
+    Eio.Stream.add t.output_sizes x
+
+  let single_write t bufs =
+    let size =
+      match Eio.Stream.take t.output_sizes with
+      | `Drain -> Eio.Stream.add t.output_sizes `Drain; Cstruct.lenv bufs
+      | `Bytes size -> size
+    in
+    let bufs = takev size bufs in
+    List.iter (W.cstruct t.to_peer) bufs;
+    let len = Cstruct.lenv bufs in
+    Log.info (fun f -> f "%s: wrote %d bytes to network" t.label len);
+    len
+
+  let copy t ~src = Eio.Flow.Pi.simple_copy ~single_write t ~src
+
+  let single_read t buf =
+    let batch = W.await_batch t.from_peer in
+    let got, _ = Cstruct.fillv ~src:batch ~dst:buf in
+    Log.info (fun f -> f "%s: read %d bytes from network" t.label got);
+    W.shift t.from_peer got;
+    got
+
+  let shutdown t = function
+    | `Send -> 
+      Log.info (fun f -> f "%s: close writer" t.label);
+      W.close t.to_peer
+    | _ -> failwith "Not implemented"
+
+  let read_methods = []
+
+  type (_, _, _) Eio.Resource.pi += Raw : ('t, 't -> t, ty) Eio.Resource.pi
+  let raw (Eio.Resource.T (t, ops)) = Eio.Resource.get ops Raw t
+end
+
+let handler =
+  Eio.Resource.handler (
+    H (Impl.Raw, Fun.id) ::
+    Eio.Resource.bindings (Eio.Flow.Pi.two_way (module Impl))
+  )
+
+let transmit t x =
+  let t = Impl.raw t in
+  Impl.transmit t x
+
+let create ~from_peer ~to_peer label =
+  let t = Impl.create ~from_peer ~to_peer label in
+  Eio.Resource.T (t, handler)
 
 let create_pair () =
   let to_a = W.create 100 in

eio/tests/mock_socket.mli

@@ -1,12 +1,13 @@
+open Eio.Std
+
 type transmit_amount = [
   | `Bytes of int   (* Send the next n bytes of data *)
   | `Drain          (* Transmit all data immediately from now on *)
 ]
 
-type socket = <
-  Eio.Flow.two_way;
-  transmit : transmit_amount -> unit;
->
+type t = [`Mock_tls | Eio.Flow.two_way_ty] r
 
-val create_pair : unit -> socket * socket
+val create_pair : unit -> t * t
 (** Create a pair of sockets [client, server], such that writes to one can be read from the other. *)
+
+val transmit : t -> transmit_amount -> unit

eio/tls_eio.ml

@@ -1,14 +1,25 @@
+open Eio.Std
+
 module Flow = Eio.Flow
 
 exception Tls_alert   of Tls.Packet.alert_type
 exception Tls_failure of Tls.Engine.failure
 
+type Eio.Exn.Backend.t += Tls_socket_closed
+let () = Eio.Exn.Backend.register_pp (fun f -> function
+    | Tls_socket_closed -> Fmt.pf f "TLS_socket_closed"; true
+    | _ -> false
+  )
+
+type ty = [ `Tls | Eio.Flow.two_way_ty ]
+type t = ty r
+
 module Raw = struct
 
   (* We could replace [`Eof] with [`Error End_of_file] and then use
      a regular [result] type here. *)
   type t = {
-    flow           : Flow.two_way ;
+    flow           : Flow.two_way_ty r;
     mutable state  : [ `Active of Tls.Engine.state
                      | `Eof
                      | `Error of exn ] ;
@@ -69,7 +80,7 @@ module Raw = struct
         | (`Error e, _)    -> raise e
         | (`Eof, _)        -> raise End_of_file
 
-  let rec read t buf =
+  let rec single_read t buf =
 
     let writeout res =
       let open Cstruct in
@@ -84,20 +95,22 @@ module Raw = struct
     | Some res -> writeout res
     | None     ->
         match read_react t with
-          | None     -> read t buf
+          | None     -> single_read t buf
           | Some res -> writeout res
 
   let writev t css =
     match t.state with
     | `Error err  -> raise err
-    | `Eof        -> raise End_of_file
+    | `Eof        -> raise (Eio.Net.err (Connection_reset Tls_socket_closed))
     | `Active tls ->
         match Tls.Engine.send_application_data tls css with
         | Some (tls, tlsdata) ->
             ( t.state <- `Active tls ; write_t t tlsdata )
         | None -> invalid_arg "tls: write: socket not ready"
 
-  let write t cs = writev t [cs]
+  let single_write t bufs =
+    writev t bufs;
+    Cstruct.lenv bufs
 
   (*
    * XXX bad XXX
@@ -162,7 +175,7 @@ module Raw = struct
   let server_of_flow config flow =
     drain_handshake {
       state    = `Active (Tls.Engine.server config) ;
-      flow     = (flow :> Flow.two_way) ;
+      flow     = (flow :> Flow.two_way_ty r) ;
       linger   = None ;
       recv_buf = Cstruct.create 4096
     }
@@ -174,7 +187,7 @@ module Raw = struct
     in
     let t = {
       state    = `Eof ;
-      flow     = (flow :> Flow.two_way);
+      flow     = (flow :> Flow.two_way_ty r);
       linger   = None ;
       recv_buf = Cstruct.create 4096
     } in
@@ -192,36 +205,31 @@ module Raw = struct
     | `Eof      -> Error ()
     | `Error _  -> Error ()
 
-  let copy_from t src =
-    try
-      while true do
-        let buf = Cstruct.create 4096 in
-        let got = Flow.single_read src buf in
-        write t (Cstruct.sub buf 0 got)
-      done
-    with End_of_file -> ()
+  let copy t ~src = Eio.Flow.Pi.simple_copy ~single_write t ~src
+
+  let read_methods = []
+
+  type (_, _, _) Eio.Resource.pi += T : ('t, 't -> t, ty) Eio.Resource.pi
 end
 
-type t = <
-  Eio.Flow.two_way;
-  t : Raw.t;
->
+let raw (Eio.Resource.T (t, ops)) = Eio.Resource.get ops Raw.T t
+
+let handler =
+  Eio.Resource.handler [
+    H (Eio.Flow.Pi.Source, (module Raw));
+    H (Eio.Flow.Pi.Sink, (module Raw));
+    H (Eio.Flow.Pi.Shutdown, (module Raw));
+    H (Raw.T, Fun.id);
+  ]
 
-let of_t t =
-  object
-    inherit Eio.Flow.two_way
-    method read_into = Raw.read t
-    method copy = Raw.copy_from t
-    method shutdown = Raw.shutdown t
-    method t = t
-  end
+let of_t t = Eio.Resource.T (t, handler)
 
 let server_of_flow config       flow = Raw.server_of_flow config       flow |> of_t
 let client_of_flow config ?host flow = Raw.client_of_flow config ?host flow |> of_t
 
-let reneg ?authenticator ?acceptable_cas ?cert ?drop (t:t) = Raw.reneg ?authenticator ?acceptable_cas ?cert ?drop t#t
-let key_update ?request (t:t) = Raw.key_update ?request t#t
-let epoch (t:t) = Raw.epoch t#t
+let reneg ?authenticator ?acceptable_cas ?cert ?drop (t:t) = Raw.reneg ?authenticator ?acceptable_cas ?cert ?drop (raw t)
+let key_update ?request (t:t) = Raw.key_update ?request (raw t)
+let epoch (t:t) = Raw.epoch (raw t)
 
 let () =
   Printexc.register_printer (function

eio/tls_eio.mli

@@ -3,13 +3,15 @@
     The pure TLS is state and buffer in, state and buffer out.  This
     module uses Eio for communication over the network. *)
 
+open Eio.Std
+
 (** [Tls_alert] exception received from the other endpoint *)
 exception Tls_alert   of Tls.Packet.alert_type
 
 (** [Tls_failure] exception while processing incoming data *)
 exception Tls_failure of Tls.Engine.failure
 
-type t = private < Eio.Flow.two_way; .. >
+type t = [ `Tls | Eio.Flow.two_way_ty ] r
 
 (** {2 Constructors} *)
 
@@ -19,15 +21,15 @@ type t = private < Eio.Flow.two_way; .. >
     You must ensure a RNG is installed while using TLS, e.g. using [Mirage_crypto_rng_eio].
     Ideally, this would be part of the [server] config so you couldn't forget it,
     but for now you'll get a runtime error if you forget. *)
-val server_of_flow : Tls.Config.server -> #Eio.Flow.two_way -> t
+val server_of_flow : Tls.Config.server -> _ Eio.Flow.two_way -> t
 
 (** [client_of_flow client ~host fd] is [t], after client-side
     TLS handshake of [flow] using [client] configuration and [host].
 
     You must ensure a RNG is installed while using TLS, e.g. using [Mirage_crypto_rng_eio].
     Ideally, this would be part of the [client] config so you couldn't forget it,
     but for now you'll get a runtime error if you forget. *)
-val client_of_flow : Tls.Config.client -> ?host:[ `host ] Domain_name.t -> #Eio.Flow.two_way -> t
+val client_of_flow : Tls.Config.client -> ?host:[ `host ] Domain_name.t -> _ Eio.Flow.two_way -> t
 
 (** {2 Control of TLS features} *)
 

tls-eio.opam

@@ -17,13 +17,15 @@ depends: [
   "ocaml" {>= "5.0.0"}
   "dune" {>= "3.0"}
   "tls" {= version}
-  "mirage-crypto-rng" {>= "0.8.0"}
-  "mirage-crypto-rng-eio" {>= "0.8.0" with-test}
+  "mirage-crypto-rng" {>= "0.11.2"}
+  "mirage-crypto-rng-eio" {>= "0.11.2" with-test}
   "x509" {>= "0.15.0"}
-  "eio" {>= "0.7"}
-  "eio_main" {>= "0.7" with-test}
+  "eio" {>= "0.12"}
+  "eio_main" {>= "0.12" with-test}
   "mdx" {with-test}
   "crowbar" {>= "0.2.1" with-test}
+  "logs" {>= "0.7.0" with-test}
+  "ptime" {>= "1.0.0"}
 ]
 tags: [ "org:mirage"]
 synopsis: "Transport Layer Security purely in OCaml - Eio"