Merge pull request #483 from hannesm/prep-release

Engine.epoch: return a result instead of a custom polymorphic variant

Author: hannesm

CHANGES.md

@@ -1,3 +1,14 @@
+## v0.17.3 (2023-11-20)
+
+* tls: provide Engine.export_key_material, which implements RFC 5705 (and 8446)
+  TLS EKM (#482 @hannesm)
+* tls: fix protocol_version in Engine.epoch (TLS 1.3 always pretended TLS 1.0)
+  (#482 @hannesm)
+* tls: add the side (`` `Client `` or `` `Server ``) to epoch_data
+  (#482 @hannesm)
+* BREAKING tls: Engine.epoch - return result instead of custom variant
+  (#483 @hannesm)
+
 ## v0.17.2 (2023-09-24)
 
 * tls-eio: update to eio 0.12 (#479 @talex5)

async/io.ml

@@ -193,10 +193,9 @@ module Make (Fd : Fd) : S with module Fd := Fd = struct
 
   let epoch t =
     match t.state with
-    | Active tls ->
-      (match Tls.Engine.epoch tls with
-       | `InitialEpoch -> assert false (* can never occur! *)
-       | `Epoch data -> Ok data)
+    | Active tls -> (match Tls.Engine.epoch tls with
+       | Ok _ as o -> o
+       | Error () -> Or_error.error_string "no TLS state available yet")
     | Eof -> Or_error.error_string "TLS state is end of file"
     | Error _ -> Or_error.error_string "TLS state is error"
   ;;

eio/tls_eio.ml

@@ -199,11 +199,8 @@ module Raw = struct
 
   let epoch t =
     match t.state with
-    | `Active tls -> ( match Tls.Engine.epoch tls with
-        | `InitialEpoch -> assert false (* can never occur! *)
-        | `Epoch data   -> Ok data )
-    | `Eof      -> Error ()
-    | `Error _  -> Error ()
+    | `Active tls -> Tls.Engine.epoch tls
+    | `Eof | `Error _ -> Error ()
 
   let copy t ~src = Eio.Flow.Pi.simple_copy ~single_write t ~src
 

lib/engine.ml

@@ -735,15 +735,8 @@ let client config =
 
 let server config = new_state Config.(of_server config) `Server
 
-type epoch = [
-  | `InitialEpoch
-  | `Epoch of epoch_data
-]
-
 let epoch state =
-  match epoch_of_hs state.handshake with
-  | None -> `InitialEpoch
-  | Some e -> `Epoch e
+  Option.to_result ~none:() (epoch_of_hs state.handshake)
 
 let export_key_material (e : epoch_data) ?context label length =
   match e.protocol_version with

lib/engine.mli

@@ -188,18 +188,9 @@ val key_update : ?request:bool -> state -> (state * Cstruct.t, failure) result
 
 (** {1 Session information} *)
 
-(** polymorphic variant of session information.  The first variant
-    [`InitialEpoch] will only be used for TLS states without completed
-    handshake.  The second variant, [`Epoch], contains actual session
-    data. *)
-type epoch = [
-  | `InitialEpoch
-  | `Epoch of Core.epoch_data
-]
-
 (** [epoch state] is [epoch], which contains the session
-    information. *)
-val epoch : state -> epoch
+    information. If there's no established session yet, an error is returned. *)
+val epoch : state -> (Core.epoch_data, unit) result
 
 (** [export_key_material epoch_data ?context label length] is the RFC 5705
     exported key material of [length] bytes using [label] and, if provided,

lwt/tls_lwt.ml

@@ -237,11 +237,8 @@ module Unix = struct
 
   let epoch t =
     match t.state with
-    | `Active tls -> ( match Tls.Engine.epoch tls with
-        | `InitialEpoch -> assert false (* can never occur! *)
-        | `Epoch data   -> Ok data )
-    | `Eof      -> Error ()
-    | `Error _  -> Error ()
+    | `Active tls -> Tls.Engine.epoch tls
+    | `Eof | `Error _ -> Error ()
 end
 
 

mirage/tls_mirage.ml

@@ -193,10 +193,7 @@ module Make (F : Mirage_flow.S) = struct
   let epoch flow =
     match flow.state with
     | `Eof | `Error _ -> Error ()
-    | `Active tls     ->
-        match Tls.Engine.epoch tls with
-        | `InitialEpoch -> assert false (* `drain_handshake` invariant. *)
-        | `Epoch e      -> Ok e
+    | `Active tls     -> Tls.Engine.epoch tls
 
 (*   let create_connection t tls_params host (addr, port) =
     |+ XXX addr -> (host : string) +|