544 lines
22 KiB
OCaml
544 lines
22 KiB
OCaml
open Core
|
|
open State
|
|
open Handshake_common
|
|
open Config
|
|
|
|
let state_version state = match state.protocol_version with
|
|
| #tls_before_13 as v -> v
|
|
| _ -> assert false
|
|
|
|
let default_client_hello config =
|
|
let host = match config.peer_name with
|
|
| None -> []
|
|
| Some x -> [`Hostname x]
|
|
in
|
|
let version = max_protocol_version config.protocol_versions in
|
|
let ecc_groups = match List.filter Config.elliptic_curve config.groups with
|
|
| [] -> []
|
|
| xs -> [ `ECPointFormats ; `SupportedGroups (List.map group_to_named_group xs) ]
|
|
in
|
|
let extensions, secrets = match version with
|
|
| `TLS_1_0 | `TLS_1_1 -> (ecc_groups, [])
|
|
| `TLS_1_2 ->
|
|
(`SignatureAlgorithms config.signature_algorithms :: ecc_groups, [])
|
|
| `TLS_1_3 ->
|
|
let sig_alg = config.signature_algorithms (* TODO: filter deprecated ones *)
|
|
and groups = List.map group_to_named_group config.groups
|
|
and secrets, keyshares =
|
|
(* OTOH, we could send all the keyshares (but this is pretty substantial size) *)
|
|
(* instead we pick the first two groups and send keyshares *)
|
|
let rec gen c gs acc = match c with
|
|
| 0 -> List.rev acc
|
|
| _ -> match gs with
|
|
| [] -> List.rev acc (* TODO log? complain? *)
|
|
| g::gs' ->
|
|
let priv, share = Handshake_crypto13.dh_gen_key g in
|
|
let acc' = ((g, priv),(group_to_named_group g, share)) :: acc in
|
|
gen (pred c) gs' acc'
|
|
in
|
|
List.split (gen 2 config.groups [])
|
|
in
|
|
let all = all_versions config.protocol_versions in
|
|
let supported_versions = List.map (fun x -> (x :> tls_any_version)) all in
|
|
let point_format =
|
|
if min_protocol_version config.protocol_versions = `TLS_1_3 then
|
|
[]
|
|
else
|
|
[ `ECPointFormats ]
|
|
in
|
|
let exts =
|
|
point_format @ [`SignatureAlgorithms sig_alg ; `SupportedGroups groups ; `KeyShare keyshares ; `SupportedVersions supported_versions ]
|
|
in
|
|
(exts, secrets)
|
|
in
|
|
let alpn = match config.alpn_protocols with
|
|
| [] -> []
|
|
| protocols -> [`ALPN protocols]
|
|
in
|
|
let sessionid =
|
|
match config.use_reneg, config.cached_session with
|
|
| _, Some { session_id ; extended_ms ; _ } when extended_ms && not (String.length session_id = 0) -> Some session_id
|
|
| false, Some { session_id ; _ } when not (String.length session_id = 0) -> Some session_id
|
|
| _ -> None
|
|
in
|
|
let ch = {
|
|
client_version = (version :> tls_any_version) ;
|
|
client_random = Mirage_crypto_rng.generate 32 ;
|
|
sessionid = sessionid ;
|
|
ciphersuites = List.map Ciphersuite.ciphersuite_to_any_ciphersuite config.ciphers ;
|
|
extensions = `ExtendedMasterSecret :: host @ extensions @ alpn
|
|
}
|
|
in
|
|
(ch, version, secrets)
|
|
|
|
let common_server_hello_validation config reneg (sh : server_hello) (ch : client_hello) =
|
|
let validate_reneg data =
|
|
let err = `Fatal (`Handshake (`Message "invalid renegotiation")) in
|
|
match reneg, data with
|
|
| Some (cvd, svd), Some x -> guard (String.equal (cvd ^ svd) x) err
|
|
| Some _, None -> Error err
|
|
| None, Some x -> guard (String.length x = 0) err
|
|
| None, None -> Ok ()
|
|
in
|
|
let* () =
|
|
guard (List.mem sh.ciphersuite config.ciphers)
|
|
(`Error (`NoConfiguredCiphersuite [sh.ciphersuite]))
|
|
in
|
|
let* () =
|
|
guard (server_hello_valid sh &&
|
|
server_exts_subset_of_client sh.extensions ch.extensions)
|
|
(`Fatal `Unsupported_extension)
|
|
in
|
|
let* () =
|
|
match get_alpn_protocol sh with
|
|
| None -> Ok ()
|
|
| Some x ->
|
|
guard (List.mem x config.alpn_protocols) (`Fatal `Unsupported_extension)
|
|
in
|
|
validate_reneg (get_secure_renegotiation sh.extensions)
|
|
|
|
let common_server_hello_machina state (sh : server_hello) (ch : client_hello) raw log =
|
|
let cipher = sh.ciphersuite in
|
|
let session_id = Option.value ~default:"" sh.sessionid in
|
|
let extended_ms =
|
|
List.mem `ExtendedMasterSecret ch.extensions &&
|
|
List.mem `ExtendedMasterSecret sh.extensions
|
|
in
|
|
let alpn_protocol = get_alpn_protocol sh in
|
|
let session =
|
|
let session = empty_session in
|
|
let common_session_data = {
|
|
session.common_session_data with
|
|
client_random = ch.client_random ;
|
|
server_random = sh.server_random ;
|
|
alpn_protocol ;
|
|
} in {
|
|
session with
|
|
common_session_data ;
|
|
ciphersuite = cipher ;
|
|
session_id ;
|
|
extended_ms ;
|
|
client_version = ch.client_version ;
|
|
}
|
|
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 }, [])
|
|
|
|
let answer_server_hello state (ch : client_hello) sh secrets raw log =
|
|
let validate_version requested (lo, _) server_version =
|
|
guard (version_ge requested server_version && server_version >= lo)
|
|
(`Error (`NoConfiguredVersions [ server_version ]))
|
|
in
|
|
|
|
let cfg = state.config in
|
|
let* () = common_server_hello_validation cfg None sh ch in
|
|
let* () = validate_version ch.client_version state.config.protocol_versions sh.server_version in
|
|
|
|
let* () =
|
|
if max_protocol_version state.config.protocol_versions = `TLS_1_3 then
|
|
let* () =
|
|
guard (not (Utils.sub_equal ~off:24 ~len:8 Packet.downgrade12 sh.server_random))
|
|
(`Fatal (`Handshake (`Message "random contains downgrade TLS 1.2")))
|
|
in
|
|
guard (not (Utils.sub_equal ~off:24 ~len:8 Packet.downgrade11 sh.server_random))
|
|
(`Fatal (`Handshake (`Message "random contains downgrade TLS 1.1")))
|
|
else
|
|
Ok ()
|
|
in
|
|
|
|
let epoch_matches (epoch : epoch_data) =
|
|
epoch.ciphersuite = sh.ciphersuite &&
|
|
epoch.protocol_version = sh.server_version &&
|
|
Option.fold ~none:false ~some:(SessionID.equal epoch.session_id) sh.sessionid &&
|
|
(not cfg.use_reneg ||
|
|
(List.mem `ExtendedMasterSecret sh.extensions && epoch.extended_ms))
|
|
in
|
|
|
|
Tracing.debug (fun m -> m "version %a" pp_tls_version sh.server_version) ;
|
|
trace_cipher sh.ciphersuite ;
|
|
|
|
let state = { state with protocol_version = sh.server_version } in
|
|
match sh.server_version with
|
|
| #tls13 ->
|
|
Handshake_client13.answer_server_hello state ch sh secrets raw (String.concat "" log)
|
|
| #tls_before_13 as v ->
|
|
match state.config.cached_session with
|
|
| Some epoch when epoch_matches epoch ->
|
|
let session =
|
|
let session = session_of_epoch epoch in
|
|
let common_session_data = {
|
|
session.common_session_data with
|
|
client_random = ch.client_random ;
|
|
server_random = sh.server_random ;
|
|
client_auth = match epoch.own_certificate with [] -> false | _ -> true ;
|
|
} in
|
|
{ session with
|
|
common_session_data ;
|
|
client_version = ch.client_version ;
|
|
}
|
|
in
|
|
let client_ctx, server_ctx =
|
|
Handshake_crypto.initialise_crypto_ctx v session
|
|
in
|
|
let machina = AwaitServerChangeCipherSpecResume (session, client_ctx, server_ctx, log @ [raw]) in
|
|
Ok ({ state with machina = Client machina }, [])
|
|
| _ -> common_server_hello_machina state sh ch raw log
|
|
|
|
let answer_server_hello_renegotiate state session (ch : client_hello) sh raw log =
|
|
let* () = common_server_hello_validation state.config (Some session.renegotiation) sh ch in
|
|
let* () =
|
|
guard (state.protocol_version = sh.server_version)
|
|
(`Fatal (`Handshake (`Message "invalid renegotiation version")))
|
|
in
|
|
common_server_hello_machina state sh ch raw log
|
|
|
|
let validate_keyusage certificate kex =
|
|
let usage = Ciphersuite.required_usage kex in
|
|
let* cert =
|
|
Option.to_result ~none:(`Fatal (`Bad_certificate "none received")) certificate
|
|
in
|
|
let* () =
|
|
guard (supports_key_usage ~not_present:true usage cert)
|
|
(`Fatal (`Bad_certificate "key usage"))
|
|
in
|
|
guard
|
|
(supports_extended_key_usage `Server_auth cert ||
|
|
supports_extended_key_usage ~not_present:true `Any cert)
|
|
(`Fatal (`Bad_certificate "extended key usage"))
|
|
|
|
let answer_certificate_RSA state (session : session_data) cs raw log =
|
|
let cfg = state.config in
|
|
let* peer_certificate, received_certificates, peer_certificate_chain, trust_anchor =
|
|
validate_chain cfg.authenticator cs cfg.ip cfg.peer_name
|
|
in
|
|
let* () = validate_keyusage peer_certificate `RSA in
|
|
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* version =
|
|
match session.client_version with
|
|
| `TLS_1_3 -> Ok `TLS_1_2
|
|
| #tls_before_13 as v -> Ok v
|
|
| _ -> assert false
|
|
in
|
|
let buf = Bytes.create (2 + 46) in
|
|
let _ver = Writer.assemble_protocol_version ~buf version in
|
|
Mirage_crypto_rng.generate_into buf ~off:2 46;
|
|
let premaster = Bytes.unsafe_to_string buf in
|
|
let* k = peer_key peer_certificate in
|
|
match k with
|
|
| `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
|
|
Ok ({ state with machina = Client machina }, [])
|
|
| _ -> Error (`Fatal (`Bad_certificate "not an RSA certificate"))
|
|
|
|
let answer_certificate_DHE state (session : session_data) cs raw log =
|
|
let cfg = state.config in
|
|
let* peer_certificate, received_certificates, peer_certificate_chain, trust_anchor =
|
|
validate_chain cfg.authenticator cs cfg.ip cfg.peer_name
|
|
in
|
|
let* () = validate_keyusage peer_certificate `FFDHE in
|
|
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 (session, log @ [raw]) in
|
|
Ok ({ state with machina = Client machina }, [])
|
|
|
|
let answer_server_key_exchange_DHE state (session : session_data) kex raw log =
|
|
let* group, shared, raw_dh_params, leftover =
|
|
if Ciphersuite.ecdhe session.ciphersuite then
|
|
let* g, share, raw, left =
|
|
map_reader_error (Reader.parse_ec_parameters kex)
|
|
in
|
|
Ok (`Ec g, share, raw, left)
|
|
else
|
|
let unpack_dh dh_params =
|
|
Result.map_error
|
|
(function `Msg m -> `Fatal (`Decode m))
|
|
(Crypto.dh_params_unpack dh_params)
|
|
in
|
|
let* dh_params, raw_dh_params, leftover =
|
|
map_reader_error (Reader.parse_dh_parameters kex)
|
|
in
|
|
let* group, shared = unpack_dh dh_params in
|
|
let* () =
|
|
guard (Mirage_crypto_pk.Dh.modulus_size group >= Config.min_dh_size)
|
|
(`Fatal (`Handshake (`BadDH "too small")))
|
|
in
|
|
Ok (`Finite_field group, shared, raw_dh_params, leftover)
|
|
in
|
|
|
|
let sigdata =
|
|
String.concat "" [
|
|
session.common_session_data.client_random ;
|
|
session.common_session_data.server_random ;
|
|
raw_dh_params
|
|
]
|
|
in
|
|
let* () =
|
|
verify_digitally_signed state.protocol_version
|
|
state.config.signature_algorithms leftover sigdata
|
|
session.common_session_data.peer_certificate
|
|
in
|
|
|
|
let* pms, kex =
|
|
let open Mirage_crypto_ec in
|
|
let map_ecdh_error =
|
|
Result.map_error (fun e -> `Fatal (`Handshake (`BadECDH e)))
|
|
in
|
|
match group with
|
|
| `Finite_field g ->
|
|
let secret, client_share = Mirage_crypto_pk.Dh.gen_key g in
|
|
let* pms =
|
|
Option.to_result
|
|
~none:(`Fatal (`Handshake (`BadDH "invalid FF")))
|
|
(Mirage_crypto_pk.Dh.shared secret shared)
|
|
in
|
|
Ok (pms, Writer.assemble_client_dh_key_exchange client_share)
|
|
| `Ec `P256 ->
|
|
let secret, client_share = P256.Dh.gen_key () in
|
|
let* pms = map_ecdh_error (P256.Dh.key_exchange secret shared) in
|
|
Ok (pms, Writer.assemble_client_ec_key_exchange client_share)
|
|
| `Ec `P384 ->
|
|
let secret, client_share = P384.Dh.gen_key () in
|
|
let* pms = map_ecdh_error (P384.Dh.key_exchange secret shared) in
|
|
Ok (pms, Writer.assemble_client_ec_key_exchange client_share)
|
|
| `Ec `P521 ->
|
|
let secret, client_share = P521.Dh.gen_key () in
|
|
let* pms = map_ecdh_error (P521.Dh.key_exchange secret shared) in
|
|
Ok (pms, Writer.assemble_client_ec_key_exchange client_share)
|
|
| `Ec `X25519 ->
|
|
let secret, client_share = X25519.gen_key () in
|
|
let* pms = map_ecdh_error (X25519.key_exchange secret shared) in
|
|
Ok (pms, Writer.assemble_client_ec_key_exchange client_share)
|
|
in
|
|
let machina =
|
|
AwaitCertificateRequestOrServerHelloDone
|
|
(session, kex, pms, log @ [raw])
|
|
in
|
|
Ok ({ state with machina = Client machina }, [])
|
|
|
|
let answer_certificate_request state (session : session_data) cr kex pms raw log =
|
|
let cfg = state.config in
|
|
let* _types, sigalgs, _cas =
|
|
match state_version state with
|
|
| `TLS_1_0 | `TLS_1_1 ->
|
|
let* types, cas =
|
|
map_reader_error (Reader.parse_certificate_request cr)
|
|
in
|
|
Ok (types, None, cas)
|
|
| `TLS_1_2 ->
|
|
let* types, sigalgs, cas =
|
|
map_reader_error (Reader.parse_certificate_request_1_2 cr)
|
|
in
|
|
Ok (types, Some sigalgs, cas)
|
|
in
|
|
(* TODO: respect _types and _cas, multiple client certificates *)
|
|
let own_certificate, own_private_key =
|
|
match cfg.own_certificates with
|
|
| `Single (chain, priv) -> (chain, Some priv)
|
|
| _ -> ([], None)
|
|
in
|
|
let session =
|
|
let common_session_data = {
|
|
session.common_session_data with
|
|
own_certificate ;
|
|
own_private_key ;
|
|
client_auth = true
|
|
} in
|
|
{ session with common_session_data }
|
|
in
|
|
let machina = AwaitServerHelloDone (session, sigalgs, kex, pms, log @ [raw]) in
|
|
Ok ({ state with machina = Client machina }, [])
|
|
|
|
let answer_server_hello_done state (session : session_data) sigalgs kex premaster raw log =
|
|
let kex = ClientKeyExchange kex in
|
|
let ckex = Writer.assemble_handshake kex in
|
|
|
|
let* msgs, raw_msgs, raws, cert_verify =
|
|
match session.common_session_data.client_auth, session.common_session_data.own_private_key with
|
|
| true, Some p ->
|
|
let cs = List.map X509.Certificate.encode_der session.common_session_data.own_certificate in
|
|
let cert = Certificate (Writer.assemble_certificates cs) in
|
|
let ccert = Writer.assemble_handshake cert in
|
|
let to_sign = log @ [ raw ; ccert ; ckex ] in
|
|
let data = String.concat "" to_sign in
|
|
let ver = state.protocol_version
|
|
and my_sigalgs = state.config.signature_algorithms in
|
|
let* signature = signature ver data sigalgs my_sigalgs p in
|
|
let cert_verify = CertificateVerify signature in
|
|
let ccert_verify = Writer.assemble_handshake cert_verify in
|
|
Ok ([ cert ; kex ; cert_verify ],
|
|
[ ccert ; ckex ; ccert_verify ],
|
|
to_sign, Some ccert_verify)
|
|
| true, None ->
|
|
let cert = Certificate (Writer.assemble_certificates []) in
|
|
let ccert = Writer.assemble_handshake cert in
|
|
Ok ([cert ; kex], [ccert ; ckex], log @ [ raw ; ccert ; ckex ], None)
|
|
| false, _ ->
|
|
Ok ([kex], [ckex], log @ [ raw ; ckex ], None)
|
|
in
|
|
|
|
let to_fin = raws @ Option.to_list cert_verify in
|
|
|
|
let master_secret =
|
|
Handshake_crypto.derive_master_secret (state_version state) session premaster raws
|
|
in
|
|
let session =
|
|
let common_session_data = { session.common_session_data with master_secret } in
|
|
{ session with common_session_data }
|
|
in
|
|
let client_ctx, server_ctx =
|
|
Handshake_crypto.initialise_crypto_ctx (state_version state) session
|
|
in
|
|
|
|
let checksum = Handshake_crypto.finished (state_version state) session.ciphersuite master_secret "client finished" to_fin in
|
|
let fin = Finished checksum in
|
|
let raw_fin = Writer.assemble_handshake fin in
|
|
let session = { session with tls_unique = checksum } in
|
|
let ps = to_fin @ [raw_fin] in
|
|
|
|
let session =
|
|
let common_session_data = { session.common_session_data with master_secret } in
|
|
{ session with common_session_data }
|
|
in
|
|
let machina = AwaitServerChangeCipherSpec (session, server_ctx, checksum, ps)
|
|
and ccst, ccs = change_cipher_spec in
|
|
|
|
List.iter (Tracing.hs ~tag:"handshake-out") msgs;
|
|
Tracing.cs ~tag:"change-cipher-spec-out" ccs ;
|
|
Tracing.cs ~tag:"master-secret" master_secret;
|
|
Tracing.hs ~tag:"handshake-out" fin;
|
|
|
|
Ok ({ state with machina = Client machina },
|
|
List.map (fun x -> `Record (Packet.HANDSHAKE, x)) raw_msgs @
|
|
[ `Record (ccst, ccs);
|
|
`Change_enc client_ctx;
|
|
`Record (Packet.HANDSHAKE, raw_fin)])
|
|
|
|
let answer_server_finished state (session : session_data) client_verify fin log =
|
|
let computed =
|
|
Handshake_crypto.finished (state_version state) session.ciphersuite session.common_session_data.master_secret "server finished" log
|
|
in
|
|
let* () =
|
|
guard (String.equal computed fin)
|
|
(`Fatal (`Handshake (`Message "couldn't verify finished")))
|
|
in
|
|
let* () =
|
|
guard (String.length state.hs_fragment = 0) (`Fatal (`Handshake `Fragments))
|
|
in
|
|
let machina = Established
|
|
and session = { session with renegotiation = (client_verify, computed) } in
|
|
Ok ({ state with machina = Client machina ; session = `TLS session :: state.session }, [])
|
|
|
|
let answer_server_finished_resume state (session : session_data) fin raw log =
|
|
let client, server =
|
|
let checksum = Handshake_crypto.finished (state_version state) session.ciphersuite session.common_session_data.master_secret in
|
|
(checksum "client finished" (log @ [raw]), checksum "server finished" log)
|
|
in
|
|
let* () =
|
|
guard (String.equal server fin)
|
|
(`Fatal (`Handshake (`Message "couldn't verify finished")))
|
|
in
|
|
let session = { session with tls_unique = server } in
|
|
let* () =
|
|
guard (String.length state.hs_fragment = 0)
|
|
(`Fatal (`Handshake `Fragments))
|
|
in
|
|
let machina = Established
|
|
and session = { session with renegotiation = (client, server) }
|
|
in
|
|
let finished = Finished client in
|
|
let raw_finished = Writer.assemble_handshake finished in
|
|
Tracing.hs ~tag:"handshake-out" finished ;
|
|
Ok ({ state with machina = Client machina ; session = `TLS session :: state.session },
|
|
[`Record (Packet.HANDSHAKE, raw_finished)])
|
|
|
|
let answer_hello_request state =
|
|
let produce_client_hello session config exts =
|
|
let dch, _, _ = default_client_hello config in
|
|
let ch = { dch with extensions = dch.extensions @ exts ; sessionid = None } in
|
|
let raw = Writer.assemble_handshake (ClientHello ch) in
|
|
let machina = AwaitServerHelloRenegotiate (session, ch, [raw]) in
|
|
Tracing.hs ~tag:"handshake-out" (ClientHello ch) ;
|
|
({ state with machina = Client machina }, [`Record (Packet.HANDSHAKE, raw)])
|
|
in
|
|
|
|
match state.config.use_reneg, state.session with
|
|
| true , `TLS x :: _ ->
|
|
let ext = `SecureRenegotiation (fst x.renegotiation) in
|
|
Ok (produce_client_hello x state.config [ext])
|
|
| true , _ -> Error (`Fatal (`Handshake (`Message "couldn't find session")))
|
|
| false, _ ->
|
|
let no_reneg = Writer.assemble_alert ~level:Packet.WARNING Packet.NO_RENEGOTIATION in
|
|
Tracing.debug (fun m -> m "alert-out (warning, no_renegotiation)") ;
|
|
Ok (state, [`Record (Packet.ALERT, no_reneg)])
|
|
|
|
let handle_change_cipher_spec cs state packet =
|
|
let* () = map_reader_error (Reader.parse_change_cipher_spec packet) in
|
|
match cs with
|
|
| AwaitServerChangeCipherSpec (session, server_ctx, client_verify, log) ->
|
|
let* () =
|
|
guard (String.length state.hs_fragment = 0)
|
|
(`Fatal (`Handshake `Fragments))
|
|
in
|
|
let machina = AwaitServerFinished (session, client_verify, log) in
|
|
Tracing.cs ~tag:"change-cipher-spec-in" packet ;
|
|
Ok ({ state with machina = Client machina }, [`Change_dec server_ctx])
|
|
| AwaitServerChangeCipherSpecResume (session, client_ctx, server_ctx, log) ->
|
|
let* () =
|
|
guard (String.length state.hs_fragment = 0)
|
|
(`Fatal (`Handshake `Fragments))
|
|
in
|
|
let ccs = change_cipher_spec in
|
|
let machina = AwaitServerFinishedResume (session, log) in
|
|
Tracing.cs ~tag:"change-cipher-spec-in" packet ;
|
|
Tracing.cs ~tag:"change-cipher-spec-out" packet ;
|
|
Ok ({ state with machina = Client machina },
|
|
[`Record ccs ; `Change_enc client_ctx; `Change_dec server_ctx])
|
|
| _ -> Error (`Fatal (`Unexpected (`Message "change cipher spec")))
|
|
|
|
let handle_handshake cs hs buf =
|
|
let* handshake = map_reader_error (Reader.parse_handshake buf) in
|
|
Tracing.hs ~tag:"handshake-in" handshake ;
|
|
match cs, handshake with
|
|
| AwaitServerHello (ch, secrets, log), ServerHello sh ->
|
|
answer_server_hello hs ch sh secrets buf log
|
|
| AwaitServerHello (ch, secrets, log), HelloRetryRequest hrr ->
|
|
Handshake_client13.answer_hello_retry_request hs ch hrr secrets buf (String.concat "" log)
|
|
| AwaitServerHelloRenegotiate (session, ch, log), ServerHello sh ->
|
|
answer_server_hello_renegotiate hs session ch sh buf log
|
|
| AwaitCertificate_RSA (session, log), Certificate cs ->
|
|
let* cs = map_reader_error (Reader.parse_certificates cs) in
|
|
answer_certificate_RSA hs session cs buf log
|
|
| AwaitCertificate_DHE (session, log), Certificate cs ->
|
|
let* cs = map_reader_error (Reader.parse_certificates cs) in
|
|
answer_certificate_DHE hs session cs 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 ->
|
|
answer_server_hello_done hs session None kex pms buf log
|
|
| AwaitServerHelloDone (session, sigalgs, kex, pms, log), ServerHelloDone ->
|
|
answer_server_hello_done hs session sigalgs kex pms buf log
|
|
| AwaitServerFinished (session, client_verify, log), Finished fin ->
|
|
answer_server_finished hs session client_verify fin log
|
|
| AwaitServerFinishedResume (session, log), Finished fin ->
|
|
answer_server_finished_resume hs session fin buf log
|
|
| Established, HelloRequest ->
|
|
answer_hello_request hs
|
|
| _, hs -> Error (`Fatal (`Unexpected (`Handshake hs)))
|