Merge pull request #468 from hannesm/split-tls-lwt

update to mirage-crypto 0.11, split tls-lwt away

lib/crypto.ml

@@ -37,22 +37,25 @@ module Ciphers = struct
         K_CBC ( (module CBC : Cipher_block.S.CBC with type key = CBC.key),
                 CBC.of_secret )
 
-  let get_aead ~secret ~nonce =
+  type aead_keyed = | K_AEAD : 'k State.aead_cipher * (Cstruct.t -> 'k) * bool -> aead_keyed
+  let get_aead =
     let open Cipher_block.AES in
     function
     | AES_128_CCM | AES_256_CCM ->
-       let cipher = (module CCM : Cipher_block.S.CCM with type key = CCM.key) in
-       (* TODO the 16 should either be input or extracted from ciphersuite name *)
-       let cipher_secret = CCM.of_secret ~maclen:16 secret in
-       State.(AEAD { cipher = CCM cipher ; cipher_secret ; nonce })
+       K_AEAD ((module CCM16 : AEAD with type key = CCM16.key),
+               CCM16.of_secret, true)
     | AES_128_GCM | AES_256_GCM ->
-       let cipher = (module GCM : Cipher_block.S.GCM with type key = GCM.key) in
-       let cipher_secret = GCM.of_secret secret in
-       State.(AEAD { cipher = GCM cipher ; cipher_secret ; nonce })
+       K_AEAD ((module GCM : AEAD with type key = GCM.key),
+               GCM.of_secret, true)
     | CHACHA20_POLY1305 ->
