From 2625ccbc5cc3ddf1ffbbe7da99c232467a50bc8b Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 31 Mar 2021 18:51:37 +0200 Subject: [PATCH 1/2] Use mirage-crypto-ec for elliptic curves, instead of hacl_x25519 and fiat This unifies the crypto primitives being used, and adds support for P384 and P521 ECDH. --- lib/config.ml | 6 +-- lib/core.ml | 22 ++++++---- lib/dune | 2 +- lib/engine.ml | 1 + lib/engine.mli | 1 + lib/handshake_client.ml | 37 +++++++++++------ lib/handshake_client13.ml | 63 ++++++++++++++--------------- lib/handshake_crypto13.ml | 85 ++++++++++++++++++++++----------------- lib/handshake_server.ml | 57 ++++++++++++++++++-------- lib/handshake_server13.ml | 8 +--- lib/reader.ml | 2 +- lib/reader.mli | 2 +- lib/state.ml | 17 ++++++-- tests/key_derivation.ml | 8 ++-- tls-mirage.opam | 2 - tls.opam | 3 +- 16 files changed, 188 insertions(+), 128 deletions(-) diff --git a/lib/config.ml b/lib/config.ml index c1974d57..31269241 100644 --- a/lib/config.ml +++ b/lib/config.ml @@ -143,11 +143,11 @@ let min_dh_size = 1024 let min_rsa_key_size = 1024 let supported_groups = - [ `X25519 ; `P256 ; `FFDHE2048 ; `FFDHE3072 ; `FFDHE4096 ; `FFDHE6144 ; `FFDHE8192 ] + [ `X25519 ; `P384 ; `P256 ; `P521 ; `FFDHE2048 ; `FFDHE3072 ; `FFDHE4096 ; `FFDHE6144 ; `FFDHE8192 ] let elliptic_curve = function - | `X25519 | `P256 -> true - | _ -> false + | `X25519 | `P256 | `P384 | `P521 -> true + | `FFDHE2048 | `FFDHE3072 | `FFDHE4096 | `FFDHE6144 | `FFDHE8192 -> false let default_config = { ciphers = Ciphers.default ; diff --git a/lib/core.ml b/lib/core.ml index 1fa642e0..e89b1917 100644 --- a/lib/core.ml +++ b/lib/core.ml @@ -124,6 +124,8 @@ type group = [ | `FFDHE8192 | `X25519 | `P256 + | `P384 + | `P521 ] [@@deriving sexp] let named_group_to_group = function @@ -134,6 +136,8 @@ let named_group_to_group = function | FFDHE8192 -> Some `FFDHE8192 | X25519 -> Some `X25519 | SECP256R1 -> Some `P256 + | SECP384R1 -> Some `P384 + | SECP521R1 -> Some `P521 | _ -> None let group_to_named_group = function @@ -144,15 +148,19 @@ let group_to_named_group = function | `FFDHE8192 -> FFDHE8192 | `X25519 -> X25519 | `P256 -> SECP256R1 + | `P384 -> SECP384R1 + | `P521 -> SECP521R1 let group_to_impl = function - | `FFDHE2048 -> `Mirage_crypto Mirage_crypto_pk.Dh.Group.ffdhe2048 - | `FFDHE3072 -> `Mirage_crypto Mirage_crypto_pk.Dh.Group.ffdhe3072 - | `FFDHE4096 -> `Mirage_crypto Mirage_crypto_pk.Dh.Group.ffdhe4096 - | `FFDHE6144 -> `Mirage_crypto Mirage_crypto_pk.Dh.Group.ffdhe6144 - | `FFDHE8192 -> `Mirage_crypto Mirage_crypto_pk.Dh.Group.ffdhe8192 - | `X25519 -> `Hacl `X25519 - | `P256 -> `Fiat `P256 + | `FFDHE2048 -> `Finite_field Mirage_crypto_pk.Dh.Group.ffdhe2048 + | `FFDHE3072 -> `Finite_field Mirage_crypto_pk.Dh.Group.ffdhe3072 + | `FFDHE4096 -> `Finite_field Mirage_crypto_pk.Dh.Group.ffdhe4096 + | `FFDHE6144 -> `Finite_field Mirage_crypto_pk.Dh.Group.ffdhe6144 + | `FFDHE8192 -> `Finite_field Mirage_crypto_pk.Dh.Group.ffdhe8192 + | `X25519 -> `X25519 + | `P256 -> `P256 + | `P384 -> `P384 + | `P521 -> `P521 type signature_algorithm = [ | `RSA_PKCS1_MD5 diff --git a/lib/dune b/lib/dune index 40289d5c..cda630fb 100644 --- a/lib/dune +++ b/lib/dune @@ -1,5 +1,5 @@ (library (name tls) (public_name tls) - (libraries cstruct cstruct-sexp logs hkdf mirage-crypto mirage-crypto-rng mirage-crypto-pk x509 sexplib domain-name fmt hacl_x25519 fiat-p256) + (libraries cstruct cstruct-sexp logs hkdf mirage-crypto mirage-crypto-rng mirage-crypto-pk x509 sexplib domain-name fmt mirage-crypto-ec) (preprocess (pps ppx_sexp_conv ppx_cstruct))) diff --git a/lib/engine.ml b/lib/engine.ml index 7e4c5445..890a472a 100644 --- a/lib/engine.ml +++ b/lib/engine.ml @@ -49,6 +49,7 @@ let alert_of_fatal = function | `NoVersions _ -> Packet.PROTOCOL_VERSION | `InsufficientDH -> Packet.INSUFFICIENT_SECURITY | `InvalidDH -> Packet.ILLEGAL_PARAMETER + | `BadECDH _ -> Packet.ILLEGAL_PARAMETER | `BadFinished -> Packet.DECRYPT_ERROR | `HandshakeFragmentsNotEmpty -> Packet.HANDSHAKE_FAILURE | `InvalidSession -> Packet.HANDSHAKE_FAILURE diff --git a/lib/engine.mli b/lib/engine.mli index 46ddd8ae..90c0ec07 100644 --- a/lib/engine.mli +++ b/lib/engine.mli @@ -107,6 +107,7 @@ type fatal = [ | `HandshakeFragmentsNotEmpty | `InsufficientDH | `InvalidDH + | `BadECDH of Mirage_crypto_ec.error | `InvalidRenegotiation | `InvalidClientHello of client_hello_errors | `InvalidServerHello diff --git a/lib/handshake_client.ml b/lib/handshake_client.ml index ae82cfda..bce0f32c 100644 --- a/lib/handshake_client.ml +++ b/lib/handshake_client.ml @@ -256,8 +256,7 @@ let answer_server_key_exchange_DHE_RSA state (session : session_data) kex raw lo let to_fatal r = match r with Ok cs -> return cs | Error er -> fail (`Fatal (`ReaderError er)) in (if Ciphersuite.ecc session.ciphersuite then to_fatal (Reader.parse_ec_parameters kex) >|= fun (g, share, raw, left) -> - let g = match g with | `X25519 -> `Hacl `X25519 | `P256 -> `Fiat `P256 in - (g, share, raw, left) + (`Ec g, share, raw, left) else let unpack_dh dh_params = match Crypto.dh_params_unpack dh_params with @@ -268,28 +267,42 @@ let answer_server_key_exchange_DHE_RSA state (session : session_data) kex raw lo unpack_dh dh_params >>= fun (group, shared) -> guard (Mirage_crypto_pk.Dh.modulus_size group >= Config.min_dh_size) (`Fatal `InsufficientDH) >|= fun () -> - (`Mirage_crypto group, shared, raw_dh_params, leftover) + (`Finite_field group, shared, raw_dh_params, leftover) ) >>= fun (group, shared, raw_dh_params, leftover) -> let sigdata = session.common_session_data.client_random <+> session.common_session_data.server_random <+> raw_dh_params in verify_digitally_signed state.protocol_version state.config.signature_algorithms leftover sigdata session.common_session_data.peer_certificate >>= fun () -> - (match group with - | `Mirage_crypto g -> + (let rng = Mirage_crypto_rng.generate in + let open Mirage_crypto_ec in + match group with + | `Finite_field g -> let secret, client_share = Mirage_crypto_pk.Dh.gen_key g in begin match Mirage_crypto_pk.Dh.shared secret shared with | None -> fail (`Fatal `InvalidDH) | Some pms -> return (pms, Writer.assemble_client_dh_key_exchange client_share) end - | `Fiat `P256 -> - let secret, client_share = Fiat_p256.gen_key ~rng:Mirage_crypto_rng.generate in - begin match Fiat_p256.key_exchange secret shared with - | Error _ -> fail (`Fatal `InvalidDH) + | `Ec `P256 -> + let secret, client_share = P256.Dh.gen_key ~rng in + begin match P256.Dh.key_exchange secret shared with + | Error e -> fail (`Fatal (`BadECDH e)) + | Ok pms -> return (pms, Writer.assemble_client_ec_key_exchange client_share) + end + | `Ec `P384 -> + let secret, client_share = P384.Dh.gen_key ~rng in + begin match P384.Dh.key_exchange secret shared with + | Error e -> fail (`Fatal (`BadECDH e)) + | Ok pms -> return (pms, Writer.assemble_client_ec_key_exchange client_share) + end + | `Ec `P521 -> + let secret, client_share = P521.Dh.gen_key ~rng in + begin match P521.Dh.key_exchange secret shared with + | Error e -> fail (`Fatal (`BadECDH e)) | Ok pms -> return (pms, Writer.assemble_client_ec_key_exchange client_share) end - | `Hacl `X25519 -> - let secret, client_share = Hacl_x25519.gen_key ~rng:Mirage_crypto_rng.generate in - begin match Hacl_x25519.key_exchange secret shared with + | `Ec `X25519 -> + let secret, client_share = X25519.gen_key ~rng in + begin match X25519.key_exchange secret shared with | Error _ -> fail (`Fatal `InvalidDH) | Ok pms -> return (pms, Writer.assemble_client_ec_key_exchange client_share) end diff --git a/lib/handshake_client13.ml b/lib/handshake_client13.ml index 3fa1d4e8..915a0699 100644 --- a/lib/handshake_client13.ml +++ b/lib/handshake_client13.ml @@ -21,40 +21,37 @@ let answer_server_hello state ch (sh : server_hello) secrets raw log = match List.find_opt (fun (g', _) -> g = g') secrets with | None -> fail (`Fatal `InvalidServerHello) | Some (_, secret) -> - Handshake_crypto13.share_appropriate_length g share >>= fun () -> - match Handshake_crypto13.dh_shared g secret share with - | None -> fail (`Fatal `InvalidDH) - | Some shared -> - let hlen = Mirage_crypto.Hash.digest_size (Ciphersuite.hash13 cipher) in - (match - map_find ~f:(function `PreSharedKey idx -> Some idx | _ -> None) sh.extensions, - state.config.Config.cached_ticket - with - | None, _ | _, None -> return (Cstruct.create hlen, false) - | Some idx, Some (psk, _epoch) -> - guard (idx = 0) (`Fatal `InvalidServerHello) >|= fun () -> - psk.secret, true) >>= fun (psk, resumed) -> - let early_secret = Handshake_crypto13.(derive (empty cipher) psk) in - let hs_secret = Handshake_crypto13.derive early_secret shared in - let log = log <+> raw in - let server_hs_secret, server_ctx, client_hs_secret, client_ctx = - Handshake_crypto13.hs_ctx hs_secret log in - let master_secret = - Handshake_crypto13.derive hs_secret (Cstruct.create hlen) - in - let session = - let base = empty_session13 cipher in - let common_session_data13 = - { base.common_session_data13 with - server_random = sh.server_random ; - client_random = ch.client_random ; - master_secret = master_secret.secret } - in - { base with master_secret ; common_session_data13 ; resumed } + Handshake_crypto13.dh_shared secret share >>= fun shared -> + let hlen = Mirage_crypto.Hash.digest_size (Ciphersuite.hash13 cipher) in + (match + map_find ~f:(function `PreSharedKey idx -> Some idx | _ -> None) sh.extensions, + state.config.Config.cached_ticket + with + | None, _ | _, None -> return (Cstruct.create hlen, false) + | Some idx, Some (psk, _epoch) -> + guard (idx = 0) (`Fatal `InvalidServerHello) >|= fun () -> + psk.secret, true) >>= fun (psk, resumed) -> + let early_secret = Handshake_crypto13.(derive (empty cipher) psk) in + let hs_secret = Handshake_crypto13.derive early_secret shared in + let log = log <+> raw in + let server_hs_secret, server_ctx, client_hs_secret, client_ctx = + Handshake_crypto13.hs_ctx hs_secret log in + let master_secret = + Handshake_crypto13.derive hs_secret (Cstruct.create hlen) + in + let session = + let base = empty_session13 cipher in + let common_session_data13 = + { base.common_session_data13 with + server_random = sh.server_random ; + client_random = ch.client_random ; + master_secret = master_secret.secret } in - let st = AwaitServerEncryptedExtensions13 (session, server_hs_secret, client_hs_secret, log) in - Ok ({ state with machina = Client13 st ; protocol_version = `TLS_1_3 }, - [ `Change_enc client_ctx ; `Change_dec server_ctx ]) + { base with master_secret ; common_session_data13 ; resumed } + in + let st = AwaitServerEncryptedExtensions13 (session, server_hs_secret, client_hs_secret, log) in + Ok ({ state with machina = Client13 st ; protocol_version = `TLS_1_3 }, + [ `Change_enc client_ctx ; `Change_dec server_ctx ]) (* called from handshake_client.ml *) let answer_hello_retry_request state (ch : client_hello) hrr _secrets raw log = diff --git a/lib/handshake_crypto13.ml b/lib/handshake_crypto13.ml index 5ac086de..d6825942 100644 --- a/lib/handshake_crypto13.ml +++ b/lib/handshake_crypto13.ml @@ -11,55 +11,68 @@ let left_pad_dh group msg = padding <+> msg let not_all_zero = function - | None -> None - | Some cs -> + | Error _ as e -> e + | Ok cs -> let all_zero = Cstruct.create (Cstruct.len cs) in - if Cstruct.equal all_zero cs then None else Some cs - -let share_appropriate_length group share = - match Core.group_to_impl group with - | `Hacl `X25519 -> Ok () (* already checked by hacl_x25519.key_exchange *) - | `Fiat `P256 -> Ok () (* already checked by fiat_p256.key_exchange *) - | `Mirage_crypto group -> - let bits = Mirage_crypto_pk.Dh.modulus_size group in - if Cstruct.len share = cdiv bits 8 then - Ok () - else (* truncated share, better reject this *) + if Cstruct.equal all_zero cs then Error (`Fatal `InvalidDH) + else + Ok cs -let dh_shared group secret share = +let dh_shared secret share = (* RFC 8556, Section 7.4.1 - we need zero-padding on the left *) not_all_zero - (match Core.group_to_impl group, secret with - | `Mirage_crypto mc_group, `Mirage_crypto secret -> - begin match Mirage_crypto_pk.Dh.shared secret share with - | None -> None - | Some shared -> Some (left_pad_dh mc_group shared) + (match secret with + | `Finite_field secret -> + let group = secret.Mirage_crypto_pk.Dh.group in + let bits = Mirage_crypto_pk.Dh.modulus_size group in + if Cstruct.len share = cdiv bits 8 then + begin match Mirage_crypto_pk.Dh.shared secret share with + | None -> Error (`Fatal `InvalidDH) + | Some shared -> Ok (left_pad_dh group shared) + end + else (* truncated share, better reject this *) + Error (`Fatal `InvalidDH) + | `P256 priv -> + begin match Mirage_crypto_ec.P256.Dh.key_exchange priv share with + | Error e -> Error (`Fatal (`BadECDH e)) + | Ok shared -> Ok shared end - | `Hacl `X25519, `Hacl priv -> - begin match Hacl_x25519.key_exchange priv share with - | Error _ -> None - | Ok shared -> Some shared + | `P384 priv -> + begin match Mirage_crypto_ec.P384.Dh.key_exchange priv share with + | Error e -> Error (`Fatal (`BadECDH e)) + | Ok shared -> Ok shared end - | `Fiat `P256, `Fiat priv -> - begin match Fiat_p256.key_exchange priv share with - | Error _ -> None - | Ok shared -> Some shared + | `P521 priv -> + begin match Mirage_crypto_ec.P521.Dh.key_exchange priv share with + | Error e -> Error (`Fatal (`BadECDH e)) + | Ok shared -> Ok shared end - | _ -> None) + | `X25519 priv -> + begin match Mirage_crypto_ec.X25519.key_exchange priv share with + | Error e -> Error (`Fatal (`BadECDH e)) + | Ok shared -> Ok shared + end) let dh_gen_key group = (* RFC 8556, Section 4.2.8.1 - we need zero-padding on the left *) + let rng = Mirage_crypto_rng.generate in match Core.group_to_impl group with - | `Mirage_crypto mc_group -> + | `Finite_field mc_group -> let sec, shared = Mirage_crypto_pk.Dh.gen_key mc_group in - `Mirage_crypto sec, left_pad_dh mc_group shared - | `Hacl `X25519 -> - let secret, shared = Hacl_x25519.gen_key ~rng:Mirage_crypto_rng.generate in - `Hacl secret, shared - | `Fiat `P256 -> - let secret, shared = Fiat_p256.gen_key ~rng:Mirage_crypto_rng.generate in - `Fiat secret, shared + `Finite_field sec, left_pad_dh mc_group shared + | `P256 -> + let secret, shared = Mirage_crypto_ec.P256.Dh.gen_key ~rng in + `P256 secret, shared + | `P384 -> + let secret, shared = Mirage_crypto_ec.P384.Dh.gen_key ~rng in + `P384 secret, shared + | `P521 -> + let secret, shared = Mirage_crypto_ec.P521.Dh.gen_key ~rng in + `P521 secret, shared + | `X25519 -> + let secret, shared = Mirage_crypto_ec.X25519.gen_key ~rng in + `X25519 secret, shared let trace tag cs = Tracing.cs ~tag:("crypto " ^ tag) cs diff --git a/lib/handshake_server.ml b/lib/handshake_server.ml index 5ab2bc89..0676741a 100644 --- a/lib/handshake_server.ml +++ b/lib/handshake_server.ml @@ -132,20 +132,33 @@ let answer_client_key_exchange_RSA state (session : session_data) kex raw log = let answer_client_key_exchange_DHE_RSA state session secret kex raw log = let to_fatal r = match r with Ok cs -> return cs | Error er -> fail (`Fatal (`ReaderError er)) in - (match secret with - | `Fiat priv -> + (let open Mirage_crypto_ec in + match secret with + | `P256 priv -> to_fatal (Reader.parse_client_ec_key_exchange kex) >>= fun share -> - begin match Fiat_p256.key_exchange priv share with - | Error _ -> fail (`Fatal `InvalidDH) + begin match P256.Dh.key_exchange priv share with + | Error e -> fail (`Fatal (`BadECDH e)) | Ok shared -> return shared end - | `Hacl priv -> + | `P384 priv -> to_fatal (Reader.parse_client_ec_key_exchange kex) >>= fun share -> - begin match Hacl_x25519.key_exchange priv share with - | Error _ -> fail (`Fatal `InvalidDH) + begin match P384.Dh.key_exchange priv share with + | Error e -> fail (`Fatal (`BadECDH e)) | Ok shared -> return shared end - | `Mirage_crypto secret -> + | `P521 priv -> + to_fatal (Reader.parse_client_ec_key_exchange kex) >>= fun share -> + begin match P521.Dh.key_exchange priv share with + | Error e -> fail (`Fatal (`BadECDH e)) + | Ok shared -> return shared + end + | `X25519 priv -> + to_fatal (Reader.parse_client_ec_key_exchange kex) >>= fun share -> + begin match X25519.key_exchange priv share with + | Error e -> fail (`Fatal (`BadECDH e)) + | Ok shared -> return shared + end + | `Finite_field secret -> to_fatal (Reader.parse_client_dh_key_exchange kex) >>= fun share -> begin match Mirage_crypto_pk.Dh.shared secret share with | None -> fail (`Fatal `InvalidDH) @@ -315,20 +328,30 @@ let answer_client_hello_common state reneg ch raw = (match session.group with | None -> fail (`Fatal `UnsupportedKeyExchange) (* should not happen *) | Some g -> + let rng = Mirage_crypto_rng.generate in + let open Mirage_crypto_ec in match group_to_impl g with - | `Mirage_crypto g -> + | `Finite_field g -> let (secret, msg) = Mirage_crypto_pk.Dh.gen_key g in let dh_param = Crypto.dh_params_pack g msg in let dh_params = Writer.assemble_dh_parameters dh_param in - return (`Mirage_crypto secret, dh_params) - | `Hacl `X25519 -> - let secret, shared = Hacl_x25519.gen_key ~rng:Mirage_crypto_rng.generate in - let params = Writer.assemble_ec_parameters `X25519 shared in - return (`Hacl secret, params) - | `Fiat `P256 -> - let secret, shared = Fiat_p256.gen_key ~rng:Mirage_crypto_rng.generate in + return (`Finite_field secret, dh_params) + | `P256 -> + let secret, shared = P256.Dh.gen_key ~rng in let params = Writer.assemble_ec_parameters `P256 shared in - return (`Fiat secret, params) + return (`P256 secret, params) + | `P384 -> + let secret, shared = P384.Dh.gen_key ~rng in + let params = Writer.assemble_ec_parameters `P384 shared in + return (`P384 secret, params) + | `P521 -> + let secret, shared = P521.Dh.gen_key ~rng in + let params = Writer.assemble_ec_parameters `P521 shared in + return (`P521 secret, params) + | `X25519 -> + let secret, shared = X25519.gen_key ~rng in + let params = Writer.assemble_ec_parameters `X25519 shared in + return (`X25519 secret, params) ) >>= fun (secret, written) -> let data = session.common_session_data.client_random <+> session.common_session_data.server_random <+> written in private_key session >>= fun priv -> diff --git a/lib/handshake_server13.ml b/lib/handshake_server13.ml index ab283f67..a0b6d770 100644 --- a/lib/handshake_server13.ml +++ b/lib/handshake_server13.ml @@ -30,9 +30,7 @@ let answer_client_hello ~hrr state ch raw = let f acc (g, ks) = match Core.named_group_to_group g with | None -> Ok acc - | Some g -> - Handshake_crypto13.share_appropriate_length g ks >|= fun () -> - (g, ks) :: acc + | Some g -> Ok ((g, ks) :: acc) in foldM f [] ks ) >>= fun keyshares -> @@ -200,9 +198,7 @@ let answer_client_hello ~hrr state ch raw = let _, early_traffic_ctx = Handshake_crypto13.early_traffic early_secret raw in let secret, public = Handshake_crypto13.dh_gen_key group in - (match Handshake_crypto13.dh_shared group secret keyshare with - | None -> fail (`Fatal `InvalidDH) - | Some shared -> return shared) >>= fun es -> + Handshake_crypto13.dh_shared secret keyshare >>= fun es -> let hs_secret = Handshake_crypto13.derive early_secret es in Tracing.cs ~tag:"hs secret" hs_secret.secret ; diff --git a/lib/reader.ml b/lib/reader.ml index 2e8e7799..fefadc3b 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -718,7 +718,7 @@ let parse_ec_parameters = catch @@ fun raw -> match int_to_named_group (BE.get_uint16 raw 1) with | Some g -> begin match named_group_to_group g with - | Some ((`X25519 | `P256) as g) -> + | Some ((`X25519 | `P256 | `P384 | `P521) as g) -> let data_len = get_uint8 raw 3 in let d, rest = split (shift raw 4) data_len in g, d, sub raw 0 (data_len + 4), rest diff --git a/lib/reader.mli b/lib/reader.mli index 743f061d..828bbeb0 100644 --- a/lib/reader.mli +++ b/lib/reader.mli @@ -38,6 +38,6 @@ val parse_client_dh_key_exchange : Cstruct.t -> Cstruct.t result val parse_client_ec_key_exchange : Cstruct.t -> Cstruct.t result val parse_dh_parameters : Cstruct.t -> (Core.dh_parameters * Cstruct.t * Cstruct.t) result -val parse_ec_parameters : Cstruct.t -> ([ `X25519 | `P256 ] * Cstruct.t * Cstruct.t * Cstruct.t) result +val parse_ec_parameters : Cstruct.t -> ([ `X25519 | `P256 | `P384 | `P521 ] * Cstruct.t * Cstruct.t * Cstruct.t) result val parse_digitally_signed : Cstruct.t -> Cstruct.t result val parse_digitally_signed_1_2 : Cstruct.t -> (Core.signature_algorithm * Cstruct.t) result diff --git a/lib/state.ml b/lib/state.ml index acb6c0a4..cc44d06a 100644 --- a/lib/state.ml +++ b/lib/state.ml @@ -61,9 +61,11 @@ type crypto_context = { type hs_log = Cstruct_sexp.t list [@@deriving sexp] type dh_secret = [ - | `Fiat of Fiat_p256.secret - | `Hacl of Hacl_x25519.secret - | `Mirage_crypto of Mirage_crypto_pk.Dh.secret + | `Finite_field of Mirage_crypto_pk.Dh.secret + | `P256 of Mirage_crypto_ec.P256.Dh.secret + | `P384 of Mirage_crypto_ec.P384.Dh.secret + | `P521 of Mirage_crypto_ec.P521.Dh.secret + | `X25519 of Mirage_crypto_ec.X25519.secret ] let sexp_of_dh_secret _ = Sexp.Atom "dh_secret" let dh_secret_of_sexp = Conv.of_sexp_error "dh_secret_of_sexp: not implemented" @@ -217,6 +219,14 @@ module V_err = struct Sexplib.Sexp.Atom s end +module Ec_err = struct + type t = Mirage_crypto_ec.error + let t_of_sexp _ = failwith "couldn't convert validatin error from sexp" + let sexp_of_t v = + let s = Fmt.to_to_string Mirage_crypto_ec.pp_error v in + Sexplib.Sexp.Atom s +end + type error = [ | `AuthenticationFailure of V_err.t | `NoConfiguredCiphersuite of Ciphersuite.ciphersuite list @@ -271,6 +281,7 @@ type fatal = [ | `HandshakeFragmentsNotEmpty | `InsufficientDH | `InvalidDH + | `BadECDH of Ec_err.t | `InvalidRenegotiation | `InvalidClientHello of client_hello_errors | `InvalidServerHello diff --git a/tests/key_derivation.ml b/tests/key_derivation.ml index a11cd5ad..9c612fc3 100644 --- a/tests/key_derivation.ml +++ b/tests/key_derivation.ml @@ -633,12 +633,12 @@ c9 82 88 76 11 20 95 fe 66 76 2b db f7 c6 72 e1 |} in let check_pub pr pu = - let _priv, pub = Hacl_x25519.gen_key ~rng:(fun _ -> pr) in + let _priv, pub = Mirage_crypto_ec.X25519.gen_key ~rng:(fun _ -> pr) in Alcotest.check cs __LOC__ pu pub in let check_one p ks = - let priv, _pub = Hacl_x25519.gen_key ~rng:(fun _ -> p) in - match Hacl_x25519.key_exchange priv ks with + let priv, _pub = Mirage_crypto_ec.X25519.gen_key ~rng:(fun _ -> p) in + match Mirage_crypto_ec.X25519.key_exchange priv ks with | Ok shared -> Alcotest.check cs __LOC__ ikm shared | Error _ -> Alcotest.fail "bad kex" in @@ -656,7 +656,7 @@ let tests = [ "derive finished", `Quick, derive_finished ; "derive master", `Quick, derive_master ; "extract master", `Quick, extract_master ; - "derive hanshake keys", `Quick, derive_write_handshake_keys ; + "derive handshake keys", `Quick, derive_write_handshake_keys ; "derive traffic keys", `Quick, derive_traffic_keys ; "application write keys", `Quick, appdata_write ; "application read keys", `Quick, appdata_read ; diff --git a/tls-mirage.opam b/tls-mirage.opam index 3d9598ed..2b507ac2 100644 --- a/tls-mirage.opam +++ b/tls-mirage.opam @@ -26,8 +26,6 @@ depends: [ "ptime" {>= "0.8.1"} "mirage-crypto" "mirage-crypto-pk" - "hacl_x25519" {>= "0.1.1"} - "fiat-p256" {>= "0.2.1"} ] tags: [ "org:mirage"] synopsis: "Transport Layer Security purely in OCaml, MirageOS layer" diff --git a/tls.opam b/tls.opam index c371ede8..c2f38ce2 100644 --- a/tls.opam +++ b/tls.opam @@ -31,8 +31,7 @@ depends: [ "ounit2" {with-test & >= "2.2.0"} "lwt" {>= "3.0.0"} "ptime" {>= "0.8.1"} - "hacl_x25519" - "fiat-p256" + "mirage-crypto-ec" "hkdf" "logs" "alcotest" {with-test} From 3f1f866aea251187264e7a3b245b8b2510004a83 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Tue, 13 Apr 2021 10:41:03 +0200 Subject: [PATCH 2/2] ECDSA and EdDSA support --- certificates/server-ec.key | 5 + certificates/server-ec.pem | 14 ++ lib/ciphersuite.ml | 157 +++++++++----- lib/config.ml | 353 +++++++++++++++++++++++++------ lib/config.mli | 2 +- lib/core.ml | 57 ++++- lib/crypto.ml | 3 - lib/engine.ml | 5 +- lib/engine.mli | 5 +- lib/handshake_client.ml | 88 +++----- lib/handshake_common.ml | 344 ++++++++++++++++++++++-------- lib/handshake_crypto.ml | 4 +- lib/handshake_server.ml | 106 ++++++---- lib/handshake_server13.ml | 14 +- lib/packet.ml | 14 +- lib/state.ml | 15 +- lwt/examples/ex_common.ml | 2 + lwt/examples/test_server.ml | 6 +- lwt/tls_lwt.mli | 2 +- lwt/x509_lwt.ml | 6 +- lwt/x509_lwt.mli | 10 +- mirage/tls_mirage.ml | 2 +- mirage/tls_mirage.mli | 2 +- tests/interop-openssl-sclient.sh | 5 +- tests/interop-openssl-sserver.sh | 51 ++++- tests/key_derivation.ml | 3 +- tls.opam | 4 +- 27 files changed, 917 insertions(+), 362 deletions(-) create mode 100644 certificates/server-ec.key create mode 100644 certificates/server-ec.pem diff --git a/certificates/server-ec.key b/certificates/server-ec.key new file mode 100644 index 00000000..847e5426 --- /dev/null +++ b/certificates/server-ec.key @@ -0,0 +1,5 @@ +-----BEGIN PRIVATE KEY----- +MGACAQAwEAYHKoZIzj0CAQYFK4EEACMESTBHAgEBBEIAtmFgIVel9k9Ivp7S5Mlc +adxdv3KvDHc1j787n4avTUpzk+Aj7g0zxen7UsBOk2q/EGbZbtVFsO4zdOvPqP1+ +m94= +-----END PRIVATE KEY----- diff --git a/certificates/server-ec.pem b/certificates/server-ec.pem new file mode 100644 index 00000000..dedae9f2 --- /dev/null +++ b/certificates/server-ec.pem @@ -0,0 +1,14 @@ +-----BEGIN CERTIFICATE----- +MIICDDCCAW+gAwIBAgIIQcOa7kqxp9cwCgYIKoZIzj0EAwQwFjEUMBIGA1UEAwwL +ZXhhbXBsZS5jb20wHhcNMjEwNDA0MTcwMTU3WhcNMjIwNDA0MTcwMTU3WjAWMRQw +EgYDVQQDDAtleGFtcGxlLmNvbTCBmzAQBgcqhkjOPQIBBgUrgQQAIwOBhgAEAXIK +VyKRhKOJjxXQtKJiTX9nM3lZs6qy632NYmG9BwJ74FidW1NYlT0eiN71nMHU9FOH +BZ76AH0ISrbo3hjG7uFzAPMplhTwTlA7IcQoR8FOGjrN0w+H5YJZRtkfYU0hFETU +F4quomVmbrxtcIgFRWLJdf7qciYYJyYc8ZlTZoHpZY02o2QwYjAdBgNVHQ4EFgQU +nku+GxZTewB6/D2bJFQcOkBN4QMwDwYDVR0PAQH/BAUDAwfGADAPBgNVHRMBAf8E +BTADAQH/MB8GA1UdIwQYMBaAFJ5LvhsWU3sAevw9myRUHDpATeEDMAoGCCqGSM49 +BAMEA4GKADCBhgJBfZBX4o5Df/fJUnzmQKo6KFFWlc70VkO3hXH6lUhVRLcT+Ame +6gJUjgYy65GryW4Tx/pFTI7tdX19UDm+kBvgv1sCQRIgxgt/eJ74VsRgt7Br3Smm +px1uULyS4PIGBKT4O4C4bWS1wdzw8ZOlegss1+pkxYYrfJFNJYyBaqY0ScTpvE4F +-----END CERTIFICATE----- +---- diff --git a/lib/ciphersuite.ml b/lib/ciphersuite.ml index fec59adc..072f367d 100644 --- a/lib/ciphersuite.ml +++ b/lib/ciphersuite.ml @@ -1,13 +1,13 @@ (** Ciphersuite definitions and some helper functions. *) (** sum type of all possible key exchange methods *) -type key_exchange_algorithm13 = [ `DHE_RSA ] [@@deriving sexp] -type key_exchange_algorithm = [ key_exchange_algorithm13 | `RSA ] [@@deriving sexp] +type key_exchange_algorithm_dhe = [ `FFDHE | `ECDHE ] [@@deriving sexp] +type key_exchange_algorithm = [ key_exchange_algorithm_dhe | `RSA ] [@@deriving sexp] -(** [required_keytype_and_usage kex] is [(keytype, usage)] which a certificate must have if it is used in the given [kex] method *) -let required_keytype_and_usage = function - | `RSA -> (`RSA, `Key_encipherment) - | `DHE_RSA -> (`RSA, `Digital_signature) (* signing with the signature scheme and hash algorithm that will be employed in the server key exchange message. *) +(** [required_usage kex] is [usage] which a certificate must have if it is used in the given [kex] method *) +let required_usage = function + | #key_exchange_algorithm_dhe -> `Digital_signature + | `RSA -> `Key_encipherment type block_cipher = | TRIPLE_DES_EDE_CBC @@ -99,7 +99,7 @@ let any_ciphersuite_to_ciphersuite13 = function | Packet.TLS_AES_256_GCM_SHA384 -> Some `AES_256_GCM_SHA384 | Packet.TLS_CHACHA20_POLY1305_SHA256 -> Some `CHACHA20_POLY1305_SHA256 | Packet.TLS_AES_128_CCM_SHA256 -> Some `AES_128_CCM_SHA256 - | _ -> None + | _ -> None type ciphersuite = [ ciphersuite13 @@ -130,6 +130,14 @@ type ciphersuite = [ | `RSA_WITH_AES_256_GCM_SHA384 | `RSA_WITH_AES_256_CCM | `RSA_WITH_AES_128_CCM + | `ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA + | `ECDHE_ECDSA_WITH_AES_128_CBC_SHA + | `ECDHE_ECDSA_WITH_AES_256_CBC_SHA + | `ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 + | `ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 + | `ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 + | `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 + | `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 ] [@@deriving sexp] let ciphersuite_to_ciphersuite13 : ciphersuite -> ciphersuite13 option = function @@ -164,6 +172,14 @@ let any_ciphersuite_to_ciphersuite = function | Packet.TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA -> Some `ECDHE_RSA_WITH_3DES_EDE_CBC_SHA | Packet.TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 -> Some `ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 | Packet.TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 -> Some `DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 + | Packet.TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA -> Some `ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA + | Packet.TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA -> Some `ECDHE_ECDSA_WITH_AES_128_CBC_SHA + | Packet.TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA -> Some `ECDHE_ECDSA_WITH_AES_256_CBC_SHA + | Packet.TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 -> Some `ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 + | Packet.TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 -> Some `ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 + | Packet.TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 -> Some `ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 + | Packet.TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 -> Some `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 + | Packet.TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 -> Some `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 | x -> any_ciphersuite_to_ciphersuite13 x let ciphersuite_to_any_ciphersuite = function @@ -198,61 +214,92 @@ let ciphersuite_to_any_ciphersuite = function | `AES_256_GCM_SHA384 -> Packet.TLS_AES_256_GCM_SHA384 | `CHACHA20_POLY1305_SHA256 -> Packet.TLS_CHACHA20_POLY1305_SHA256 | `AES_128_CCM_SHA256 -> Packet.TLS_AES_128_CCM_SHA256 + | `ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA -> Packet.TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA + | `ECDHE_ECDSA_WITH_AES_128_CBC_SHA -> Packet.TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA + | `ECDHE_ECDSA_WITH_AES_256_CBC_SHA -> Packet.TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA + | `ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 -> Packet.TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 + | `ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 -> Packet.TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 + | `ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 -> Packet.TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 + | `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 -> Packet.TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 + | `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 -> Packet.TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 let ciphersuite_to_string x = Packet.any_ciphersuite_to_string (ciphersuite_to_any_ciphersuite x) (** [get_kex_privprot ciphersuite] is [(kex, privacy_protection)] where it dissects the [ciphersuite] into a pair containing the key exchange method [kex], and its [privacy_protection] *) -let get_kex_privprot = function - | `RSA_WITH_3DES_EDE_CBC_SHA -> (`RSA , `Block (TRIPLE_DES_EDE_CBC, `SHA1)) - | `DHE_RSA_WITH_3DES_EDE_CBC_SHA -> (`DHE_RSA, `Block (TRIPLE_DES_EDE_CBC, `SHA1)) - | `RSA_WITH_AES_128_CBC_SHA -> (`RSA , `Block (AES_128_CBC, `SHA1)) - | `DHE_RSA_WITH_AES_128_CBC_SHA -> (`DHE_RSA, `Block (AES_128_CBC, `SHA1)) - | `RSA_WITH_AES_256_CBC_SHA -> (`RSA , `Block (AES_256_CBC, `SHA1)) - | `DHE_RSA_WITH_AES_256_CBC_SHA -> (`DHE_RSA, `Block (AES_256_CBC, `SHA1)) - | `RSA_WITH_AES_128_CBC_SHA256 -> (`RSA , `Block (AES_128_CBC, `SHA256)) - | `RSA_WITH_AES_256_CBC_SHA256 -> (`RSA , `Block (AES_256_CBC, `SHA256)) - | `DHE_RSA_WITH_AES_128_CBC_SHA256 -> (`DHE_RSA, `Block (AES_128_CBC, `SHA256)) - | `DHE_RSA_WITH_AES_256_CBC_SHA256 -> (`DHE_RSA, `Block (AES_256_CBC, `SHA256)) - | `RSA_WITH_AES_128_CCM -> (`RSA , `AEAD AES_128_CCM) - | `RSA_WITH_AES_256_CCM -> (`RSA , `AEAD AES_256_CCM) - | `DHE_RSA_WITH_AES_128_CCM -> (`DHE_RSA, `AEAD AES_128_CCM) - | `DHE_RSA_WITH_AES_256_CCM -> (`DHE_RSA, `AEAD AES_256_CCM) - | `RSA_WITH_AES_128_GCM_SHA256 -> (`RSA , `AEAD AES_128_GCM) - | `RSA_WITH_AES_256_GCM_SHA384 -> (`RSA , `AEAD AES_256_GCM) - | `DHE_RSA_WITH_AES_128_GCM_SHA256 -> (`DHE_RSA, `AEAD AES_128_GCM) - | `DHE_RSA_WITH_AES_256_GCM_SHA384 -> (`DHE_RSA, `AEAD AES_256_GCM) - | `ECDHE_RSA_WITH_AES_128_GCM_SHA256 -> (`DHE_RSA, `AEAD AES_128_GCM) - | `ECDHE_RSA_WITH_AES_256_GCM_SHA384 -> (`DHE_RSA, `AEAD AES_256_GCM) - | `ECDHE_RSA_WITH_AES_256_CBC_SHA384 -> (`DHE_RSA, `Block (AES_256_CBC, `SHA384)) - | `ECDHE_RSA_WITH_AES_128_CBC_SHA256 -> (`DHE_RSA, `Block (AES_128_CBC, `SHA256)) - | `ECDHE_RSA_WITH_AES_256_CBC_SHA -> (`DHE_RSA, `Block (AES_256_CBC, `SHA1)) - | `ECDHE_RSA_WITH_AES_128_CBC_SHA -> (`DHE_RSA, `Block (AES_128_CBC, `SHA1)) - | `ECDHE_RSA_WITH_3DES_EDE_CBC_SHA -> (`DHE_RSA, `Block (TRIPLE_DES_EDE_CBC, `SHA1)) - | `DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 -> (`DHE_RSA, `AEAD CHACHA20_POLY1305) - | `ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 -> (`DHE_RSA, `AEAD CHACHA20_POLY1305) - | #ciphersuite13 as cs13 -> (`DHE_RSA, `AEAD (privprot13 cs13)) +let get_keytype_kex_privprot = function + | `RSA_WITH_3DES_EDE_CBC_SHA -> (`RSA, `RSA, `Block (TRIPLE_DES_EDE_CBC, `SHA1)) + | `DHE_RSA_WITH_3DES_EDE_CBC_SHA -> (`RSA, `FFDHE, `Block (TRIPLE_DES_EDE_CBC, `SHA1)) + | `RSA_WITH_AES_128_CBC_SHA -> (`RSA, `RSA, `Block (AES_128_CBC, `SHA1)) + | `DHE_RSA_WITH_AES_128_CBC_SHA -> (`RSA, `FFDHE, `Block (AES_128_CBC, `SHA1)) + | `RSA_WITH_AES_256_CBC_SHA -> (`RSA, `RSA, `Block (AES_256_CBC, `SHA1)) + | `DHE_RSA_WITH_AES_256_CBC_SHA -> (`RSA, `FFDHE, `Block (AES_256_CBC, `SHA1)) + | `RSA_WITH_AES_128_CBC_SHA256 -> (`RSA, `RSA, `Block (AES_128_CBC, `SHA256)) + | `RSA_WITH_AES_256_CBC_SHA256 -> (`RSA, `RSA, `Block (AES_256_CBC, `SHA256)) + | `DHE_RSA_WITH_AES_128_CBC_SHA256 -> (`RSA, `FFDHE, `Block (AES_128_CBC, `SHA256)) + | `DHE_RSA_WITH_AES_256_CBC_SHA256 -> (`RSA, `FFDHE, `Block (AES_256_CBC, `SHA256)) + | `RSA_WITH_AES_128_CCM -> (`RSA, `RSA, `AEAD AES_128_CCM) + | `RSA_WITH_AES_256_CCM -> (`RSA, `RSA, `AEAD AES_256_CCM) + | `DHE_RSA_WITH_AES_128_CCM -> (`RSA, `FFDHE, `AEAD AES_128_CCM) + | `DHE_RSA_WITH_AES_256_CCM -> (`RSA, `FFDHE, `AEAD AES_256_CCM) + | `RSA_WITH_AES_128_GCM_SHA256 -> (`RSA, `RSA, `AEAD AES_128_GCM) + | `RSA_WITH_AES_256_GCM_SHA384 -> (`RSA, `RSA, `AEAD AES_256_GCM) + | `DHE_RSA_WITH_AES_128_GCM_SHA256 -> (`RSA, `FFDHE, `AEAD AES_128_GCM) + | `DHE_RSA_WITH_AES_256_GCM_SHA384 -> (`RSA, `FFDHE, `AEAD AES_256_GCM) + | `ECDHE_RSA_WITH_AES_128_GCM_SHA256 -> (`RSA, `ECDHE, `AEAD AES_128_GCM) + | `ECDHE_RSA_WITH_AES_256_GCM_SHA384 -> (`RSA, `ECDHE, `AEAD AES_256_GCM) + | `ECDHE_RSA_WITH_AES_256_CBC_SHA384 -> (`RSA, `ECDHE, `Block (AES_256_CBC, `SHA384)) + | `ECDHE_RSA_WITH_AES_128_CBC_SHA256 -> (`RSA, `ECDHE, `Block (AES_128_CBC, `SHA256)) + | `ECDHE_RSA_WITH_AES_256_CBC_SHA -> (`RSA, `ECDHE, `Block (AES_256_CBC, `SHA1)) + | `ECDHE_RSA_WITH_AES_128_CBC_SHA -> (`RSA, `ECDHE, `Block (AES_128_CBC, `SHA1)) + | `ECDHE_RSA_WITH_3DES_EDE_CBC_SHA -> (`RSA, `ECDHE, `Block (TRIPLE_DES_EDE_CBC, `SHA1)) + | `DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 -> (`RSA, `FFDHE, `AEAD CHACHA20_POLY1305) + | `ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 -> (`RSA, `ECDHE, `AEAD CHACHA20_POLY1305) + | `ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA -> (`EC, `ECDHE, `Block (TRIPLE_DES_EDE_CBC, `SHA1)) + | `ECDHE_ECDSA_WITH_AES_128_CBC_SHA -> (`EC, `ECDHE, `Block (AES_128_CBC, `SHA1)) + | `ECDHE_ECDSA_WITH_AES_256_CBC_SHA -> (`EC, `ECDHE, `Block (AES_256_CBC, `SHA1)) + | `ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 -> (`EC, `ECDHE, `Block (AES_128_CBC, `SHA256)) + | `ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 -> (`EC, `ECDHE, `Block (AES_256_CBC, `SHA384)) + | `ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 -> (`EC, `ECDHE, `AEAD AES_128_GCM) + | `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 -> (`EC, `ECDHE, `AEAD AES_256_GCM) + | `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 -> (`EC, `ECDHE, `AEAD CHACHA20_POLY1305) + | #ciphersuite13 as cs13 -> (`RSA, `FFDHE, `AEAD (privprot13 cs13)) (* this is mostly wrong *) (** [ciphersuite_kex ciphersuite] is [kex], first projection of [get_kex_privprot] *) -let ciphersuite_kex c = fst (get_kex_privprot c) +let ciphersuite_kex c = + let _keytype, kex, _pp = get_keytype_kex_privprot c in + kex (** [ciphersuite_privprot ciphersuite] is [privprot], second projection of [get_kex_privprot] *) -let ciphersuite_privprot c = snd (get_kex_privprot c) +let ciphersuite_privprot c = + let _keytype, _kex, pp = get_keytype_kex_privprot c in + pp + +let ciphersuite_keytype c = + let keytype, _kex, _pp = get_keytype_kex_privprot c in + keytype let ciphersuite_fs cs = match ciphersuite_kex cs with - | `DHE_RSA -> true + | #key_exchange_algorithm_dhe -> true | `RSA -> false -let ecc = function - | `ECDHE_RSA_WITH_AES_256_CBC_SHA - | `ECDHE_RSA_WITH_AES_128_CBC_SHA - | `ECDHE_RSA_WITH_3DES_EDE_CBC_SHA - | `ECDHE_RSA_WITH_AES_128_GCM_SHA256 - | `ECDHE_RSA_WITH_AES_256_GCM_SHA384 - | `ECDHE_RSA_WITH_AES_256_CBC_SHA384 - | `ECDHE_RSA_WITH_AES_128_CBC_SHA256 - | `ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 -> true - | _ -> false +let ecdhe_only = function + | #ciphersuite13 -> false + | cs -> match get_keytype_kex_privprot cs with + | (_, `ECDHE, _) -> true + | _ -> false + +let dhe_only = function + | #ciphersuite13 -> false + | cs -> match get_keytype_kex_privprot cs with + | (_, `FFDHE, _) -> true + | _ -> false + +let ecdhe = function + | #ciphersuite13 -> true + | cs -> match get_keytype_kex_privprot cs with + | (_, `ECDHE, _) -> true + | _ -> false let ciphersuite_tls12_only = function | `DHE_RSA_WITH_AES_256_CBC_SHA256 @@ -272,12 +319,14 @@ let ciphersuite_tls12_only = function | `ECDHE_RSA_WITH_AES_256_CBC_SHA384 | `ECDHE_RSA_WITH_AES_128_CBC_SHA256 | `DHE_RSA_WITH_CHACHA20_POLY1305_SHA256 - | `ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 -> true + | `ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 + | `ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 + | `ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 + | `ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 + | `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 + | `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 -> true | _ -> false let ciphersuite_tls13 = function - | `AES_128_GCM_SHA256 - | `AES_256_GCM_SHA384 - | `CHACHA20_POLY1305_SHA256 - | `AES_128_CCM_SHA256 -> true + | #ciphersuite13 -> true | _ -> false diff --git a/lib/config.ml b/lib/config.ml index 31269241..f0fdda98 100644 --- a/lib/config.ml +++ b/lib/config.ml @@ -3,7 +3,10 @@ open Core open Sexplib.Std -type certchain = Cert.t list * Mirage_crypto_pk.Rsa.priv [@@deriving sexp] +let src = Logs.Src.create "tls.config" ~doc:"TLS config" +module Log = (val Logs.src_log src : Logs.LOG) + +type certchain = Cert.t list * Priv.t [@@deriving sexp] type own_cert = [ | `None @@ -39,6 +42,7 @@ type ticket_cache_opt = ticket_cache option let ticket_cache_opt_of_sexp _ = None let sexp_of_ticket_cache_opt _ = Sexplib.Sexp.Atom "TICKET_CACHE" +(* TODO: min_rsa, min_dh *) type config = { ciphers : Ciphersuite.ciphersuite list ; protocol_versions : tls_version * tls_version ; @@ -94,6 +98,13 @@ module Ciphers = struct `ECDHE_RSA_WITH_AES_128_CBC_SHA256 ; `ECDHE_RSA_WITH_AES_256_CBC_SHA ; `ECDHE_RSA_WITH_AES_128_CBC_SHA ; + `ECDHE_ECDSA_WITH_AES_128_CBC_SHA ; + `ECDHE_ECDSA_WITH_AES_256_CBC_SHA ; + `ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 ; + `ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 ; + `ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 ; + `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 ; + `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 ; `RSA_WITH_AES_256_GCM_SHA384 ; `RSA_WITH_AES_128_GCM_SHA256 ; `RSA_WITH_AES_256_CCM ; @@ -107,8 +118,10 @@ module Ciphers = struct let supported = default @ [ `DHE_RSA_WITH_3DES_EDE_CBC_SHA ; `RSA_WITH_3DES_EDE_CBC_SHA ; - ] + `ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA ; + ] + (* as defined in https://httpwg.org/specs/rfc7540.html#BadCipherSuites *) let http2 = default13 @ [ `DHE_RSA_WITH_AES_256_GCM_SHA384 ; `DHE_RSA_WITH_AES_128_GCM_SHA256 ; @@ -118,6 +131,9 @@ module Ciphers = struct `ECDHE_RSA_WITH_AES_128_GCM_SHA256 ; `ECDHE_RSA_WITH_AES_256_GCM_SHA384 ; `ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256 ; + `ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 ; + `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 ; + `ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256 ; ] let fs_of = List.filter Ciphersuite.ciphersuite_fs @@ -125,14 +141,19 @@ module Ciphers = struct let fs = fs_of default end -(* TODO split into <=12 and >=13, the SHA1 isn't 13 anymore *) let default_signature_algorithms = - [ `RSA_PSS_RSAENC_SHA256 ; + [ `ECDSA_SECP256R1_SHA256 ; + `ECDSA_SECP384R1_SHA384 ; + `ECDSA_SECP521R1_SHA512 ; + `ED25519 ; + `RSA_PSS_RSAENC_SHA256 ; `RSA_PSS_RSAENC_SHA384 ; `RSA_PSS_RSAENC_SHA512 ; `RSA_PKCS1_SHA256 ; `RSA_PKCS1_SHA384 ; `RSA_PKCS1_SHA512 ; + `RSA_PKCS1_SHA224 ; + `ECDSA_SECP256R1_SHA1 ; `RSA_PKCS1_SHA1 ] let supported_signature_algorithms = @@ -143,7 +164,8 @@ let min_dh_size = 1024 let min_rsa_key_size = 1024 let supported_groups = - [ `X25519 ; `P384 ; `P256 ; `P521 ; `FFDHE2048 ; `FFDHE3072 ; `FFDHE4096 ; `FFDHE6144 ; `FFDHE8192 ] + [ `X25519 ; `P384 ; `P256 ; `P521 ; + `FFDHE2048 ; `FFDHE3072 ; `FFDHE4096 ; `FFDHE6144 ; `FFDHE8192 ] let elliptic_curve = function | `X25519 | `P256 | `P384 | `P521 -> true @@ -167,47 +189,191 @@ let default_config = { zero_rtt = 0l ; } +(* There are inter-configuration option constraints that are checked and + adjusted here. The overall approach is if the client explicitly provided + values, these are taken as granted (a conflict will result in an error). If + the defaults are used, they are adjusted depending on the others. + + The options in question are: + - ciphers, which before 1.3 include the key exchange (FFDHE, ECDHE, RSA) + - groups, which name the FFDHE and ECDHE groups used for DH + - signature_algorithms, which (since 1.2) specify the key type and algorithm + used for signatures (RSA-PKCS, RSA-PSS, ECDSA/EdDSA) + - certificate chains, which influence ciphers (before 1.3) and + signature_algorithms + + Using everywhere the default (but a custom certificate / or multiple) result + in a working configuration (where, depending on the certificate key type, + some signature_algorithms and ciphersuites are removed). The provided server + certificate may remove ciphers & signature_algorithms, but will only result + in failure if these will then be empty. + + An invalid configuration is for example: only FFDHE ciphersuites, but no + FFDHE groups. Or only EC signature algorithms, but only ciphers where the + key type is RSA. + + At session initiation time, the server implementation selects cipher, + certificate, signature_algorithm, and group depending on its configuration + and client request. +*) + + let invalid msg = invalid_arg ("Tls.Config: invalid configuration: " ^ msg) +let ciphers_and_groups ?ciphers ?groups default_ciphers = + let tls13 = function #Ciphersuite.ciphersuite13 -> true | _ -> false in + match ciphers, groups with + | None, None -> default_ciphers, supported_groups + | Some cs, None -> + cs, + let has_kex x = function + | #Ciphersuite.ciphersuite13 -> true + | c -> x = Ciphersuite.ciphersuite_kex c + in + begin + match List.exists (has_kex `ECDHE) cs, List.exists (has_kex `FFDHE) cs with + | true, true -> supported_groups + | true, false -> + Log.warn (fun m -> m "removed FFDHE groups (no FFDHE ciphersuite) from configuation"); + List.filter elliptic_curve supported_groups + | false, true -> + Log.warn (fun m -> m "removed ECDHE groups (no ECDHE ciphersuite) from configuration"); + List.filter (fun g -> not (elliptic_curve g)) supported_groups + | false, false -> [] + end + | None, Some g -> + begin match List.partition elliptic_curve g with + | [], [] -> + Log.warn (fun m -> m "removed DHE and ECDHE ciphersuites (empty groups provided) from configuration"); + List.filter (fun c -> not (Ciphersuite.ciphersuite_fs c)) default_ciphers + | _::_, [] -> + Log.warn (fun m -> m "removed DHE ciphersuites (no FFDHE groups provided) from configuration"); + List.filter (fun c -> not (Ciphersuite.dhe_only c)) default_ciphers + | [], _ :: _ -> + Log.warn (fun m -> m "removed ECDHE ciphersuites (no EC groups provided) from configuration"); + List.filter (fun c -> not (Ciphersuite.ecdhe_only c)) default_ciphers + | _ -> default_ciphers + end, g + | Some cs, Some g -> + if List.exists Ciphersuite.ecdhe_only cs && not (List.exists elliptic_curve g) then + invalid "ciphersuite with ECDHE provided, but no EC group"; + if List.exists Ciphersuite.dhe_only cs && not (List.exists (fun g -> not (elliptic_curve g)) g) then + invalid "ciphersuite with FFDHE provided, but no FF group"; + if List.exists Ciphersuite.ciphersuite_fs cs && g = [] then + invalid "ciphersuite with forward security provided, but no group"; + if List.exists elliptic_curve g && not (List.exists Ciphersuite.ecdhe cs) then + invalid "EC group provided, but no ciphersuite with ECDHE"; + if List.exists (fun g -> not (elliptic_curve g)) g && + not (List.exists (fun c -> Ciphersuite.dhe_only c || tls13 c) cs) + then + invalid "FF group provided, but no ciphersuite with DHE"; + cs, g + +let ciphers_and_sig_alg ?ciphers ?signature_algorithms default_ciphers = + let tls13 = function #Ciphersuite.ciphersuite13 -> true | _ -> false in + let default_sa_from_ciphers c = + let has_key k c = tls13 c || k = Ciphersuite.ciphersuite_keytype c in + match List.exists (has_key `RSA) c, List.exists (has_key `EC) c with + | true, true -> supported_signature_algorithms + | true, false -> + Log.warn (fun m -> m "removed EC signature algorithms (no EC ciphersuite present)"); + List.filter rsa_sigalg supported_signature_algorithms + | false, true -> + Log.warn (fun m -> m "removed RSA signature algorithms (no RSA ciphersuite present)"); + List.filter (fun sa -> not (rsa_sigalg sa)) supported_signature_algorithms + | false, false -> + invalid "ciphersuite list without RSA and EC keys" + in + match ciphers, signature_algorithms with + | None, None -> default_ciphers, default_sa_from_ciphers default_ciphers + | Some c, None -> c, default_sa_from_ciphers c + | None, Some sa -> + begin match List.partition rsa_sigalg sa with + | [], [] -> invalid "empty signature algorithms provided" + | _::_, [] -> + Log.warn (fun m -> m "removing EC ciphers (no EC signature algorithm provided)"); + List.filter + (fun c -> tls13 c || not (Ciphersuite.ciphersuite_keytype c = `EC)) + default_ciphers, + sa + | [], _::_ -> + Log.warn (fun m -> m "removing RSA ciphers (no RSA signature algorithm provided)"); + List.filter + (fun c -> tls13 c || not (Ciphersuite.ciphersuite_keytype c = `RSA)) + default_ciphers, + sa + | _::_, _::_ -> default_ciphers, sa + end + | Some c, Some sa -> + if List.exists rsa_sigalg sa && not (List.exists (fun c -> Ciphersuite.ciphersuite_keytype c = `RSA) c) then + invalid "RSA signature algorithm, but no ciphersuites with RSA keys"; + if List.exists (fun s -> not (rsa_sigalg s)) sa && not (List.exists (fun c -> Ciphersuite.ciphersuite_keytype c = `EC) c) then + invalid "EC signature algorithm, but no ciphersuites with EC keys"; + if List.exists (fun c -> Ciphersuite.ciphersuite_keytype c = `RSA) c && not (List.exists rsa_sigalg sa) then + invalid "RSA ciphersuite, but no RSA signature algorithm"; + if List.exists (fun c -> Ciphersuite.ciphersuite_keytype c = `EC) c && not (List.exists (fun s -> not (rsa_sigalg s)) sa) then + invalid "EC ciphersuite, but no EC signature algorithm"; + c, sa + let validate_common config = let (v_min, v_max) = config.protocol_versions in if v_max < v_min then invalid "bad version range" ; - ( match config.signature_algorithms with - | [] when v_max >= `TLS_1_2 -> - invalid "TLS 1.2 configured but no signature algorithms provided" - | hs when not (List_set.subset hs supported_signature_algorithms) -> - invalid "Some signature algorithms are not supported" - | _ -> () ) ; - if not (List_set.is_proper_set config.ciphers) then + let ciphers, signature_algorithms = + match v_min, v_max with + | _, `TLS_1_1 | _, `TLS_1_0 -> + Log.warn (fun m -> m "TLS 1.0 or TLS 1.1 as maximum version configured, removing 1.2 and 1.3 ciphersuites"); + List.filter (fun c -> + not (Ciphersuite.ciphersuite_tls12_only c || Ciphersuite.ciphersuite_tls13 c)) + config.ciphers, + [] + | _, `TLS_1_2 -> + if config.signature_algorithms = [] then + invalid "TLS 1.2 configured but no signature algorithms provided" + else begin + Log.warn (fun m -> m "TLS 1.2 as maximum version configured, removing 1.3 cipher suites"); + List.filter + (fun c -> not (Ciphersuite.ciphersuite_tls13 c)) config.ciphers, + config.signature_algorithms + end + | `TLS_1_3, `TLS_1_3 -> + let sa = List.filter tls13_sigalg config.signature_algorithms in + if sa = [] then + invalid "TLS 1.3 configured but no 1.3 signature algorithms provided" + else begin + Log.warn (fun m -> m "only TLS 1.3 configured, removing pre-1.3 cipher suites and signature algorithms"); + List.filter Ciphersuite.ciphersuite_tls13 config.ciphers, sa + end + | _ -> config.ciphers, config.signature_algorithms + in + if not (List_set.is_proper_set ciphers) then invalid "set of ciphers is not a proper set" ; - if List.length config.ciphers = 0 then + if List.length ciphers = 0 then invalid "set of ciphers is empty" ; - (* groups and ciphersuites (<= 1.2): any ECC if a ECDHE cipher present *) - if List.exists Ciphersuite.ecc config.ciphers then - if not (List.exists elliptic_curve config.groups) then - invalid_arg "ECDHE ciphersuite configured, but no ECC curve"; - if List.exists (fun c -> Ciphersuite.(ciphersuite_fs c && not (ecc c))) config.ciphers then - if List.for_all elliptic_curve config.groups then - invalid_arg "DHE ciphersuites configured, but no FFDHE group"; + if not (List_set.is_proper_set config.groups) then + invalid "set of groups is not a proper set" ; + if not (List_set.is_proper_set signature_algorithms) then + invalid "set of signature algorithms is not a proper set" ; if List.exists (fun proto -> let len = String.length proto in len = 0 || len > 255) config.alpn_protocols then invalid "invalid alpn protocol" ; if List.length config.alpn_protocols > 0xffff then - invalid "alpn protocols list too large" - -module CertTypeUsageOrdered = struct - type t = X509.Certificate.key_type * X509.Extension.key_usage - let compare = compare -end -module CertTypeUsageSet = Set.Make(CertTypeUsageOrdered) + invalid "alpn protocols list too large" ; + { config with ciphers ; signature_algorithms } let validate_certificate_chain = function | (s::chain, priv) -> - let pub = Mirage_crypto_pk.Rsa.pub_of_priv priv in - if Mirage_crypto_pk.Rsa.pub_bits pub < min_rsa_key_size then - invalid "RSA key too short!" ; - ( match X509.Certificate.public_key s with - | `RSA pub' when pub = pub' -> () - | _ -> invalid "public / private key combination" ) ; + let pub = X509.Private_key.public priv in + ( match pub with + | `RSA pub -> + if Mirage_crypto_pk.Rsa.pub_bits pub < min_rsa_key_size then + invalid "RSA key too short!" + | _ -> () ); + ( let eq_pub a b = + Cstruct.equal + (X509.Public_key.fingerprint a) + (X509.Public_key.fingerprint b) + in + if not (eq_pub pub (X509.Certificate.public_key s)) then + invalid "public / private key combination" ) ; ( match init_and_last chain with | Some (ch, trust) -> (* TODO: verify that certificates are x509 v3 if TLS_1_2 *) @@ -217,7 +383,7 @@ let validate_certificate_chain = function let s = Fmt.to_to_string X509.Validation.pp_validation_error x in invalid ("certificate chain does not validate: " ^ s)) | None -> () ) - | _ -> invalid "certificate" + | _ -> invalid "certificate chain" let validate_client config = match config.own_certificates with @@ -245,44 +411,85 @@ let non_overlapping cs = in check namessets +module KU = Set.Make (struct + type t = X509.Extension.key_usage + let compare a b = compare a b + end) + +module PK = Map.Make (struct + type t = [ `RSA | `ED25519 | `P256 | `P384 | `P521 ] + let compare a b = compare a b + end) + let validate_server config = let open Ciphersuite in - let typeusage = - let tylist = - List.map ciphersuite_kex config.ciphers |> - List.map required_keytype_and_usage - in - List.fold_right CertTypeUsageSet.add tylist CertTypeUsageSet.empty + let usages = + List.fold_left + (fun acc c -> KU.add (required_usage (ciphersuite_kex c)) acc) + KU.empty config.ciphers and certificate_chains = match config.own_certificates with | `Single c -> [c] | `Multiple cs -> cs | `Multiple_default (c, cs) -> c :: cs - | `None -> [] + | `None -> invalid "no server certificate provided" in let server_certs = - List.map (function - | (s::_,_) -> s - | _ -> invalid "empty certificate chain") + List.map (function (s::_,_) -> s | _ -> invalid "empty certificate chain") certificate_chains in - if - not (CertTypeUsageSet.for_all - (fun (t, u) -> - List.exists (fun c -> - X509.Certificate.supports_keytype c t && - supports_key_usage ~not_present:true c u) - server_certs) - typeusage) + if not + (KU.for_all (fun u -> + List.exists (supports_key_usage ~not_present:true u) server_certs) + usages) then - invalid "certificate type or usage does not match" ; + invalid "certificate usage does not match" ; List.iter validate_certificate_chain certificate_chains ; + let rsa_cert, ec_cert = + let is_ec_cert c = match X509.Certificate.public_key c with + | `ED25519 _ | `P256 _ | `P384 _ | `P521 _ -> true + | _ -> false + and is_rsa_cert c = match X509.Certificate.public_key c with + | `RSA _ -> true | _ -> false + in + List.exists is_rsa_cert server_certs, + List.exists is_ec_cert server_certs + in + let ciphers = + List.filter + (function + | #Ciphersuite.ciphersuite13 -> true + | c -> + let keytype = ciphersuite_keytype c in + (rsa_cert && keytype = `RSA) || (ec_cert && keytype = `EC)) + config.ciphers + in + let signature_algorithms = + let pk = List.map snd certificate_chains in + List.filter (fun sa -> List.exists (fun p -> pk_matches_sa p sa) pk) + config.signature_algorithms + in ( match config.own_certificates with - | `Multiple cs -> non_overlapping cs - | `Multiple_default (_, cs) -> non_overlapping cs - | _ -> () ) - (* TODO: verify that certificates are x509 v3 if TLS_1_2 *) - + | `Multiple cs + | `Multiple_default (_, cs) -> + let add k v acc = match PK.find_opt k acc with + | None -> PK.add k [v] acc + | Some r -> PK.add k (v :: r) acc + in + let pk = + List.fold_left (fun acc cs -> + match snd cs with + | `RSA _ -> add `RSA cs acc + | `ED25519 _ -> add `ED25519 cs acc + | `P256 _ -> add `P256 cs acc + | `P384 _ -> add `P384 cs acc + | `P521 _ -> add `P521 cs acc + | _ -> invalid "unknown key type") + PK.empty cs + in + PK.iter (fun _ chains -> non_overlapping chains) pk + | _ -> () ); + { config with ciphers ; signature_algorithms } type client = config [@@deriving sexp] type server = config [@@deriving sexp] @@ -302,12 +509,14 @@ let () ma b = match ma with None -> b | Some a -> a let client ~authenticator ?peer_name ?ciphers ?version ?signature_algorithms ?reneg ?certificates ?cached_session ?cached_ticket ?ticket_cache ?alpn_protocols ?groups () = + let ciphers', groups = ciphers_and_groups ?ciphers ?groups default_config.ciphers in + let ciphers, signature_algorithms = ciphers_and_sig_alg ?ciphers ?signature_algorithms ciphers' in let config = { default_config with authenticator = Some authenticator ; - ciphers = ciphers default_config.ciphers ; + ciphers ; protocol_versions = version default_config.protocol_versions ; - signature_algorithms = signature_algorithms default_config.signature_algorithms ; + signature_algorithms ; use_reneg = reneg default_config.use_reneg ; own_certificates = certificates default_config.own_certificates ; peer_name = peer_name ; @@ -315,17 +524,23 @@ let client alpn_protocols = alpn_protocols default_config.alpn_protocols ; ticket_cache = ticket_cache ; cached_ticket = cached_ticket ; - groups = groups default_config.groups ; + groups ; } in - ( validate_common config ; validate_client config ; config ) + let config = validate_common config in + validate_client config ; + Log.info (fun m -> m "client with %s" + (Sexplib.Sexp.to_string_hum (sexp_of_config config))); + config let server - ?ciphers ?version ?signature_algorithms ?reneg ?certificates ?acceptable_cas ?authenticator ?session_cache ?ticket_cache ?alpn_protocols ?groups ?zero_rtt () = + ?ciphers ?version ?signature_algorithms ?reneg ?certificates ?acceptable_cas ?authenticator ?session_cache ?ticket_cache ?alpn_protocols ?groups ?zero_rtt () = + let ciphers', groups = ciphers_and_groups ?ciphers ?groups default_config.ciphers in + let ciphers, signature_algorithms = ciphers_and_sig_alg ?ciphers ?signature_algorithms ciphers' in let config = { default_config with - ciphers = ciphers default_config.ciphers ; + ciphers ; protocol_versions = version default_config.protocol_versions ; - signature_algorithms = signature_algorithms default_config.signature_algorithms ; + signature_algorithms ; use_reneg = reneg default_config.use_reneg ; own_certificates = certificates default_config.own_certificates ; acceptable_cas = acceptable_cas default_config.acceptable_cas ; @@ -333,7 +548,11 @@ let server session_cache = session_cache default_config.session_cache ; alpn_protocols = alpn_protocols default_config.alpn_protocols ; ticket_cache = ticket_cache ; - groups = groups default_config.groups ; + groups ; zero_rtt = zero_rtt default_config.zero_rtt ; } in - ( validate_common config ; validate_server config ; config ) + let config = validate_server config in + let config = validate_common config in + Log.info (fun m -> m "server with %s" + (Sexplib.Sexp.to_string_hum (sexp_of_config config))); + config diff --git a/lib/config.mli b/lib/config.mli index 075dfc25..8a21ec95 100644 --- a/lib/config.mli +++ b/lib/config.mli @@ -5,7 +5,7 @@ open Core (** {1 Config type} *) (** certificate chain and private key of the first certificate *) -type certchain = Cert.t list * Mirage_crypto_pk.Rsa.priv +type certchain = Cert.t list * X509.Private_key.t (** polymorphic variant of own certificates *) type own_cert = [ diff --git a/lib/core.ml b/lib/core.ml index e89b1917..554b7c7c 100644 --- a/lib/core.ml +++ b/lib/core.ml @@ -169,15 +169,15 @@ type signature_algorithm = [ | `RSA_PKCS1_SHA256 | `RSA_PKCS1_SHA384 | `RSA_PKCS1_SHA512 -(* | `ECDSA_SECP256R1_SHA1 + | `ECDSA_SECP256R1_SHA1 | `ECDSA_SECP256R1_SHA256 - | `ECDSA_SECP256R1_SHA384 - | `ECDSA_SECP256R1_SHA512 *) + | `ECDSA_SECP384R1_SHA384 + | `ECDSA_SECP521R1_SHA512 | `RSA_PSS_RSAENC_SHA256 | `RSA_PSS_RSAENC_SHA384 | `RSA_PSS_RSAENC_SHA512 -(* | `ED25519 - | `ED448 + | `ED25519 +(* | `ED448 | `RSA_PSS_PSS_SHA256 | `RSA_PSS_PSS_SHA384 | `RSA_PSS_PSS_SHA512 *) @@ -193,6 +193,11 @@ let hash_of_signature_algorithm = function | `RSA_PSS_RSAENC_SHA256 -> `SHA256 | `RSA_PSS_RSAENC_SHA384 -> `SHA384 | `RSA_PSS_RSAENC_SHA512 -> `SHA512 + | `ECDSA_SECP256R1_SHA1 -> `SHA1 + | `ECDSA_SECP256R1_SHA256 -> `SHA256 + | `ECDSA_SECP384R1_SHA384 -> `SHA384 + | `ECDSA_SECP521R1_SHA512 -> `SHA512 + | `ED25519 -> `SHA512 let signature_scheme_of_signature_algorithm = function | `RSA_PKCS1_MD5 -> `PKCS1 @@ -204,6 +209,36 @@ let signature_scheme_of_signature_algorithm = function | `RSA_PSS_RSAENC_SHA256 -> `PSS | `RSA_PSS_RSAENC_SHA384 -> `PSS | `RSA_PSS_RSAENC_SHA512 -> `PSS + | `ECDSA_SECP256R1_SHA1 -> `ECDSA + | `ECDSA_SECP256R1_SHA256 -> `ECDSA + | `ECDSA_SECP384R1_SHA384 -> `ECDSA + | `ECDSA_SECP521R1_SHA512 -> `ECDSA + | `ED25519 -> `EdDSA + +let rsa_sigalg = function + | `RSA_PSS_RSAENC_SHA256 | `RSA_PSS_RSAENC_SHA384 | `RSA_PSS_RSAENC_SHA512 + | `RSA_PKCS1_SHA256 | `RSA_PKCS1_SHA384 | `RSA_PKCS1_SHA512 + | `RSA_PKCS1_SHA224 | `RSA_PKCS1_SHA1 | `RSA_PKCS1_MD5 -> true + | `ECDSA_SECP256R1_SHA1 | `ECDSA_SECP256R1_SHA256 | `ECDSA_SECP384R1_SHA384 + | `ECDSA_SECP521R1_SHA512 | `ED25519 -> false + +let tls13_sigalg = function + | `RSA_PSS_RSAENC_SHA256 | `RSA_PSS_RSAENC_SHA384 | `RSA_PSS_RSAENC_SHA512 + | `ECDSA_SECP256R1_SHA256 | `ECDSA_SECP384R1_SHA384 + | `ECDSA_SECP521R1_SHA512 | `ED25519 -> true + | `RSA_PKCS1_SHA256 | `RSA_PKCS1_SHA384 | `RSA_PKCS1_SHA512 + | `RSA_PKCS1_SHA224 | `RSA_PKCS1_SHA1 | `RSA_PKCS1_MD5 + | `ECDSA_SECP256R1_SHA1 -> false + +let pk_matches_sa pk sa = + match pk, sa with + | `RSA _, _ -> rsa_sigalg sa + | `ED25519 _, `ED25519 + | `P256 _, `ECDSA_SECP256R1_SHA256 + | `P256 _, `ECDSA_SECP256R1_SHA1 + | `P384 _, `ECDSA_SECP384R1_SHA384 + | `P521 _, `ECDSA_SECP521R1_SHA512 -> true + | _ -> false type client_extension = [ | `Hostname of string @@ -340,6 +375,12 @@ module Cert = struct let sexp_of_t _ = Sexplib.Sexp.Atom "certificate" end +module Priv = struct + include X509.Private_key + let t_of_sexp _ = failwith "can't convert private key from S-expression" + let sexp_of_t _ = Sexplib.Sexp.Atom "private key" +end + module Ptime = struct include Ptime let sexp_of_t ts = Sexplib.Sexp.Atom (Ptime.to_rfc3339 ts) @@ -377,7 +418,7 @@ type epoch_data = { received_certificates : Cert.t list ; own_random : Cstruct_sexp.t ; own_certificate : Cert.t list ; - own_private_key : Mirage_crypto_pk.Rsa.priv option ; + own_private_key : Priv.t option ; own_name : string option ; master_secret : master_secret ; session_id : SessionID.t ; @@ -385,12 +426,12 @@ type epoch_data = { alpn_protocol : string option ; } [@@deriving sexp] -let supports_key_usage ?(not_present = false) cert usage = +let supports_key_usage ?(not_present = false) usage cert = match X509.Extension.(find Key_usage (X509.Certificate.extensions cert)) with | None -> not_present | Some (_, kus) -> List.mem usage kus -let supports_extended_key_usage ?(not_present = false) cert usage = +let supports_extended_key_usage ?(not_present = false) usage cert = match X509.Extension.(find Ext_key_usage (X509.Certificate.extensions cert)) with | None -> not_present | Some (_, kus) -> List.mem usage kus diff --git a/lib/crypto.ml b/lib/crypto.ml index 3de7d1d3..a9b2c924 100644 --- a/lib/crypto.ml +++ b/lib/crypto.ml @@ -66,9 +66,6 @@ module Ciphers = struct | `AEAD cipher -> get_aead ~secret ~nonce cipher end -let digest_eq fn ~target cs = - Utils.Cs.equal target (Hash.digest fn cs) - let sequence_buf seq = let open Cstruct in let buf = create 8 in diff --git a/lib/engine.ml b/lib/engine.ml index 890a472a..c79d53bd 100644 --- a/lib/engine.ml +++ b/lib/engine.ml @@ -55,10 +55,8 @@ let alert_of_fatal = function | `InvalidSession -> Packet.HANDSHAKE_FAILURE | `UnexpectedCCS -> Packet.UNEXPECTED_MESSAGE | `UnexpectedHandshake _ -> Packet.UNEXPECTED_MESSAGE - | `RSASignatureMismatch -> Packet.HANDSHAKE_FAILURE | `HashAlgorithmMismatch -> Packet.HANDSHAKE_FAILURE - | `NotRSASignature -> Packet.HANDSHAKE_FAILURE - | `RSASignatureVerificationFailed -> Packet.HANDSHAKE_FAILURE + | `SignatureVerificationFailed -> Packet.HANDSHAKE_FAILURE | `UnsupportedSignatureScheme -> Packet.HANDSHAKE_FAILURE | `KeyTooSmall -> Packet.INSUFFICIENT_SECURITY | `BadCertificateChain -> Packet.BAD_CERTIFICATE @@ -76,7 +74,6 @@ let alert_of_fatal = function | `Toomany0rttbytes -> Packet.UNEXPECTED_MESSAGE | `MissingContentType -> Packet.UNEXPECTED_MESSAGE | `Downgrade12 | `Downgrade11 -> Packet.ILLEGAL_PARAMETER - | `UnsupportedKeyExchange -> Packet.HANDSHAKE_FAILURE let alert_of_failure = function | `Error x -> alert_of_error x diff --git a/lib/engine.mli b/lib/engine.mli index 90c0ec07..e1559ac0 100644 --- a/lib/engine.mli +++ b/lib/engine.mli @@ -88,10 +88,8 @@ type fatal = [ | `NoCertificateReceived | `NoCertificateVerifyReceived | `NotRSACertificate - | `NotRSASignature | `KeyTooSmall - | `RSASignatureMismatch - | `RSASignatureVerificationFailed + | `SignatureVerificationFailed | `UnsupportedSignatureScheme | `HashAlgorithmMismatch | `BadCertificateChain @@ -125,7 +123,6 @@ type fatal = [ | `MissingContentType | `Downgrade12 | `Downgrade11 - | `UnsupportedKeyExchange ] (** type of failures *) diff --git a/lib/handshake_client.ml b/lib/handshake_client.ml index bce0f32c..3ae0fc62 100644 --- a/lib/handshake_client.ml +++ b/lib/handshake_client.ml @@ -59,16 +59,7 @@ let default_client_hello config = | [] -> [] | protocols -> [`ALPN protocols] in - let ciphers = - match - min_protocol_version config.protocol_versions, - max_protocol_version config.protocol_versions - with - | `TLS_1_3, _ -> (ciphers13 config :> Ciphersuite.ciphersuite list) - | _, `TLS_1_3 -> config.ciphers - | _, `TLS_1_1 | _, `TLS_1_0 -> List.filter (o not Ciphersuite.ciphersuite_tls12_only) config.ciphers - | _ -> config.ciphers - and sessionid = + let sessionid = match config.use_reneg, config.cached_session with | _, Some { session_id ; extended_ms ; _ } when extended_ms && not (Cs.null session_id) -> Some session_id | false, Some { session_id ; _ } when not (Cs.null session_id) -> Some session_id @@ -78,7 +69,7 @@ let default_client_hello config = client_version = (version :> tls_any_version) ; client_random = Mirage_crypto_rng.generate 32 ; sessionid = sessionid ; - ciphersuites = List.map Ciphersuite.ciphersuite_to_any_ciphersuite ciphers ; + ciphersuites = List.map Ciphersuite.ciphersuite_to_any_ciphersuite config.ciphers ; extensions = `ExtendedMasterSecret :: host @ extensions @ alpn } in @@ -129,15 +120,12 @@ let common_server_hello_machina state (sh : server_hello) (ch : client_hello) ra in let state = { state with protocol_version = sh.server_version } in match Ciphersuite.ciphersuite_kex cipher with + | #Ciphersuite.key_exchange_algorithm_dhe -> + let machina = Client (AwaitCertificate_DHE (session, log @ [raw])) in + Ok ({ state with machina }, []) | `RSA -> let machina = Client (AwaitCertificate_RSA (session, log @ [raw])) in Ok ({ state with machina }, []) - | `DHE_RSA -> - let machina = Client (AwaitCertificate_DHE_RSA (session, log @ [raw])) in - Ok ({ state with machina }, []) - | _ -> - (* we don't support PSK for 1.2 and below *) - Error (`Fatal `UnsupportedKeyExchange) let answer_server_hello state (ch : client_hello) sh secrets raw log = let validate_version requested (lo, _) server_version = @@ -200,27 +188,22 @@ let answer_server_hello_renegotiate state session (ch : client_hello) sh raw log (`Fatal (`InvalidRenegotiationVersion sh.server_version)) >>= fun () -> common_server_hello_machina state sh ch raw log -let validate_keytype_usage certificate ciphersuite = - let keytype, usage = - Ciphersuite.(o required_keytype_and_usage ciphersuite_kex ciphersuite) - in +let validate_keyusage certificate kex = + let usage = Ciphersuite.required_usage kex in match certificate with | None -> fail (`Fatal `NoCertificateReceived) | Some cert -> - let open X509 in - guard (Certificate.supports_keytype cert keytype) - (`Fatal `NotRSACertificate) >>= fun () -> - guard (supports_key_usage ~not_present:true cert usage) + guard (supports_key_usage ~not_present:true usage cert) (`Fatal `InvalidCertificateUsage) >>= fun () -> guard - (supports_extended_key_usage cert `Server_auth || - supports_extended_key_usage ~not_present:true cert `Any) + (supports_extended_key_usage `Server_auth cert || + supports_extended_key_usage ~not_present:true `Any cert) (`Fatal `InvalidCertificateExtendedUsage) let answer_certificate_RSA state (session : session_data) cs raw log = let cfg = state.config in validate_chain cfg.authenticator cs (host_name_opt cfg.peer_name) >>= fun (peer_certificate, received_certificates, peer_certificate_chain, trust_anchor) -> - validate_keytype_usage peer_certificate session.ciphersuite >>= fun () -> + validate_keyusage peer_certificate `RSA >>= fun () -> let session = let common_session_data = { session.common_session_data with received_certificates ; peer_certificate ; peer_certificate_chain ; trust_anchor } in { session with common_session_data } @@ -232,29 +215,31 @@ let answer_certificate_RSA state (session : session_data) cs raw log = ) >>= fun version -> let ver = Writer.assemble_protocol_version version in let premaster = ver <+> Mirage_crypto_rng.generate 46 in - peer_rsa_key peer_certificate >|= fun pubkey -> - let kex = Mirage_crypto_pk.Rsa.PKCS1.encrypt ~key:pubkey premaster in - let kex = Writer.assemble_client_dh_key_exchange kex in - let machina = - AwaitCertificateRequestOrServerHelloDone - (session, kex, premaster, log @ [raw]) - in - ({ state with machina = Client machina }, []) - -let answer_certificate_DHE_RSA state (session : session_data) cs raw log = + peer_key peer_certificate >>= function + | `RSA key -> + let kex = Mirage_crypto_pk.Rsa.PKCS1.encrypt ~key premaster in + let kex = Writer.assemble_client_dh_key_exchange kex in + let machina = + AwaitCertificateRequestOrServerHelloDone + (session, kex, premaster, log @ [raw]) + in + return ({ state with machina = Client machina }, []) + | _ -> fail (`Fatal `NotRSACertificate) + +let answer_certificate_DHE state (session : session_data) cs raw log = let cfg = state.config in validate_chain cfg.authenticator cs (host_name_opt cfg.peer_name) >>= fun (peer_certificate, received_certificates, peer_certificate_chain, trust_anchor) -> - validate_keytype_usage peer_certificate session.ciphersuite >|= fun () -> + validate_keyusage peer_certificate `FFDHE >|= fun () -> let session = let common_session_data = { session.common_session_data with received_certificates ; peer_certificate ; peer_certificate_chain ; trust_anchor } in { session with common_session_data } in - let machina = AwaitServerKeyExchange_DHE_RSA (session, log @ [raw]) in + let machina = AwaitServerKeyExchange_DHE (session, log @ [raw]) in ({ state with machina = Client machina }, []) -let answer_server_key_exchange_DHE_RSA state (session : session_data) kex raw log = +let answer_server_key_exchange_DHE state (session : session_data) kex raw log = let to_fatal r = match r with Ok cs -> return cs | Error er -> fail (`Fatal (`ReaderError er)) in - (if Ciphersuite.ecc session.ciphersuite then + (if Ciphersuite.ecdhe session.ciphersuite then to_fatal (Reader.parse_ec_parameters kex) >|= fun (g, share, raw, left) -> (`Ec g, share, raw, left) else @@ -325,14 +310,11 @@ let answer_certificate_request state (session : session_data) cr kex pms raw log | Ok (types, sigalgs, cas) -> return (types, Some sigalgs, cas) | Error re -> fail (`Fatal (`ReaderError re)) ) | v -> fail (`Fatal (`BadRecordVersion (v :> tls_any_version))) (* never happens *) - ) >|= fun (types, sigalgs, _cas) -> - (* TODO: respect cas, maybe multiple client certificates? *) + ) >|= fun (_types, sigalgs, _cas) -> + (* TODO: respect _types and _cas, multiple client certificates *) let own_certificate, own_private_key = - match - List.mem Packet.RSA_SIGN types, - cfg.own_certificates - with - | true, `Single (chain, priv) -> (chain, Some priv) + match cfg.own_certificates with + | `Single (chain, priv) -> (chain, Some priv) | _ -> ([], None) in let session = @@ -490,12 +472,12 @@ let handle_handshake cs hs buf = (match Reader.parse_certificates cs with | Ok cs -> answer_certificate_RSA hs session cs buf log | Error re -> fail (`Fatal (`ReaderError re))) - | AwaitCertificate_DHE_RSA (session, log), Certificate cs -> + | AwaitCertificate_DHE (session, log), Certificate cs -> (match Reader.parse_certificates cs with - | Ok cs -> answer_certificate_DHE_RSA hs session cs buf log + | Ok cs -> answer_certificate_DHE hs session cs buf log | Error re -> fail (`Fatal (`ReaderError re))) - | AwaitServerKeyExchange_DHE_RSA (session, log), ServerKeyExchange kex -> - answer_server_key_exchange_DHE_RSA hs session kex buf log + | AwaitServerKeyExchange_DHE (session, log), ServerKeyExchange kex -> + answer_server_key_exchange_DHE hs session kex buf log | AwaitCertificateRequestOrServerHelloDone (session, kex, pms, log), CertificateRequest cr -> answer_certificate_request hs session cr kex pms buf log | AwaitCertificateRequestOrServerHelloDone (session, kex, pms, log), ServerHelloDone -> diff --git a/lib/handshake_common.ml b/lib/handshake_common.ml index 82043f9b..156ea17c 100644 --- a/lib/handshake_common.ml +++ b/lib/handshake_common.ml @@ -8,7 +8,9 @@ let src = Logs.Src.create "handshake" ~doc:"TLS handshake" module Log = (val Logs.src_log src : Logs.LOG) let trace_cipher cipher = - let kex, papr = Ciphersuite.get_kex_privprot cipher in + let kex = Ciphersuite.ciphersuite_kex cipher + and papr = Ciphersuite.ciphersuite_privprot cipher + in let sexp = lazy (Sexplib.Sexp.(List Ciphersuite.( [ sexp_of_key_exchange_algorithm kex ; sexp_of_payload_protection papr ]))) @@ -50,7 +52,7 @@ let rec find_matching host certs = | _::xs -> find_matching host xs (* this should never happen! *) | [] -> None -let agreed_cert certs hostname = +let agreed_cert certs ?f ?signature_algorithms hostname = let match_host ?default host certs = match find_matching host certs with | Some x -> return x @@ -58,13 +60,41 @@ let agreed_cert certs hostname = | Some c -> return c | None -> fail (`Error (`NoMatchingCertificateFound (Domain_name.to_string host))) in + let filter = function + | ([], _) -> false (* cannot happen, TODO: adapt types to avoid this case *) + | (s :: _, _) -> + match f with + | None -> true + | Some f -> f s + in + let filter_sigalg c = + match signature_algorithms with + | None -> true + | Some s -> List.exists (pk_matches_sa (snd c)) s + in match certs, hostname with - | `None , _ -> fail (`Error `NoCertificateConfigured) - | `Single c , _ -> return c - | `Multiple_default (c, _) , None -> return c - | `Multiple cs , Some h -> match_host h cs - | `Multiple_default (c, cs), Some h -> match_host h cs ~default:c - | _ -> fail (`Error `CouldntSelectCertificate) + | `None, _ -> fail (`Error `NoCertificateConfigured) + | `Single c, _ -> + if filter c && filter_sigalg c then return c else fail (`Error `CouldntSelectCertificate) + | `Multiple_default (c, _), None -> + if filter c && filter_sigalg c then return c else fail (`Error `CouldntSelectCertificate) + | `Multiple_default (c, cs), Some h -> + let default = if filter c && filter_sigalg c then Some c else None in + begin match default, List.filter (fun c -> filter c && filter_sigalg c) cs with + | Some d, cs -> match_host ~default:d h cs + | None, c :: cs -> match_host ~default:c h (c::cs) + | None, [] -> fail (`Error `CouldntSelectCertificate) + end + | `Multiple cs, None -> + begin match List.filter (fun c -> filter c && filter_sigalg c) cs with + | cert :: _ -> return cert + | _ -> fail (`Error `CouldntSelectCertificate) + end + | `Multiple cs, Some h -> + match List.filter (fun c -> filter c && filter_sigalg c) cs with + | [ cert ] -> return cert + | c :: cs -> match_host ~default:c h (c :: cs) + | [] -> fail (`Error `CouldntSelectCertificate) let get_secure_renegotiation exts = map_find @@ -328,105 +358,227 @@ let to_sign_1_3 context_string = in prefix <+> ctx -let signature version ?context_string data client_sig_algs signature_algorithms private_key = +let ecdsa_sig = + let f (r, s) = + if Z.sign r < 0 then + Asn.S.parse_error "ECDSA signature: r < 0" + else if Z.sign s < 0 then + Asn.S.parse_error "ECDSA signature: s < 0" + else + Mirage_crypto_pk.Z_extra.to_cstruct_be r, + Mirage_crypto_pk.Z_extra.to_cstruct_be s + and g (r, s) = + Mirage_crypto_pk.Z_extra.of_cstruct_be r, + Mirage_crypto_pk.Z_extra.of_cstruct_be s + in + Asn.S.(map f g @@ + sequence2 + (required ~label:"r" integer) + (required ~label:"s" integer)) + +let ecdsa_sig_of_cstruct, ecdsa_sig_to_cstruct = + let decode codec cs = + let open Rresult.R.Infix in + Asn.decode codec cs >>= fun (a, cs) -> + if Cstruct.len cs = 0 then Ok a else Error (`Parse "Leftover") + in + let c = Asn.codec Asn.der ecdsa_sig in + let dec c cs = match decode c cs with + | Ok a -> Ok a + | Error _ -> Error (`Fatal `SignatureVerificationFailed) + in + (dec c, Asn.encode c) + +let signature version ?context_string data client_sig_algs signature_algorithms (private_key : X509.Private_key.t) = try begin match version with - | `TLS_1_0 | `TLS_1_1 -> - let data = Hash.MD5.digest data <+> Hash.SHA1.digest data in - let signed = Mirage_crypto_pk.Rsa.PKCS1.sig_encode ~key:private_key data in - return (Writer.assemble_digitally_signed signed) - | `TLS_1_2 -> - (* if no signature_algorithms extension is sent by the client, - support for md5 and sha1 can be safely assumed! *) - ( match client_sig_algs with - | None -> return `RSA_PKCS1_SHA1 - | Some client_algos -> - match first_match client_algos signature_algorithms with - | None -> fail (`Error (`NoConfiguredSignatureAlgorithm client_algos)) - | Some sig_alg -> return sig_alg ) >|= fun sig_alg -> - let hash_alg = Core.hash_of_signature_algorithm sig_alg in - begin match signature_scheme_of_signature_algorithm sig_alg with - | `PSS -> - let module H = (val (Hash.module_of hash_alg)) in - let module PSS = Mirage_crypto_pk.Rsa.PSS(H) in - let sign = PSS.sign ~key:private_key (`Message data) in - Writer.assemble_digitally_signed_1_2 sig_alg sign - | `PKCS1 -> - let hash = Hash.digest hash_alg data in - let cs = X509.Certificate.encode_pkcs1_digest_info (hash_alg, hash) in - let sign = Mirage_crypto_pk.Rsa.PKCS1.sig_encode ~key:private_key cs in - Writer.assemble_digitally_signed_1_2 sig_alg sign - end - | `TLS_1_3 -> - (* RSA-PSS is used *) - let prefix = to_sign_1_3 context_string in - ( match client_sig_algs with - | None -> return `RSA_PSS_RSAENC_SHA256 - | Some client_algos -> - (* SHA1 must not be used - all our PSS_RSAENC only use sha2 *) - match first_match client_algos signature_algorithms with - | None -> fail (`Error (`NoConfiguredSignatureAlgorithm client_algos)) - | Some sig_alg -> return sig_alg ) >>= fun sig_alg -> - let hash_algo = hash_of_signature_algorithm sig_alg in - match signature_scheme_of_signature_algorithm sig_alg with - | `PSS -> - let module H = (val (Hash.module_of hash_algo)) in - let module PSS = Mirage_crypto_pk.Rsa.PSS(H) in - let to_sign = prefix <+> data in - let signature = PSS.sign ~key:private_key (`Message to_sign) in - return (Writer.assemble_digitally_signed_1_2 sig_alg signature) - | _ -> fail (`Error (`NoConfiguredSignatureAlgorithm [])) (*TODO different warning, types *) + | `TLS_1_0 | `TLS_1_1 -> + begin match private_key with + | `RSA key -> + let data = Hash.MD5.digest data <+> Hash.SHA1.digest data in + return (Mirage_crypto_pk.Rsa.PKCS1.sig_encode ~key data) + | `P256 key -> + let data = Hash.SHA1.digest data in + return (ecdsa_sig_to_cstruct (Mirage_crypto_ec.P256.Dsa.sign ~key data)) + | `P384 key -> + let data = Hash.SHA1.digest data in + return (ecdsa_sig_to_cstruct (Mirage_crypto_ec.P384.Dsa.sign ~key data)) + | `P521 key -> + let data = Hash.SHA1.digest data in + return (ecdsa_sig_to_cstruct (Mirage_crypto_ec.P521.Dsa.sign ~key data)) + | `ED25519 key -> return (Mirage_crypto_ec.Ed25519.sign ~key data) + | _ -> fail (`Error (`NoConfiguredSignatureAlgorithm [])) + end >|= fun signed -> + Writer.assemble_digitally_signed signed + | `TLS_1_2 -> + let sig_alg ec = + match client_sig_algs with + | None -> return (if ec then `ECDSA_SECP256R1_SHA1 else `RSA_PKCS1_SHA1) + | Some client_algos -> + let f = if ec then (fun sa -> not (rsa_sigalg sa)) else rsa_sigalg in + match first_match client_algos (List.filter f signature_algorithms) with + | None -> fail (`Error (`NoConfiguredSignatureAlgorithm client_algos)) + | Some sig_alg -> return sig_alg + in + ( match private_key with + | `RSA key -> + begin + sig_alg false >>= fun sig_alg -> + match + signature_scheme_of_signature_algorithm sig_alg, + hash_of_signature_algorithm sig_alg + with + | `PSS, hash_alg -> + let module H = (val (Hash.module_of hash_alg)) in + let module PSS = Mirage_crypto_pk.Rsa.PSS(H) in + return (sig_alg, PSS.sign ~key (`Message data)) + | `PKCS1, hash_alg -> + let hash = Hash.digest hash_alg data in + let cs = X509.Certificate.encode_pkcs1_digest_info (hash_alg, hash) in + return (sig_alg, Mirage_crypto_pk.Rsa.PKCS1.sig_encode ~key cs) + | _ -> fail (`Error (`NoConfiguredSignatureAlgorithm [])) + end + | `P256 key -> + sig_alg true >|= fun sig_alg -> + let hash = Hash.digest (hash_of_signature_algorithm sig_alg) data in + sig_alg, ecdsa_sig_to_cstruct (Mirage_crypto_ec.P256.Dsa.sign ~key hash) + | `P384 key -> + sig_alg true >|= fun sig_alg -> + let hash = Hash.digest (hash_of_signature_algorithm sig_alg) data in + sig_alg, ecdsa_sig_to_cstruct (Mirage_crypto_ec.P384.Dsa.sign ~key hash) + | `P521 key -> + sig_alg true >|= fun sig_alg -> + let hash = Hash.digest (hash_of_signature_algorithm sig_alg) data in + sig_alg, ecdsa_sig_to_cstruct (Mirage_crypto_ec.P521.Dsa.sign ~key hash) + | `ED25519 key -> + sig_alg true >|= fun sig_alg -> + sig_alg, Mirage_crypto_ec.Ed25519.sign ~key data + | _ -> fail (`Error (`NoConfiguredSignatureAlgorithm [])) ) >|= fun (sig_alg, signature) -> + Writer.assemble_digitally_signed_1_2 sig_alg signature + | `TLS_1_3 -> + let to_sign = + let prefix = to_sign_1_3 context_string in + prefix <+> data + in + (match client_sig_algs with + | None -> fail (`Error (`NoConfiguredSignatureAlgorithm [])) + (* 8446 4.2.3 "client MUST send signatureAlgorithms" *) + | Some client_algos -> + let sa = List.filter tls13_sigalg signature_algorithms in + let sa = List.filter (pk_matches_sa private_key) sa in + match first_match client_algos sa with + | None -> fail (`Error (`NoConfiguredSignatureAlgorithm client_algos)) + | Some sig_alg -> return sig_alg) >>= fun sig_alg -> + let hash_alg = hash_of_signature_algorithm sig_alg in + (match signature_scheme_of_signature_algorithm sig_alg, private_key with + | `PSS, `RSA key -> + let module H = (val (Hash.module_of hash_alg)) in + let module PSS = Mirage_crypto_pk.Rsa.PSS(H) in + return (PSS.sign ~key (`Message to_sign)) + | `ECDSA, `P256 key -> + let hash = Hash.digest hash_alg to_sign in + return (ecdsa_sig_to_cstruct (Mirage_crypto_ec.P256.Dsa.sign ~key hash)) + | `ECDSA, `P384 key -> + let hash = Hash.digest hash_alg to_sign in + return (ecdsa_sig_to_cstruct (Mirage_crypto_ec.P384.Dsa.sign ~key hash)) + | `ECDSA, `P521 key -> + let hash = Hash.digest hash_alg to_sign in + return (ecdsa_sig_to_cstruct (Mirage_crypto_ec.P521.Dsa.sign ~key hash)) + | `EdDSA, `ED25519 key -> + return (Mirage_crypto_ec.Ed25519.sign ~key to_sign) + | _ -> fail (`Error (`NoConfiguredSignatureAlgorithm []))) >|= fun signature -> + Writer.assemble_digitally_signed_1_2 sig_alg signature end with Mirage_crypto_pk.Rsa.Insufficient_key -> fail (`Fatal `KeyTooSmall) -let peer_rsa_key = function +let peer_key = function | None -> fail (`Fatal `NoCertificateReceived) - | Some cert -> - match X509.Certificate.public_key cert with - | `RSA key -> return key - | _ -> fail (`Fatal `NotRSACertificate) + | Some cert -> return (X509.Certificate.public_key cert) let verify_digitally_signed version ?context_string sig_algs data signature_data certificate = - peer_rsa_key certificate >>= fun pubkey -> + peer_key certificate >>= fun pubkey -> - let decode_pkcs1_signature raw_signature = - match Mirage_crypto_pk.Rsa.PKCS1.sig_decode ~key:pubkey raw_signature with + let decode_pkcs1_signature key raw_signature = + match Mirage_crypto_pk.Rsa.PKCS1.sig_decode ~key raw_signature with | Some signature -> return signature - | None -> fail (`Fatal `RSASignatureVerificationFailed) + | None -> fail (`Fatal `SignatureVerificationFailed) in match version with | `TLS_1_0 | `TLS_1_1 -> ( match Reader.parse_digitally_signed data with | Ok signature -> - let compare_hashes should data = - let computed_sig = Hash.MD5.digest data <+> Hash.SHA1.digest data in - guard (Cs.equal should computed_sig) (`Fatal `RSASignatureMismatch) - in - decode_pkcs1_signature signature >>= fun raw -> - compare_hashes raw signature_data + begin match pubkey with + | `RSA key -> + let computed = + Hash.(MD5.digest signature_data <+> SHA1.digest signature_data) + in + decode_pkcs1_signature key signature >>= fun raw -> + guard (Cs.equal raw computed) (`Fatal `SignatureVerificationFailed) + | `P256 key -> + let hash = Hash.SHA1.digest signature_data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P256.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `P384 key -> + let hash = Hash.SHA1.digest signature_data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P384.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `P521 key -> + let hash = Hash.SHA1.digest signature_data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P521.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `ED25519 key -> + let msg = signature_data in + guard (Mirage_crypto_ec.Ed25519.verify ~key signature ~msg) + (`Fatal `SignatureVerificationFailed) + | _ -> Error (`Fatal `UnsupportedSignatureScheme) + end | Error re -> fail (`Fatal (`ReaderError re)) ) | `TLS_1_2 -> ( match Reader.parse_digitally_signed_1_2 data with | Ok (sig_alg, signature) -> guard (List.mem sig_alg sig_algs) (`Error (`NoConfiguredSignatureAlgorithm sig_algs)) >>= fun () -> let hash_algo = hash_of_signature_algorithm sig_alg in - begin match signature_scheme_of_signature_algorithm sig_alg with - | `PSS -> + begin match signature_scheme_of_signature_algorithm sig_alg, pubkey with + | `PSS, `RSA key -> let module H = (val (Hash.module_of hash_algo)) in let module PSS = Mirage_crypto_pk.Rsa.PSS(H) in - guard (PSS.verify ~key:pubkey ~signature (`Message signature_data)) - (`Fatal `RSASignatureMismatch) - | `PKCS1 -> + guard (PSS.verify ~key ~signature (`Message signature_data)) + (`Fatal `SignatureVerificationFailed) + | `PKCS1, `RSA key -> let compare_hashes should data = match X509.Certificate.decode_pkcs1_digest_info should with | Ok (hash_algo', target) when hash_algo = hash_algo' -> - guard (Crypto.digest_eq hash_algo ~target data) (`Fatal `RSASignatureMismatch) + let cs = Hash.digest hash_algo data in + guard (Cs.equal target cs) (`Fatal `SignatureVerificationFailed) | _ -> fail (`Fatal `HashAlgorithmMismatch) in - decode_pkcs1_signature signature >>= fun raw -> + decode_pkcs1_signature key signature >>= fun raw -> compare_hashes raw signature_data + | `ECDSA, `P256 key -> + let hash = Hash.digest hash_algo signature_data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P256.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `ECDSA, `P384 key -> + let hash = Hash.digest hash_algo signature_data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P384.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `ECDSA, `P521 key -> + let hash = Hash.digest hash_algo signature_data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P521.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `EdDSA, `ED25519 key -> + let msg = signature_data in + guard (Mirage_crypto_ec.Ed25519.verify ~key signature ~msg) + (`Fatal `SignatureVerificationFailed) + | _ -> fail (`Fatal `UnsupportedSignatureScheme) end | Error re -> fail (`Fatal (`ReaderError re)) ) | `TLS_1_3 -> @@ -434,17 +586,35 @@ let verify_digitally_signed version ?context_string sig_algs data signature_data | Ok (sig_alg, signature) -> guard (List.mem sig_alg sig_algs) (`Error (`NoConfiguredSignatureAlgorithm sig_algs)) >>= fun () -> let hash_algo = hash_of_signature_algorithm sig_alg in - begin match signature_scheme_of_signature_algorithm sig_alg with - | `PSS -> + let data = + let prefix = to_sign_1_3 context_string in + prefix <+> signature_data + in + begin match signature_scheme_of_signature_algorithm sig_alg, pubkey with + | `PSS, `RSA key -> let module H = (val (Hash.module_of hash_algo)) in let module PSS = Mirage_crypto_pk.Rsa.PSS(H) in - let data = - let prefix = to_sign_1_3 context_string in - prefix <+> signature_data - in - guard (PSS.verify ~key:pubkey ~signature (`Message data)) - (`Fatal `RSASignatureMismatch) - | `PKCS1 -> + guard (PSS.verify ~key ~signature (`Message data)) + (`Fatal `SignatureVerificationFailed) + | `ECDSA, `P256 key -> + let hash = Hash.digest hash_algo data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P256.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `ECDSA, `P384 key -> + let hash = Hash.digest hash_algo data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P384.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `ECDSA, `P521 key -> + let hash = Hash.digest hash_algo data in + ecdsa_sig_of_cstruct signature >>= fun s -> + guard (Mirage_crypto_ec.P521.Dsa.verify ~key s hash) + (`Fatal `SignatureVerificationFailed) + | `EdDSA, `ED25519 key -> + guard (Mirage_crypto_ec.Ed25519.verify ~key signature ~msg:data) + (`Fatal `SignatureVerificationFailed) + | _ -> fail (`Fatal `UnsupportedSignatureScheme) end | Error re -> fail (`Fatal (`ReaderError re))) @@ -458,8 +628,8 @@ let validate_chain authenticator certificates hostname = and key_size min cs = let check c = match X509.Certificate.public_key c with - | `RSA key when Mirage_crypto_pk.Rsa.pub_bits key >= min -> true - | _ -> false + | `RSA key -> Mirage_crypto_pk.Rsa.pub_bits key >= min + | _ -> true in guard (List.for_all check cs) (`Fatal `KeyTooSmall) diff --git a/lib/handshake_crypto.ml b/lib/handshake_crypto.ml index c201ee22..e6f2b675 100644 --- a/lib/handshake_crypto.ml +++ b/lib/handshake_crypto.ml @@ -22,7 +22,9 @@ let prf_mac = function | `RSA_WITH_AES_256_GCM_SHA384 | `DHE_RSA_WITH_AES_256_GCM_SHA384 | `ECDHE_RSA_WITH_AES_256_GCM_SHA384 - | `ECDHE_RSA_WITH_AES_256_CBC_SHA384 -> (module SHA384 : S) + | `ECDHE_RSA_WITH_AES_256_CBC_SHA384 + | `ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 + | `ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 -> (module SHA384 : S) | _ -> (module SHA256 : S) let pseudo_random_function version cipher len secret label seed = diff --git a/lib/handshake_server.ml b/lib/handshake_server.ml index 0676741a..a996b561 100644 --- a/lib/handshake_server.ml +++ b/lib/handshake_server.ml @@ -93,9 +93,9 @@ let answer_client_certificate_RSA state (session : session_data) certs raw log = let machina = AwaitClientKeyExchange_RSA (session, log @ [raw]) in ({ state with machina = Server machina }, []) -let answer_client_certificate_DHE_RSA state (session : session_data) dh_sent certs raw log = +let answer_client_certificate_DHE state (session : session_data) dh_sent certs raw log = validate_certs certs state.config.authenticator session >|= fun session -> - let machina = AwaitClientKeyExchange_DHE_RSA (session, dh_sent, log @ [raw]) in + let machina = AwaitClientKeyExchange_DHE (session, dh_sent, log @ [raw]) in ({ state with machina = Server machina }, []) let answer_client_certificate_verify state (session : session_data) sctx cctx verify raw log = @@ -119,18 +119,19 @@ let answer_client_key_exchange_RSA state (session : session_data) kex raw log = (* we do not provide an option to disable the version checking (yet!) *) match Cstruct.len k == 48, Reader.parse_any_version k with | true, Ok c_ver when c_ver = session.client_version -> k - | _ -> other + | _ -> other in - private_key session >|= fun priv -> - - let pms = match Mirage_crypto_pk.Rsa.PKCS1.decrypt ~key:priv kex with - | None -> validate_premastersecret other - | Some k -> validate_premastersecret k - in - establish_master_secret state session pms raw log + private_key session >>= function + | `RSA key -> + let pms = match Mirage_crypto_pk.Rsa.PKCS1.decrypt ~key kex with + | None -> validate_premastersecret other + | Some k -> validate_premastersecret k + in + return (establish_master_secret state session pms raw log) + | _ -> fail (`Fatal `NotRSACertificate) -let answer_client_key_exchange_DHE_RSA state session secret kex raw log = +let answer_client_key_exchange_DHE state session secret kex raw log = let to_fatal r = match r with Ok cs -> return cs | Error er -> fail (`Fatal (`ReaderError er)) in (let open Mirage_crypto_ec in match secret with @@ -175,18 +176,17 @@ let ecc_group configured_groups requested_groups = first_match requested_groups configured_groups let agreed_cipher cert ecc requested = - let type_usage_matches cipher = - let cstyp, csusage = - Ciphersuite.(required_keytype_and_usage @@ ciphersuite_kex cipher) + let usage_matches cipher = + let csusage = + Ciphersuite.(required_usage @@ ciphersuite_kex cipher) in - X509.(Certificate.supports_keytype cert cstyp && - supports_key_usage ~not_present:true cert csusage) + supports_key_usage ~not_present:true csusage cert in - let cciphers = List.filter type_usage_matches requested in + let cciphers = List.filter usage_matches requested in if ecc then cciphers else - List.filter (fun x -> not (Ciphersuite.ecc x)) cciphers + List.filter (fun x -> not (Ciphersuite.ecdhe x)) cciphers let server_hello config (client_hello : client_hello) (session : session_data) version reneg = (* RFC 4366: server shall reply with an empty hostname extension *) @@ -217,7 +217,7 @@ let server_hello config (client_hello : client_hello) (session : session_data) v | Some protocol -> [`ALPN protocol] and ecpointformat = match map_find ~f:(function `ECPointFormats -> Some () | _ -> None) client_hello.extensions with - | Some () when Ciphersuite.ecc session.ciphersuite -> [ `ECPointFormats ] + | Some () when Ciphersuite.ecdhe session.ciphersuite -> [ `ECPointFormats ] | _ -> [] in let sh = ServerHello @@ -244,7 +244,39 @@ let answer_client_hello_common state reneg ch raw = let ecc_group = ecc_group configured_ecc_groups groups and cciphers = List.filter (fun c -> not (Ciphersuite.ciphersuite_tls13 c)) cciphers in - (agreed_cert config.own_certificates host >>= function + let cciphers = List.filter (fun c -> List.mem c config.ciphers) cciphers in + let f = + (* from the ciphers, figure out: + - (a) RSA only (b) EC only + - (c) static RSA only (keyUsage = KeyEncipherment) (d) DHE only (keyUsage = DigitalSignature) + - (e) from the groups (they indicate the key type!) + *) + let kt_filter = + match List.partition (fun c -> Ciphersuite.ciphersuite_keytype c = `RSA) cciphers with + | _::_, [] -> begin fun s -> match X509.Certificate.public_key s with `RSA _ -> true | _ -> false end + | [], _::_ -> begin fun s -> match X509.Certificate.public_key s with `ED25519 _ | `P256 _ | `P384 _ | `P521 _ -> true | _ -> false end + | _, _ -> begin fun _s -> true end + in + let ku_filter = + match List.partition (fun c -> Ciphersuite.ciphersuite_kex c = `RSA) cciphers with + | _::_, [] -> supports_key_usage ~not_present:true `Key_encipherment + | [], _::_ -> supports_key_usage ~not_present:true `Digital_signature + | _ -> begin fun _ -> true end + in + let kt_matches_group s = + match X509.Certificate.public_key s with + | `RSA _ -> true + | `ED25519 _ -> List.mem `X25519 groups + | `P256 _ -> List.mem `P256 groups + | `P384 _ -> List.mem `P384 groups + | `P521 _ -> List.mem `P521 groups + | _ -> false + in + fun s -> + kt_filter s && ku_filter s && kt_matches_group s + in + let signature_algorithms = sig_algs ch in + (agreed_cert ~f ?signature_algorithms config.own_certificates host >>= function | (c::cs, priv) -> let cciphers = agreed_cipher c (ecc_group <> None) cciphers in return (cciphers, c::cs, Some priv) | ([], _) -> fail (`Fatal `InvalidSession) (* TODO: assert false / remove by types in config *) @@ -264,7 +296,7 @@ let answer_client_hello_common state reneg ch raw = let own_name = match host with None -> None | Some h -> Some (Domain_name.to_string h) in let group = - if Ciphersuite.ecc cipher then + if Ciphersuite.ecdhe cipher then ecc_group else match other_groups with | [] -> None @@ -306,12 +338,14 @@ let answer_client_hello_common state reneg ch raw = | Some _ -> let cas = List.map X509.Distinguished_name.encode_der config.acceptable_cas + and certs = + [ Packet.RSA_SIGN ; Packet.ECDSA_SIGN ] in (match version with | `TLS_1_0 | `TLS_1_1 -> - return (assemble_certificate_request [Packet.RSA_SIGN] cas) + return (assemble_certificate_request certs cas) | `TLS_1_2 -> - return (assemble_certificate_request_1_2 [Packet.RSA_SIGN] config.signature_algorithms cas) + return (assemble_certificate_request_1_2 certs config.signature_algorithms cas) | `TLS_1_3 -> (* TLS 1.3 handshakes are diverted in answer_client_hello, this will never be executed. for renegotiation, it is checked that the @@ -324,9 +358,9 @@ let answer_client_hello_common state reneg ch raw = let common_session_data = { session.common_session_data with client_auth = true } in ([ assemble_handshake certreq ], { session with common_session_data }) - and kex_dhe_rsa config (session : session_data) version sig_algs = + and kex_dhe config (session : session_data) version sig_algs = (match session.group with - | None -> fail (`Fatal `UnsupportedKeyExchange) (* should not happen *) + | None -> assert false (* can not happen *) | Some g -> let rng = Mirage_crypto_rng.generate in let open Mirage_crypto_ec in @@ -369,15 +403,15 @@ let answer_client_hello_common state reneg ch raw = cert_request state.protocol_version state.config session >>= fun (cert_req, session) -> ( match Ciphersuite.ciphersuite_kex session.ciphersuite with - | `DHE_RSA -> - kex_dhe_rsa state.config session state.protocol_version (sig_algs ch) >>= fun (kex, dh) -> + | #Ciphersuite.key_exchange_algorithm_dhe -> + kex_dhe state.config session state.protocol_version (sig_algs ch) >>= fun (kex, dh) -> let outs = sh :: certificates @ [ kex ] @ cert_req @ [ hello_done ] in let log = raw :: outs in let machina = if session.common_session_data.client_auth then - AwaitClientCertificate_DHE_RSA (session, dh, log) + AwaitClientCertificate_DHE (session, dh, log) else - AwaitClientKeyExchange_DHE_RSA (session, dh, log) + AwaitClientKeyExchange_DHE (session, dh, log) in Tracing.sexpf ~tag:"handshake-out" ~f:sexp_of_tls_handshake ServerHelloDone ; return (outs, machina) @@ -391,11 +425,7 @@ let answer_client_hello_common state reneg ch raw = AwaitClientKeyExchange_RSA (session, log) in Tracing.sexpf ~tag:"handshake-out" ~f:sexp_of_tls_handshake ServerHelloDone ; - return (outs, machina) - | _ -> - (* no support for PSK for 1.2 and below *) - fail (`Fatal `UnsupportedKeyExchange) - ) >|= fun (out_recs, machina) -> + return (outs, machina) ) >|= fun (out_recs, machina) -> ({ state with machina = Server machina }, [`Record (Packet.HANDSHAKE, Cs.appends out_recs)]) @@ -573,16 +603,16 @@ let handle_handshake ss hs buf = (match Reader.parse_certificates cs with | Ok cs -> answer_client_certificate_RSA hs session cs buf log | Error re -> fail (`Fatal (`ReaderError re))) - | AwaitClientCertificate_DHE_RSA (session, dh_sent, log), Certificate cs -> + | AwaitClientCertificate_DHE (session, dh_sent, log), Certificate cs -> (match Reader.parse_certificates cs with - | Ok cs -> answer_client_certificate_DHE_RSA hs session dh_sent cs buf log + | Ok cs -> answer_client_certificate_DHE hs session dh_sent cs buf log | Error re -> fail (`Fatal (`ReaderError re))) | AwaitClientKeyExchange_RSA (session, log), ClientKeyExchange cs -> (match Reader.parse_client_dh_key_exchange cs with | Ok kex -> answer_client_key_exchange_RSA hs session kex buf log | Error re -> fail (`Fatal (`ReaderError re))) - | AwaitClientKeyExchange_DHE_RSA (session, dh_sent, log), ClientKeyExchange kex -> - answer_client_key_exchange_DHE_RSA hs session dh_sent kex buf log + | AwaitClientKeyExchange_DHE (session, dh_sent, log), ClientKeyExchange kex -> + answer_client_key_exchange_DHE hs session dh_sent kex buf log | AwaitClientCertificateVerify (session, sctx, cctx, log), CertificateVerify ver -> answer_client_certificate_verify hs session sctx cctx ver buf log | AwaitClientFinished (session, log), Finished fin -> diff --git a/lib/handshake_server13.ml b/lib/handshake_server13.ml index a0b6d770..75e378dc 100644 --- a/lib/handshake_server13.ml +++ b/lib/handshake_server13.ml @@ -209,9 +209,13 @@ let answer_client_hello ~hrr state ch raw = let log = log <+> raw <+> sh_raw in let server_hs_secret, server_ctx, client_hs_secret, client_ctx = hs_ctx hs_secret log in - (* TODO: check sig_algs (better cert_sig_algs) whether we can present a - suitable certificate chain and signature *) - (agreed_cert config.Config.own_certificates hostname >>= function + ( match map_find ~f:(function `SignatureAlgorithms sa -> Some sa | _ -> None) ch.extensions with + | None -> fail (`Fatal (`InvalidClientHello `NoSignatureAlgorithmsExtension)) + | Some sa -> return sa ) >>= fun sigalgs -> + (* TODO respect certificate_signature_algs if present *) + + let f = supports_key_usage ~not_present:true `Digital_signature in + (agreed_cert ~f ~signature_algorithms:sigalgs config.Config.own_certificates hostname >>= function | (c::cs, priv) -> return (c::cs, priv) | _ -> fail (`Fatal `InvalidSession)) >>= fun (chain, priv) -> alpn_protocol config ch >>= fun alpn_protocol -> @@ -264,10 +268,6 @@ let answer_client_hello ~hrr state ch raw = Tracing.sexpf ~tag:"handshake-out" ~f:sexp_of_tls_handshake cert ; let log = log <+> cert_raw in - ( match map_find ~f:(function `SignatureAlgorithms sa -> Some sa | _ -> None) ch.extensions with - | None -> fail (`Fatal (`InvalidClientHello `NoSignatureAlgorithmsExtension)) - | Some sa -> return sa ) >>= fun sigalgs -> - (* TODO respect certificate_signature_algs if present *) let tbs = Mirage_crypto.Hash.digest (Ciphersuite.hash13 cipher) log in signature `TLS_1_3 ~context_string:"TLS 1.3, server CertificateVerify" tbs (Some sigalgs) config.Config.signature_algorithms priv >|= fun signed -> diff --git a/lib/packet.ml b/lib/packet.ml index d34901b4..5a17e9e1 100644 --- a/lib/packet.ml +++ b/lib/packet.ml @@ -197,8 +197,8 @@ type signature_alg = | RSA_PKCS1_SHA512 [@id 0x0601] | ECDSA_SECP256R1_SHA1 [@id 0x0203] (* deprecated, TLS 1.2 only *) | ECDSA_SECP256R1_SHA256 [@id 0x0403] - | ECDSA_SECP256R1_SHA384 [@id 0x0503] - | ECDSA_SECP256R1_SHA512 [@id 0x0603] + | ECDSA_SECP384R1_SHA384 [@id 0x0503] + | ECDSA_SECP521R1_SHA512 [@id 0x0603] | RSA_PSS_RSAENC_SHA256 [@id 0x0804] | RSA_PSS_RSAENC_SHA384 [@id 0x0805] | RSA_PSS_RSAENC_SHA512 [@id 0x0806] @@ -221,6 +221,11 @@ let to_signature_alg = function | `RSA_PSS_RSAENC_SHA256 -> RSA_PSS_RSAENC_SHA256 | `RSA_PSS_RSAENC_SHA384 -> RSA_PSS_RSAENC_SHA384 | `RSA_PSS_RSAENC_SHA512 -> RSA_PSS_RSAENC_SHA512 + | `ECDSA_SECP256R1_SHA1 -> ECDSA_SECP256R1_SHA1 + | `ECDSA_SECP256R1_SHA256 -> ECDSA_SECP256R1_SHA256 + | `ECDSA_SECP384R1_SHA384 -> ECDSA_SECP384R1_SHA384 + | `ECDSA_SECP521R1_SHA512 -> ECDSA_SECP521R1_SHA512 + | `ED25519 -> ED25519 let of_signature_alg = function | RSA_PKCS1_MD5 -> Some `RSA_PKCS1_MD5 @@ -232,6 +237,11 @@ let of_signature_alg = function | RSA_PSS_RSAENC_SHA256 -> Some `RSA_PSS_RSAENC_SHA256 | RSA_PSS_RSAENC_SHA384 -> Some `RSA_PSS_RSAENC_SHA384 | RSA_PSS_RSAENC_SHA512 -> Some `RSA_PSS_RSAENC_SHA512 + | ECDSA_SECP256R1_SHA1 -> Some `ECDSA_SECP256R1_SHA1 + | ECDSA_SECP256R1_SHA256 -> Some `ECDSA_SECP256R1_SHA256 + | ECDSA_SECP384R1_SHA384 -> Some `ECDSA_SECP384R1_SHA384 + | ECDSA_SECP521R1_SHA512 -> Some `ECDSA_SECP521R1_SHA512 + | ED25519 -> Some `ED25519 | _ -> None (* EC RFC4492*) diff --git a/lib/state.ml b/lib/state.ml index cc44d06a..5d3809a7 100644 --- a/lib/state.ml +++ b/lib/state.ml @@ -82,7 +82,7 @@ type common_session_data = { trust_anchor : Cert.t option ; received_certificates : Cert.t list ; own_certificate : Cert.t list ; - own_private_key : Mirage_crypto_pk.Rsa.priv option ; + own_private_key : Priv.t option ; own_name : string option ; client_auth : bool ; master_secret : master_secret ; @@ -104,9 +104,9 @@ type server_handshake_state = | AwaitClientHello (* initial state *) | AwaitClientHelloRenegotiate | AwaitClientCertificate_RSA of session_data * hs_log - | AwaitClientCertificate_DHE_RSA of session_data * dh_secret * hs_log + | AwaitClientCertificate_DHE of session_data * dh_secret * hs_log | AwaitClientKeyExchange_RSA of session_data * hs_log (* server hello done is sent, and RSA key exchange used, waiting for a client key exchange message *) - | AwaitClientKeyExchange_DHE_RSA of session_data * dh_secret * hs_log (* server hello done is sent, and DHE_RSA key exchange used, waiting for client key exchange *) + | AwaitClientKeyExchange_DHE of session_data * dh_secret * hs_log (* server hello done is sent, and DHE_RSA key exchange used, waiting for client key exchange *) | AwaitClientCertificateVerify of session_data * crypto_context * crypto_context * hs_log | AwaitClientChangeCipherSpec of session_data * crypto_context * crypto_context * hs_log (* client key exchange received, next should be change cipher spec *) | AwaitClientChangeCipherSpecResume of session_data * crypto_context * Cstruct_sexp.t * hs_log (* resumption: next should be change cipher spec *) @@ -121,8 +121,8 @@ type client_handshake_state = | AwaitServerHello of client_hello * (group * dh_secret) list * hs_log (* client hello is sent, handshake_params are half-filled *) | AwaitServerHelloRenegotiate of session_data * client_hello * hs_log (* client hello is sent, handshake_params are half-filled *) | AwaitCertificate_RSA of session_data * hs_log (* certificate expected with RSA key exchange *) - | AwaitCertificate_DHE_RSA of session_data * hs_log (* certificate expected with DHE_RSA key exchange *) - | AwaitServerKeyExchange_DHE_RSA of session_data * hs_log (* server key exchange expected with DHE_RSA *) + | AwaitCertificate_DHE of session_data * hs_log (* certificate expected with DHE key exchange *) + | AwaitServerKeyExchange_DHE of session_data * hs_log (* server key exchange expected with DHE *) | AwaitCertificateRequestOrServerHelloDone of session_data * Cstruct_sexp.t * Cstruct_sexp.t * hs_log (* server hello done expected, client key exchange and premastersecret are ready *) | AwaitServerHelloDone of session_data * signature_algorithm list option * Cstruct_sexp.t * Cstruct_sexp.t * hs_log (* server hello done expected, client key exchange and premastersecret are ready *) | AwaitServerChangeCipherSpec of session_data * crypto_context * Cstruct_sexp.t * hs_log (* change cipher spec expected *) @@ -262,10 +262,8 @@ type fatal = [ | `NoCertificateReceived | `NoCertificateVerifyReceived | `NotRSACertificate - | `NotRSASignature | `KeyTooSmall - | `RSASignatureMismatch - | `RSASignatureVerificationFailed + | `SignatureVerificationFailed | `UnsupportedSignatureScheme | `HashAlgorithmMismatch | `BadCertificateChain @@ -299,7 +297,6 @@ type fatal = [ | `MissingContentType | `Downgrade12 | `Downgrade11 - | `UnsupportedKeyExchange ] [@@deriving sexp] type failure = [ diff --git a/lwt/examples/ex_common.ml b/lwt/examples/ex_common.ml index 3b8271ba..e213a241 100644 --- a/lwt/examples/ex_common.ml +++ b/lwt/examples/ex_common.ml @@ -6,6 +6,8 @@ let o f g x = f (g x) let ca_cert_dir = "./certificates" let server_cert = "./certificates/server.pem" let server_key = "./certificates/server.key" +let server_ec_cert = "./certificates/server-ec.pem" +let server_ec_key = "./certificates/server-ec.key" let yap ~tag msg = Lwt_io.printf "(%s %s)\n%!" tag msg diff --git a/lwt/examples/test_server.ml b/lwt/examples/test_server.ml index 7014dca0..c0483f14 100644 --- a/lwt/examples/test_server.ml +++ b/lwt/examples/test_server.ml @@ -9,8 +9,12 @@ let serve_ssl port callback = X509_lwt.private_of_pems ~cert:server_cert ~priv_key:server_key >>= fun certificate -> + X509_lwt.private_of_pems + ~cert:server_ec_cert + ~priv_key:server_ec_key >>= fun ec_certificate -> + let certificates = `Multiple [ certificate ; ec_certificate ] in let config = - Tls.Config.(server ~version:(`TLS_1_0, `TLS_1_3) ~certificates:(`Single certificate) ~ciphers:Ciphers.supported ()) in + Tls.Config.(server ~version:(`TLS_1_0, `TLS_1_3) ~certificates ~ciphers:Ciphers.supported ()) in let server_s = let open Lwt_unix in diff --git a/lwt/tls_lwt.mli b/lwt/tls_lwt.mli index 4f4630a8..a1a1567d 100644 --- a/lwt/tls_lwt.mli +++ b/lwt/tls_lwt.mli @@ -111,7 +111,7 @@ val connect_ext : Tls.Config.client -> string * int -> (ic * oc) Lwt.t (** [connect authenticator (host, port)] is [ic, oc], the input and output channel of a TLS connection to [host] on [port] using the default configuration and the [authenticator]. *) -val connect : X509_lwt.authenticator -> string * int -> (ic * oc) Lwt.t +val connect : X509.Authenticator.t -> string * int -> (ic * oc) Lwt.t (** [of_t t] is [ic, oc], the input and output channel. [close] defaults to [!Unix.close]. *) diff --git a/lwt/x509_lwt.ml b/lwt/x509_lwt.ml index 3e2a32bd..cf8cb603 100644 --- a/lwt/x509_lwt.ml +++ b/lwt/x509_lwt.ml @@ -1,9 +1,5 @@ open Lwt -type priv = X509.Certificate.t list * Mirage_crypto_pk.Rsa.priv - -type authenticator = X509.Authenticator.t - let failure msg = fail @@ Failure msg let catch_invalid_arg th h = @@ -54,7 +50,7 @@ let private_of_pems ~cert ~priv_key = catch_invalid_arg (read_file priv_key >|= fun pem -> match X509.Private_key.decode_pem pem with - | Ok (`RSA key) -> key + | Ok key -> key | Error (`Msg m) -> invalid_arg ("failed to parse private key " ^ m)) (o failure @@ Printf.sprintf "Private key (%s): %s" priv_key) >>= fun pk -> return (certs, pk) diff --git a/lwt/x509_lwt.mli b/lwt/x509_lwt.mli index a92dd9c6..8e69426c 100644 --- a/lwt/x509_lwt.mli +++ b/lwt/x509_lwt.mli @@ -1,15 +1,9 @@ (** X.509 certificate handling using Lwt. *) -(** private material: a certificate chain and a RSA private key *) -type priv = X509.Certificate.t list * Mirage_crypto_pk.Rsa.priv - -(** authenticator *) -type authenticator = X509.Authenticator.t - (** [private_of_pems ~cert ~priv_key] is [priv], after reading the private key and certificate chain from the given PEM-encoded files. *) -val private_of_pems : cert:Lwt_io.file_name -> priv_key:Lwt_io.file_name -> priv Lwt.t +val private_of_pems : cert:Lwt_io.file_name -> priv_key:Lwt_io.file_name -> Tls.Config.certchain Lwt.t (** [certs_of_pem file] is [certificates], which are read from the PEM-encoded [file]. *) @@ -29,4 +23,4 @@ val authenticator : ?hash_whitelist:Mirage_crypto.Hash.hash list -> ?crls:Lwt_io | `Cert_fingerprints of Mirage_crypto.Hash.hash * ([`host] Domain_name.t * Cstruct.t) list | `Hex_cert_fingerprints of Mirage_crypto.Hash.hash * ([`host] Domain_name.t * string) list ] - -> authenticator Lwt.t + -> X509.Authenticator.t Lwt.t diff --git a/mirage/tls_mirage.ml b/mirage/tls_mirage.ml index 65b5744b..97bad4a5 100644 --- a/mirage/tls_mirage.ml +++ b/mirage/tls_mirage.ml @@ -248,7 +248,7 @@ module X509 (KV : Mirage_kv.RO) (C: Mirage_clock.PCLOCK) = struct read kv (Mirage_kv.Key.v (name ^ ".pem")) >>= decode_or_fail X509.Certificate.decode_pem_multiple >>= fun certs -> read kv (Mirage_kv.Key.v (name ^ ".key")) >>= - decode_or_fail X509.Private_key.decode_pem >|= fun (`RSA pk) -> + decode_or_fail X509.Private_key.decode_pem >|= fun pk -> (certs, pk) in function | `Default -> read default_cert | `Name name -> read name diff --git a/mirage/tls_mirage.mli b/mirage/tls_mirage.mli index da13ba13..ec8dddc2 100644 --- a/mirage/tls_mirage.mli +++ b/mirage/tls_mirage.mli @@ -67,5 +67,5 @@ module X509 (KV : Mirage_kv.RO) (C : Mirage_clock.PCLOCK) : sig (** [certificate store typ] unmarshals a certificate chain and private key material from the [store]. *) val certificate : KV.t -> [< `Default | `Name of string ] - -> (X509.Certificate.t list * Mirage_crypto_pk.Rsa.priv) Lwt.t + -> Tls.Config.certchain Lwt.t end diff --git a/tests/interop-openssl-sclient.sh b/tests/interop-openssl-sclient.sh index 94a334db..a2b935d4 100755 --- a/tests/interop-openssl-sclient.sh +++ b/tests/interop-openssl-sclient.sh @@ -46,7 +46,7 @@ testit extra_args="-tls1_3" testit -ciphers="DHE-RSA-AES256-SHA AES256-SHA DHE-RSA-AES128-SHA AES128-SHA ECDHE-RSA-AES256-SHA ECDHE-RSA-AES128-SHA" +ciphers="DHE-RSA-AES256-SHA AES256-SHA DHE-RSA-AES128-SHA AES128-SHA ECDHE-RSA-AES256-SHA ECDHE-RSA-AES128-SHA ECDHE-ECDSA-AES128-SHA ECDHE-ECDSA-AES256-SHA" #OpenSSL <1.1.1: #EDH-RSA-DES-CBC3-SHA DES-CBC3-SHA for i in $ciphers; do @@ -63,7 +63,7 @@ for i in $ciphers; do testit done -tls12_ciphers="DHE-RSA-AES256-SHA256 AES256-SHA256 DHE-RSA-AES128-SHA256 AES128-SHA256 AES128-GCM-SHA256 DHE-RSA-AES128-GCM-SHA256 AES256-GCM-SHA384 DHE-RSA-AES256-GCM-SHA384 ECDHE-RSA-AES256-GCM-SHA384 ECDHE-RSA-AES128-GCM-SHA256 ECDHE-RSA-AES256-SHA384 ECDHE-RSA-AES128-SHA256 ECDHE-RSA-CHACHA20-POLY1305 DHE-RSA-CHACHA20-POLY1305" +tls12_ciphers="DHE-RSA-AES256-SHA256 AES256-SHA256 DHE-RSA-AES128-SHA256 AES128-SHA256 AES128-GCM-SHA256 DHE-RSA-AES128-GCM-SHA256 AES256-GCM-SHA384 DHE-RSA-AES256-GCM-SHA384 ECDHE-RSA-AES256-GCM-SHA384 ECDHE-RSA-AES128-GCM-SHA256 ECDHE-RSA-AES256-SHA384 ECDHE-RSA-AES128-SHA256 ECDHE-RSA-CHACHA20-POLY1305 DHE-RSA-CHACHA20-POLY1305 ECDHE-ECDSA-AES128-SHA256 ECDHE-ECDSA-AES256-SHA384 ECDHE-ECDSA-AES128-GCM-SHA256 ECDHE-ECDSA-AES256-GCM-SHA384 ECDHE-ECDSA-CHACHA20-POLY1305" for i in $tls12_ciphers; do extra_args="-cipher $i" testit @@ -72,7 +72,6 @@ for i in $tls12_ciphers; do testit done -#add TLS_CHACHA20_POLY1305_SHA256 once we support it tls13_ciphers="TLS_AES_256_GCM_SHA384 TLS_AES_128_GCM_SHA256 TLS_CHACHA20_POLY1305_SHA256" for i in $tls13_ciphers; do extra_args="-ciphersuites $i" diff --git a/tests/interop-openssl-sserver.sh b/tests/interop-openssl-sserver.sh index 576e52db..a094f945 100755 --- a/tests/interop-openssl-sserver.sh +++ b/tests/interop-openssl-sserver.sh @@ -64,7 +64,56 @@ for i in $tls12_ciphers; do testit done -#add TLS_CHACHA20_POLY1305_SHA256 once we support it +tls13_ciphers="TLS_AES_256_GCM_SHA384 TLS_AES_128_GCM_SHA256 TLS_CHACHA20_POLY1305_SHA256" +for i in $tls13_ciphers; do + extra_args="-ciphersuites $i" + testit + + extra_args="-tls1_3 -ciphersuites $i" + testit +done + +s_server_args="s_server -quiet -key ../certificates/server-ec.key -cert ../certificates/server-ec.pem -www -dhparam dh.pem " +ec_ciphers="ECDHE-ECDSA-AES128-SHA ECDHE-ECDSA-AES256-SHA" +ec_ciphers12="ECDHE-ECDSA-AES128-SHA256 ECDHE-ECDSA-AES256-SHA384 ECDHE-ECDSA-AES128-GCM-SHA256 ECDHE-ECDSA-AES256-GCM-SHA384 ECDHE-ECDSA-CHACHA20-POLY1305" + +extra_args="" +testit + +extra_args="-tls1" +testit + +extra_args="-tls1_1" +testit + +extra_args="-tls1_2" +testit + +extra_args="-tls1_3" +testit + +for i in $ec_ciphers; do + extra_args="-cipher $i" + testit + + extra_args="-tls1 -cipher $i" + testit + + extra_args="-tls1_1 -cipher $i" + testit + + extra_args="-tls1_2 -cipher $i" + testit +done + +for i in $ec_ciphers12; do + extra_args="-cipher $i" + testit + + extra_args="-tls1_2 -cipher $i" + testit +done + tls13_ciphers="TLS_AES_256_GCM_SHA384 TLS_AES_128_GCM_SHA256 TLS_CHACHA20_POLY1305_SHA256" for i in $tls13_ciphers; do extra_args="-ciphersuites $i" diff --git a/tests/key_derivation.ml b/tests/key_derivation.ml index 9c612fc3..3a5fcbe2 100644 --- a/tests/key_derivation.ml +++ b/tests/key_derivation.ml @@ -520,7 +520,8 @@ let self_signature () = Tls.Handshake_common.signature `TLS_1_3 ~context_string:"TLS 1.3, server CertificateVerify" (Mirage_crypto.Hash.digest hash log) - None [ `RSA_PSS_RSAENC_SHA256 ] private_key + (Some [ `RSA_PSS_RSAENC_SHA256 ]) [ `RSA_PSS_RSAENC_SHA256 ] + (`RSA private_key) with | Error _ -> Alcotest.fail "expected sth" | Ok data -> diff --git a/tls.opam b/tls.opam index c2f38ce2..87668730 100644 --- a/tls.opam +++ b/tls.opam @@ -22,16 +22,16 @@ depends: [ "cstruct-sexp" "sexplib" "mirage-crypto" {>= "0.8.1"} + "mirage-crypto-ec" "mirage-crypto-pk" "mirage-crypto-rng" {>= "0.8.0"} - "x509" {>= "0.11.0"} + "x509" {>= "0.12.0"} "domain-name" {>= "0.3.0"} "fmt" "cstruct-unix" {with-test & >= "3.0.0"} "ounit2" {with-test & >= "2.2.0"} "lwt" {>= "3.0.0"} "ptime" {>= "0.8.1"} - "mirage-crypto-ec" "hkdf" "logs" "alcotest" {with-test}