-
Notifications
You must be signed in to change notification settings - Fork 68
/
handshake_client.ml
307 lines (267 loc) · 11.9 KB
/
handshake_client.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
open Nocrypto
open Utils
open Core
open State
open Handshake_common
open Config
let (<+>) = Cs.(<+>)
let default_client_hello config =
let host = match config.peer_name with
| None -> []
| Some x -> [Hostname (Some x)]
in
let version = max_protocol_version config.protocol_versions in
let signature_algos = match version with
| TLS_1_0 | TLS_1_1 -> []
| TLS_1_2 ->
let supported = List.map (fun h -> (h, Packet.RSA)) config.hashes in
[SignatureAlgorithms supported]
in
let ch = {
version = version ;
random = Rng.generate 32 ;
sessionid = None ;
ciphersuites = config.ciphers ;
extensions = host @ signature_algos
}
in
( ch , { server_random = Cstruct.create 0 ;
client_random = ch.random ;
client_version = ch.version ;
cipher = List.hd ch.ciphersuites })
let answer_server_hello state params ch (sh : server_hello) raw log =
let validate_version requested (lo, _) server_version =
match
requested >= server_version, server_version >= lo
with
| true, true -> return ()
| _ , _ -> fail Packet.PROTOCOL_VERSION
and validate_cipher suites suite =
match List.mem suite suites with
| true -> return ()
| false -> fail_handshake
and validate_reneg required reneg data =
match required, reneg, data with
| _ , None , Some x -> assure (Cs.null x)
| _ , Some (cvd, svd), Some x -> assure (Cs.equal (cvd <+> svd) x)
| false, _ , _ -> return ()
| true , _ , _ -> fail_handshake
in
let cfg = state.config in
assure (server_hello_valid sh &&
server_exts_subset_of_client sh.extensions ch.extensions)
>>= fun () ->
validate_version params.client_version state.config.protocol_versions sh.version >>= fun () ->
validate_cipher cfg.ciphers sh.ciphersuites >>= fun () ->
let reneg_data = get_secure_renegotiation sh.extensions in
validate_reneg cfg.secure_reneg state.reneg reneg_data >|= fun () ->
let machina =
let cipher = sh.ciphersuites in
let params = { params with server_random = sh.random ; cipher } in
Ciphersuite.(match ciphersuite_kex params.cipher with
| RSA -> AwaitCertificate_RSA (params, log @ [raw])
| DHE_RSA -> AwaitCertificate_DHE_RSA (params, log @ [raw]))
in
({ state with version = sh.version ; machina = Client machina }, [])
let validate_chain config cipher certificates =
let open Certificate in
let parse css =
match parse_stack css with
| None -> fail Packet.BAD_CERTIFICATE
| Some stack -> return stack
and validate validator server_name ((server_cert, _) as stack) =
match
X509.Validator.validate ?host:server_name validator stack
with
| `Fail SelfSigned -> fail Packet.UNKNOWN_CA
| `Fail NoTrustAnchor -> fail Packet.UNKNOWN_CA
| `Fail CertificateExpired -> fail Packet.CERTIFICATE_EXPIRED
| `Fail _ -> fail Packet.BAD_CERTIFICATE
| `Ok -> return server_cert
and validate_keytype cert ktype =
cert_type cert = ktype
and validate_usage cert usage =
match cert_usage cert with
| None -> true
| Some usages -> List.mem usage usages
and validate_ext_usage cert ext_use =
match cert_extended_usage cert with
| None -> true
| Some ext_usages -> List.mem ext_use ext_usages || List.mem `Any ext_usages
in
let key_size min cs =
let check c =
let open Asn_grammars in
( match Certificate.(asn_of_cert c).tbs_cert.pk_info with
| PK.RSA key when RSA.pub_bits key >= min -> true
| _ -> false )
in
guard (List.for_all check cs) Packet.INSUFFICIENT_SECURITY
in
let host = match config.peer_name with
| None -> None
| Some x -> Some (`Wildcard x)
in
(* RFC5246: must be x509v3, take signaturealgorithms into account! *)
(* RFC2246/4346: is generally x509v3, signing algorithm for certificate _must_ be same as algorithm for certificate key *)
match config.validator with
| None -> parse certificates >|= fun (server, _) ->
server
| Some validator -> parse certificates >>= fun (s, xs) ->
key_size Config.min_rsa_key_size (s :: xs) >>= fun () ->
validate validator host (s, xs) >>= fun cert ->
let keytype, usage =
Ciphersuite.(o required_keytype_and_usage ciphersuite_kex cipher)
in
guard (validate_keytype cert keytype &&
validate_usage cert usage &&
validate_ext_usage cert `Server_auth)
Packet.BAD_CERTIFICATE >|= fun () ->
cert
let peer_rsa_key cert =
let open Asn_grammars in
( match Certificate.(asn_of_cert cert).tbs_cert.pk_info with
| PK.RSA key -> return key
| _ -> fail_handshake )
let answer_certificate_RSA state params cs raw log =
validate_chain state.config params.cipher cs >>= fun cert ->
let ver = Writer.assemble_protocol_version params.client_version in
let premaster = ver <+> Rng.generate 46 in
peer_rsa_key cert >|= fun pubkey ->
let kex = RSA.PKCS1.encrypt pubkey premaster in
let machina = AwaitServerHelloDone (params, kex, premaster, log @ [raw]) in
({ state with machina = Client machina }, [])
let answer_certificate_DHE_RSA state params cs raw log =
validate_chain state.config params.cipher cs >|= fun cert ->
let machina = AwaitServerKeyExchange_DHE_RSA (params, cert, log @ [raw]) in
({ state with machina = Client machina }, [])
let answer_server_key_exchange_DHE_RSA state params cert kex raw log =
let open Reader in
let dh_params kex =
match parse_dh_parameters kex with
| Or_error.Ok data -> return data
| Or_error.Error _ -> fail_handshake
and signature_verifier version data =
match version with
| TLS_1_0 | TLS_1_1 ->
( match parse_digitally_signed data with
| Or_error.Ok signature ->
let compare_hashes should data =
let computed_sig = Hash.(MD5.digest data <+> SHA1.digest data) in
assure (Cs.equal should computed_sig)
in
return (signature, compare_hashes)
| Or_error.Error _ -> fail_handshake )
| TLS_1_2 ->
( match parse_digitally_signed_1_2 data with
| Or_error.Ok (hash_algo, Packet.RSA, signature) ->
let compare_hashes should data =
match Crypto.pkcs1_digest_info_of_cstruct should with
| Some (hash_algo', target) when hash_algo = hash_algo' ->
( match Crypto.hash_eq hash_algo ~target data with
| true -> return ()
| false -> fail_handshake )
| _ -> fail_handshake
in
return (signature, compare_hashes)
| _ -> fail_handshake )
and signature pubkey raw_signature =
match RSA.PKCS1.verify pubkey raw_signature with
| Some signature -> return signature
| None -> fail_handshake
in
dh_params kex >>= fun (dh_params, raw_dh_params, leftover) ->
signature_verifier state.version leftover >>= fun (raw_signature, verifier) ->
peer_rsa_key cert >>= fun pubkey ->
signature pubkey raw_signature >>= fun signature ->
let sigdata = params.client_random <+> params.server_random <+> raw_dh_params in
verifier signature sigdata >>= fun () ->
let group, shared = Crypto.dh_params_unpack dh_params in
guard (DH.apparent_bit_size group >= Config.min_dh_size) Packet.INSUFFICIENT_SECURITY
>>= fun () ->
let secret, kex = DH.gen_secret group in
match Crypto.dh_shared group secret shared with
| None -> fail Packet.INSUFFICIENT_SECURITY
| Some pms -> let machina = AwaitServerHelloDone (params, kex, pms, log @ [raw]) in
return ({ state with machina = Client machina }, [])
let answer_server_hello_done state params kex premaster raw log =
let kex = ClientKeyExchange kex in
let ckex = Writer.assemble_handshake kex in
let (ccst, ccs) = change_cipher_spec in
let client_ctx, server_ctx, master_secret =
Handshake_crypto.initialise_crypto_ctx state.version params premaster in
let to_fin = log @ [raw; ckex] in
let checksum = Handshake_crypto.finished state.version master_secret "client finished" to_fin in
let fin = Finished checksum in
let raw_fin = Writer.assemble_handshake fin in
let ps = to_fin @ [raw_fin] in
let machina = AwaitServerChangeCipherSpec (server_ctx, checksum, master_secret, ps)
in
Tracing.sexpf ~tag:"handshake-out" ~f:sexp_of_tls_handshake kex;
Tracing.cs ~tag:"change-cipher-spec-out" ccs ;
Tracing.cs ~tag:"master-secret" master_secret;
Tracing.sexpf ~tag:"handshake-out" ~f:sexp_of_tls_handshake fin;
return ({ state with machina = Client machina },
[`Record (Packet.HANDSHAKE, ckex);
`Record (ccst, ccs);
`Change_enc (Some client_ctx);
`Record (Packet.HANDSHAKE, raw_fin)])
let answer_server_finished state client_verify master_secret fin log =
let computed = Handshake_crypto.finished state.version master_secret "server finished" log in
assure (Cs.equal computed fin && Cs.null state.hs_fragment)
>|= fun () ->
let machina = Established in
let reneg = Some (client_verify, computed) in
({ state with machina = Client machina ; reneg }, [])
let answer_hello_request state =
let get_reneg_data optdata =
match optdata with
| None -> fail_handshake
| Some (cvd, _) -> return (SecureRenegotiation cvd)
and produce_client_hello config exts =
let dch, params = default_client_hello config in
let ch = { dch with
extensions = exts @ dch.extensions } in
let raw = Writer.assemble_handshake (ClientHello ch) in
let machina = AwaitServerHello (ch, params, [raw]) in
Tracing.sexpf ~tag:"handshake-out" ~f:sexp_of_tls_handshake (ClientHello ch) ;
({ state with machina = Client machina }, [`Record (Packet.HANDSHAKE, raw)])
in
if state.config.use_reneg then
get_reneg_data state.reneg >|= fun ext ->
produce_client_hello state.config [ext]
else
let no_reneg = Writer.assemble_alert ~level:Packet.WARNING Packet.NO_RENEGOTIATION in
return (state, [`Record (Packet.ALERT, no_reneg)])
let handle_change_cipher_spec cs state packet =
let open Reader in
match parse_change_cipher_spec packet, cs with
| Or_error.Ok (), AwaitServerChangeCipherSpec (server_ctx, client_verify, ms, log) ->
assure (Cs.null state.hs_fragment) >>= fun () ->
let machina = AwaitServerFinished (client_verify, ms, log) in
Tracing.cs ~tag:"change-cipher-spec-in" packet ;
return ({ state with machina = Client machina }, [], `Change_dec (Some server_ctx))
| _ ->
fail Packet.UNEXPECTED_MESSAGE
let handle_handshake cs hs buf =
let open Reader in
match parse_handshake buf with
| Or_error.Ok handshake ->
Tracing.sexpf ~tag:"handshake-in" ~f:sexp_of_tls_handshake handshake ;
( match cs, handshake with
| AwaitServerHello (ch, params, log), ServerHello sh ->
answer_server_hello hs params ch sh buf log
| AwaitCertificate_RSA (params, log), Certificate cs ->
answer_certificate_RSA hs params cs buf log
| AwaitCertificate_DHE_RSA (params, log), Certificate cs ->
answer_certificate_DHE_RSA hs params cs buf log
| AwaitServerKeyExchange_DHE_RSA (params, cert, log), ServerKeyExchange kex ->
answer_server_key_exchange_DHE_RSA hs params cert kex buf log
| AwaitServerHelloDone (params, kex, pms, log), ServerHelloDone ->
answer_server_hello_done hs params kex pms buf log
| AwaitServerFinished (client_verify, master, log), Finished fin ->
answer_server_finished hs client_verify master fin log
| Established, HelloRequest ->
answer_hello_request hs
| _, _ -> fail_handshake )
| Or_error.Error _ -> fail Packet.UNEXPECTED_MESSAGE