-      let cipher = (module Chacha20 : AEAD with type key = Chacha20.key) in
-      let cipher_secret = Chacha20.of_secret secret in
-      State.(AEAD { cipher = ChaCha20_Poly1305 cipher ; cipher_secret ; nonce })
+       K_AEAD ((module Chacha20 : AEAD with type key = Chacha20.key),
+               Chacha20.of_secret, false)
+
+  let get_aead_cipher ~secret ~nonce aead_cipher =
+    match get_aead aead_cipher with
+    | K_AEAD (cipher, sec, explicit_nonce) ->
+      let cipher_secret = sec secret in
+      State.(AEAD { cipher ; cipher_secret ; nonce ; explicit_nonce })
 
   let get_cipher ~secret ~hmac_secret ~iv_mode ~nonce = function
     | `Block (cipher, hmac) ->
@@ -62,7 +65,7 @@ module Ciphers = struct
             State.(CBC { cipher ; cipher_secret ; iv_mode ; hmac ; hmac_secret })
        )
 
-    | `AEAD cipher -> get_aead ~secret ~nonce cipher
+    | `AEAD cipher -> get_aead_cipher ~secret ~nonce cipher
 end
 
 let sequence_buf seq =
@@ -138,45 +141,17 @@ let cbc_unpad data =
     if check 0 then Some res else None
   with Invalid_argument _ -> None
 
-let tag_len (type a) = function
-  | State.CCM cipher ->
-    let module C = (val cipher : Cipher_block.S.CCM with type key = a) in
-    (* TODO this is wrong (but works since "16" is always passed in above,
-       which indeed is the AES128/256 block size). There should be a
-       C.tag_size (in CCM this needs to depend on the key though (due to
-       different possible mac sizes), in contrast to GCM where we always have
-       a static one) - maybe mirage-crypto CCM should take mac len as functor
-       argument? *)
-    C.block_size
-  | State.GCM cipher ->
-    let module C = (val cipher : Cipher_block.S.GCM with type key = a) in
-    C.tag_size
-  | State.ChaCha20_Poly1305 _ ->
-    Poly1305.mac_size
+let tag_len (type a) cipher =
+  let module C = (val cipher : AEAD with type key = a) in
+  C.tag_size
 
 let encrypt_aead (type a) ~cipher ~key ~nonce ?adata data =
-  match cipher with
-  | State.CCM cipher ->
-    let module C = (val cipher : Cipher_block.S.CCM with type key = a) in
-    C.authenticate_encrypt ~key ~nonce ?adata data
-  | State.GCM cipher ->
-    let module C = (val cipher : Cipher_block.S.GCM with type key = a) in
-    C.authenticate_encrypt ~key ~nonce ?adata data
-  | State.ChaCha20_Poly1305 cipher ->
-    let module C = (val cipher : AEAD with type key = a) in
-    C.authenticate_encrypt ~key ~nonce ?adata data
+  let module C = (val cipher : AEAD with type key = a) in
+  C.authenticate_encrypt ~key ~nonce ?adata data
 
 let decrypt_aead (type a) ~cipher ~key ~nonce ?adata data =
-  match cipher with
-  | State.CCM cipher ->
-     let module C = (val cipher : Cipher_block.S.CCM with type key = a) in
-     C.authenticate_decrypt ~key ~nonce ?adata data
-  | State.GCM cipher ->
-     let module C = (val cipher : Cipher_block.S.GCM with type key = a) in
-     C.authenticate_decrypt ~key ~nonce ?adata data
-  | State.ChaCha20_Poly1305 cipher ->
-    let module C = (val cipher : AEAD with type key = a) in
-    C.authenticate_decrypt ~key ~nonce ?adata data
+  let module C = (val cipher : AEAD with type key = a) in
+  C.authenticate_decrypt ~key ~nonce ?adata data
 
 let encrypt_cbc (type a) ~cipher ~key ~iv data =
   let module C = (val cipher : Cipher_block.S.CBC with type key = a) in

lib/engine.ml

@@ -159,22 +159,21 @@ let encrypt (version : tls_version) (st : crypto_state) ty buf =
                   (CBC { c with iv_mode = Iv iv' }, m) )
 
           | AEAD c ->
-            match c.cipher with
-            | ChaCha20_Poly1305 _ ->
-              (* RFC 7905: no explicit nonce, instead TLS 1.3 construction is adapted *)
-              let nonce = Crypto.aead_nonce c.nonce ctx.sequence in
-              let msg =
-                Crypto.encrypt_aead ~cipher:c.cipher ~key:c.cipher_secret ~nonce ~adata:pseudo_hdr buf
-              in
-              (AEAD c, msg)
-            | _ ->
+            if c.explicit_nonce then
               let explicit_nonce = Crypto.sequence_buf ctx.sequence in
               let nonce = c.nonce <+> explicit_nonce
               in
               let msg =
                 Crypto.encrypt_aead ~cipher:c.cipher ~key:c.cipher_secret ~nonce ~adata:pseudo_hdr buf
               in
               (AEAD c, explicit_nonce <+> msg)
+            else
+              (* RFC 7905: no explicit nonce, instead TLS 1.3 construction is adapted *)
+              let nonce = Crypto.aead_nonce c.nonce ctx.sequence in
+              let msg =
+                Crypto.encrypt_aead ~cipher:c.cipher ~key:c.cipher_secret ~nonce ~adata:pseudo_hdr buf
+              in
+              (AEAD c, msg)
         in
         (Some { sequence = Int64.succ ctx.sequence ; cipher_st = c_st }, ty, enc)
 
@@ -233,18 +232,7 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
               Ok (CBC c, msg) )
 
     | AEAD c ->
-      match c.cipher with
-      | ChaCha20_Poly1305 _ ->
-        (* RFC 7905: no explicit nonce, instead TLS 1.3 construction is adapted *)
-        let adata =
-          let ver = pair_of_tls_version version in
-          Crypto.pseudo_header seq ty ver (Cstruct.length buf - Crypto.tag_len c.cipher)
-        and nonce = Crypto.aead_nonce c.nonce seq
-        in
-        (match Crypto.decrypt_aead ~adata ~cipher:c.cipher ~key:c.cipher_secret ~nonce buf with
-         | None -> Error (`Fatal `MACMismatch)
-         | Some x -> Ok (AEAD c, x))
-      | _ ->
+      if c.explicit_nonce then
         let explicit_nonce_len = 8 in
         if Cstruct.length buf < explicit_nonce_len then
           Error (`Fatal `MACUnderflow)
@@ -258,6 +246,16 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
           match Crypto.decrypt_aead ~cipher:c.cipher ~key:c.cipher_secret ~nonce ~adata buf with
           | None -> Error (`Fatal `MACMismatch)
           | Some x -> Ok (AEAD c, x)
+      else
+        (* RFC 7905: no explicit nonce, instead TLS 1.3 construction is adapted *)
+        let adata =
+          let ver = pair_of_tls_version version in
+          Crypto.pseudo_header seq ty ver (Cstruct.length buf - Crypto.tag_len c.cipher)
+        and nonce = Crypto.aead_nonce c.nonce seq
+        in
+        (match Crypto.decrypt_aead ~adata ~cipher:c.cipher ~key:c.cipher_secret ~nonce buf with
+         | None -> Error (`Fatal `MACMismatch)
+         | Some x -> Ok (AEAD c, x))
   in
   match st, version with
   | None, _ when ty = Packet.APPLICATION_DATA ->

lib/engine.mli

@@ -67,7 +67,6 @@ type client_hello_errors = [
   | `NotSetCiphersuites of Packet.any_ciphersuite list
   | `NoSupportedCiphersuite of Packet.any_ciphersuite list
   | `NotSetExtension of Core.client_extension list
-  | `HasSignatureAlgorithmsExtension
   | `NoSignatureAlgorithmsExtension
   | `NoGoodSignatureAlgorithms of Core.signature_algorithm list
   | `NoKeyShareExtension

lib/handshake_common.ml

@@ -303,11 +303,7 @@ let client_hello_valid version (ch : client_hello) =
               | _, _, false -> Error (`NotSubsetKeyShareSupportedGroup (gs, ks)) )
         | Some x -> Error (`NoGoodSignatureAlgorithms x)
       )
-    | `SSL_3 | `TLS_1_0 | `TLS_1_1 ->
-      Option.fold
-        ~none:(Error `HasSignatureAlgorithmsExtension)
-        ~some:(fun _ -> Ok ())
-        sig_alg
+    | `SSL_3 | `TLS_1_0 | `TLS_1_1 -> Ok ()
   in
 
   let share_ciphers =

lib/handshake_crypto13.ml

@@ -138,7 +138,7 @@ let ctx t label secret =
   trace (label ^ " secret") secret ;
   trace (label ^ " nonce") nonce ;
   let pp = Ciphersuite.privprot13 t.State.cipher in
-  { State.sequence = 0L ; cipher_st = Crypto.Ciphers.get_aead ~secret ~nonce pp }
+  { State.sequence = 0L ; cipher_st = Crypto.Ciphers.get_aead_cipher ~secret ~nonce pp }
 
 let early_traffic t log =
   let secret = derive_secret t "c e traffic" log in

lib/state.ml

@@ -26,15 +26,13 @@ type 'k cbc_state = {
 
 type nonce = Cstruct.t
 
-type 'k aead_cipher =
-  | CCM of (module Cipher_block.S.CCM with type key = 'k)
-  | GCM of (module Cipher_block.S.GCM with type key = 'k)
-  | ChaCha20_Poly1305 of (module AEAD with type key = 'k)
-
+type 'k aead_cipher = (module AEAD with type key = 'k)
 type 'k aead_state = {
   cipher         : 'k aead_cipher ;
   cipher_secret  : 'k ;
-  nonce          : nonce
+  nonce          : nonce ;
+  explicit_nonce : bool ; (* RFC 7905: no explicit nonce, instead TLS 1.3 construction is adapted *)
+
 }
 
 (* state of a symmetric cipher *)
@@ -239,7 +237,6 @@ type client_hello_errors = [
   | `NotSetCiphersuites of Packet.any_ciphersuite list
   | `NoSupportedCiphersuite of Packet.any_ciphersuite list
   | `NotSetExtension of client_extension list
-  | `HasSignatureAlgorithmsExtension
   | `NoSignatureAlgorithmsExtension
   | `NoGoodSignatureAlgorithms of signature_algorithm list
   | `NoKeyShareExtension

lwt/dune

@@ -1,5 +1,5 @@
 (library
  (name tls_lwt)
- (public_name tls.lwt)
+ (public_name tls-lwt)
  (wrapped false)
- (libraries tls lwt lwt.unix ptime.clock.os mirage-crypto-rng.lwt))
+ (libraries tls lwt lwt.unix ptime.clock.os mirage-crypto-rng-lwt))

lwt/examples/dune

@@ -1,64 +1,64 @@
 (library
  (name ex_common)
- (libraries lwt lwt.unix sexplib tls tls.lwt cmdliner fmt.cli logs.fmt fmt.tty logs.cli)
+ (libraries lwt lwt.unix sexplib tls tls-lwt cmdliner fmt.cli logs.fmt fmt.tty logs.cli)
  (modules ex_common))
 
 (executable
  (name starttls_server)
  (modules starttls_server)
- (libraries tls.lwt lwt.unix))
+ (libraries tls-lwt lwt.unix))
 
 (executable
  (name echo_server)
  (modules echo_server)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name echo_server_sni)
  (modules echo_server_sni)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name echo_server_alpn)
  (modules echo_server_alpn)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name echo_client)
  (modules echo_client)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name echo_client_alpn)
  (modules echo_client_alpn)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name test_server)
  (modules test_server)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name test_client)
  (modules test_client)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name http_client)
  (modules http_client)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name fuzz_server)
  (modules fuzz_server)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name resume_client)
  (modules resume_client)
- (libraries tls.lwt lwt.unix ex_common))
+ (libraries tls-lwt lwt.unix ex_common))
 
 (executable
  (name resume_echo_server)
  (modules resume_echo_server)
- (libraries randomconv tls.lwt lwt.unix ex_common))
+ (libraries randomconv tls-lwt lwt.unix ex_common))

lwt/tls_lwt.ml

@@ -276,7 +276,7 @@ and connect authenticator addr =
   in connect_ext config addr
 
 (* Boot the entropy loop at module init time. *)
-let () = Mirage_crypto_rng_lwt.initialize ()
+let () = Mirage_crypto_rng_lwt.initialize (module Mirage_crypto_rng.Fortuna)
 
 let () =
   Printexc.register_printer (function

tests/key_derivation.ml

@@ -680,5 +680,5 @@ let () =
   Fmt_tty.setup_std_outputs ();
   Logs.set_level (Some Logs.Debug);
   Logs.set_reporter (Logs_fmt.reporter ~dst:Format.std_formatter ()) ;
-  Mirage_crypto_rng_unix.initialize () ;
+  Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna) ;
   Alcotest.run "Key derivation tests" [ "key extraction and derivation", tests ]

tests/testlib.ml

@@ -1,6 +1,6 @@
 open OUnit2
 
-let () = Mirage_crypto_rng_unix.initialize ()
+let () = Mirage_crypto_rng_unix.initialize (module Mirage_crypto_rng.Fortuna)
 
 let time f =
   let t1 = Sys.time () in

tls-lwt.opam

@@ -0,0 +1,42 @@
+opam-version: "2.0"
+homepage:     "https://github.com/mirleft/ocaml-tls"
+dev-repo:     "git+https://github.com/mirleft/ocaml-tls.git"
+bug-reports:  "https://github.com/mirleft/ocaml-tls/issues"
+doc:          "https://mirleft.github.io/ocaml-tls/doc"
+author:       ["David Kaloper <david@numm.org>" "Hannes Mehnert <hannes@mehnert.org>"]
+maintainer:   ["Hannes Mehnert <hannes@mehnert.org>" "David Kaloper <david@numm.org>"]
+license:      "BSD-2-Clause"
+
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
+]
+
+depends: [
+  "ocaml" {>= "4.08.0"}
+  "dune" {>= "3.0"}
+  "tls" {= version}
+  "mirage-crypto-rng-lwt" {>= "0.11.0"}
+  "x509" {>= "0.15.0"}
+  "lwt" {>= "3.0.0"}
+  "cmdliner" {>= "1.1.0"}
+]
+conflicts: [ "result" {< "1.5"} ]
+tags: [ "org:mirage"]
+synopsis: "Transport Layer Security purely in OCaml"
+description: """
+Transport Layer Security (TLS) is probably the most widely deployed security
+protocol on the Internet. It provides communication privacy to prevent
+eavesdropping, tampering, and message forgery. Furthermore, it optionally
+provides authentication of the involved endpoints. TLS is commonly deployed for
+securing web services ([HTTPS](http://tools.ietf.org/html/rfc2818)), emails,
+virtual private networks, and wireless networks.
+
+TLS uses asymmetric cryptography to exchange a symmetric key, and optionally
+authenticate (using X.509) either or both endpoints. It provides algorithmic
+agility, which means that the key exchange method, symmetric encryption
+algorithm, and hash algorithm are negotiated.
+
+Read [further](https://nqsb.io) and our [Usenix Security 2015 paper](https://usenix15.nqsb.io).
+"""

tls.opam

@@ -30,15 +30,12 @@ depends: [
   "fmt" {>= "0.8.7"}
   "cstruct-unix" {with-test & >= "3.0.0"}
   "ounit2" {with-test & >= "2.2.0"}
-  "lwt" {>= "3.0.0"}
-  "ptime" {>= "0.8.1"}
   "hkdf"
   "logs"
   "ipaddr"
   "ipaddr-sexp"
   "alcotest" {with-test}
   "randomconv" {with-test}
-  "cmdliner" {dev & > "1.1.0"}
 ]
 conflicts: [ "result" {< "1.5"} ]
 tags: [ "org:mirage"]