From 8c003113a9ae451e88062d6da5e8cafe46ceca40 Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Wed, 28 Jul 2021 15:33:11 +0200 Subject: [PATCH] use Cstruct.length instead of deprecated Cstruct.len, requires cstruct >= 6.0.0 --- async/io.ml | 4 +- async/session.ml | 2 +- lib/core.ml | 2 +- lib/crypto.ml | 6 +- lib/engine.ml | 34 ++++----- lib/handshake_client.ml | 14 ++-- lib/handshake_client13.ml | 12 ++-- lib/handshake_crypto.ml | 2 +- lib/handshake_crypto13.ml | 10 +-- lib/handshake_server.ml | 18 ++--- lib/handshake_server13.ml | 10 +-- lib/reader.ml | 144 ++++++++++++++++++------------------- lib/writer.ml | 56 +++++++-------- lwt/tls_lwt.ml | 6 +- tests/key_derivation.ml | 2 +- tests/readertests.ml | 12 ++-- tests/readerwritertests.ml | 8 +-- tls.opam | 2 +- 18 files changed, 172 insertions(+), 172 deletions(-) diff --git a/async/io.ml b/async/io.ml index 7a177ba3..fe3704f7 100644 --- a/async/io.ml +++ b/async/io.ml @@ -72,8 +72,8 @@ module Make (Fd : Fd) : S with module Fd := Fd = struct let rec read t buf = let writeout res = let open Cstruct in - let rlen = len res in - let n = min (len buf) rlen in + let rlen = length res in + let n = min (length buf) rlen in blit res 0 buf 0 n; t.linger <- (if n < rlen then Some (sub res n (rlen - n)) else None); return n diff --git a/async/session.ml b/async/session.ml index 2d9065cb..665a7a95 100644 --- a/async/session.ml +++ b/async/session.ml @@ -16,7 +16,7 @@ module Fd = struct let rec write_full fd buf = let open Deferred.Or_error.Let_syntax in - match Cstruct.len buf with + match Cstruct.length buf with | 0 -> return () | len -> let%bind () = write fd buf in diff --git a/lib/core.ml b/lib/core.ml index d9641edb..80f0466b 100644 --- a/lib/core.ml +++ b/lib/core.ml @@ -112,7 +112,7 @@ type psk_identity = (Cstruct_sexp.t * int32) * Cstruct_sexp.t [@@deriving sexp_o let binders_len psks = let binder_len (_, binder) = - Cstruct.len binder + 1 (* binder len *) + Cstruct.length binder + 1 (* binder len *) in 2 (* binder len *) + List.fold_left (+) 0 (List.map binder_len psks) diff --git a/lib/crypto.ml b/lib/crypto.ml index dda12a66..25e8492b 100644 --- a/lib/crypto.ml +++ b/lib/crypto.ml @@ -73,7 +73,7 @@ let sequence_buf seq = let aead_nonce nonce seq = let s = - let l = Cstruct.len nonce in + let l = Cstruct.length nonce in let s = sequence_buf seq in let pad = Cstruct.create (l - 8) in pad <+> s @@ -114,7 +114,7 @@ let cbc_pad block data = let open Cstruct in (* 1 is the padding length, encoded as 8 bit at the end of the fragment *) - let len = 1 + len data in + let len = 1 + length data in (* we might want to add additional blocks of padding *) let padding_length = block - (len mod block) in (* 1 is again padding length field *) @@ -126,7 +126,7 @@ let cbc_pad block data = let cbc_unpad data = let open Cstruct in - let len = len data in + let len = length data in let padlen = get_uint8 data (pred len) in let (res, pad) = split data (len - padlen - 1) in diff --git a/lib/engine.ml b/lib/engine.ml index 5b214d6d..6c521483 100644 --- a/lib/engine.ml +++ b/lib/engine.ml @@ -133,7 +133,7 @@ let encrypt (version : tls_version) (st : crypto_state) ty buf = buf <+> t in let nonce = Crypto.aead_nonce c.nonce ctx.sequence in - let adata = Crypto.adata_1_3 (Cstruct.len buf + Crypto.tag_len c.cipher) in + let adata = Crypto.adata_1_3 (Cstruct.length buf + Crypto.tag_len c.cipher) in let buf = Crypto.encrypt_aead ~cipher:c.cipher ~adata ~key:c.cipher_secret ~nonce buf in (Some { ctx with sequence = Int64.succ ctx.sequence }, Packet.APPLICATION_DATA, buf) | _ -> assert false) @@ -142,7 +142,7 @@ let encrypt (version : tls_version) (st : crypto_state) ty buf = let seq = ctx.sequence and ver = pair_of_tls_version version in - Crypto.pseudo_header seq ty ver (Cstruct.len buf) + Crypto.pseudo_header seq ty ver (Cstruct.length buf) in let to_encrypt mac mac_k = let signature = Crypto.mac mac mac_k pseudo_hdr buf in @@ -186,12 +186,12 @@ let encrypt (version : tls_version) (st : crypto_state) ty buf = (* well-behaved pure decryptor *) let verify_mac sequence mac mac_k ty ver decrypted = - let macstart = Cstruct.len decrypted - Mirage_crypto.Hash.digest_size mac in + let macstart = Cstruct.length decrypted - Mirage_crypto.Hash.digest_size mac in guard (macstart >= 0) (`Fatal `MACUnderflow) >>= fun () -> let (body, mmac) = Cstruct.split decrypted macstart in let cmac = let ver = pair_of_tls_version ver in - let hdr = Crypto.pseudo_header sequence ty ver (Cstruct.len body) in + let hdr = Crypto.pseudo_header sequence ty ver (Cstruct.length body) in Crypto.mac mac mac_k hdr body in guard (Cstruct.equal cmac mmac) (`Fatal `MACMismatch) >>| fun () -> body @@ -230,7 +230,7 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf dec iv buf >>| fun (msg, iv') -> CBC { c with iv_mode = Iv iv' }, msg | Random_iv -> - if Cstruct.len buf < Crypto.cbc_block c.cipher then + if Cstruct.length buf < Crypto.cbc_block c.cipher then Error (`Fatal `MACUnderflow) else let iv, buf = Cstruct.split buf (Crypto.cbc_block c.cipher) in @@ -243,7 +243,7 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf (* RFC 7905: no explicit nonce, instead TLS 1.3 construction is adapted *) let adata = let ver = pair_of_tls_version version in - Crypto.pseudo_header seq ty ver (Cstruct.len buf - Crypto.tag_len c.cipher) + Crypto.pseudo_header seq ty ver (Cstruct.length buf - Crypto.tag_len c.cipher) and nonce = Crypto.aead_nonce c.nonce seq in (match Crypto.decrypt_aead ~adata ~cipher:c.cipher ~key:c.cipher_secret ~nonce buf with @@ -251,13 +251,13 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf | Some x -> Ok (AEAD c, x)) | _ -> let explicit_nonce_len = 8 in - if Cstruct.len buf < explicit_nonce_len then + if Cstruct.length buf < explicit_nonce_len then Error (`Fatal `MACUnderflow) else let explicit_nonce, buf = Cstruct.split buf explicit_nonce_len in let adata = let ver = pair_of_tls_version version in - Crypto.pseudo_header seq ty ver (Cstruct.len buf - Crypto.tag_len c.cipher) + Crypto.pseudo_header seq ty ver (Cstruct.length buf - Crypto.tag_len c.cipher) and nonce = c.nonce <+> explicit_nonce in match Crypto.decrypt_aead ~cipher:c.cipher ~key:c.cipher_secret ~nonce ~adata buf with @@ -291,9 +291,9 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf | Some ct -> Ok (Cstruct.sub x 0 idx, ct) | None -> Error (`Fatal `MACUnderflow) (* TODO better error? *) in - eat (pred (Cstruct.len x)) + eat (pred (Cstruct.length x)) in - let adata = Crypto.adata_1_3 (Cstruct.len buf) in + let adata = Crypto.adata_1_3 (Cstruct.length buf) in (match Crypto.decrypt_aead ~adata ~cipher:c.cipher ~key:c.cipher_secret ~nonce buf with | None -> if trial then @@ -336,7 +336,7 @@ let rec separate_records : Cstruct.t -> ((tls_hdr * Cstruct.t) list * Cstruct.t, let encrypt_records encryptor version records = let rec split = function | [] -> [] - | (t1, a) :: xs when Cstruct.len a >= 1 lsl 14 -> + | (t1, a) :: xs when Cstruct.length a >= 1 lsl 14 -> let fst, snd = Cstruct.split a (1 lsl 14) in (t1, fst) :: split ((t1, snd) :: xs) | x::xs -> x :: split xs @@ -420,7 +420,7 @@ and handle_handshake = function | Server13 ss -> Handshake_server13.handle_handshake ss let non_empty cs = - if Cstruct.len cs = 0 then None else Some cs + if Cstruct.length cs = 0 then None else Some cs let handle_packet hs buf = function (* RFC 5246 -- 6.2.1.: @@ -435,7 +435,7 @@ let handle_packet hs buf = function (hs, out, None, err) | Packet.APPLICATION_DATA -> - if hs_can_handle_appdata hs || (early_data hs && Cstruct.len hs.hs_fragment = 0) then + if hs_can_handle_appdata hs || (early_data hs && Cstruct.length hs.hs_fragment = 0) then (Tracing.cs ~tag:"application-data-in" buf; Ok (hs, [], non_empty buf, `No_err)) else @@ -461,7 +461,7 @@ let handle_packet hs buf = function let decrement_early_data hs ty buf = let bytes left cipher = - let count = Cstruct.len buf - fst (Ciphersuite.kn_13 (Ciphersuite.privprot13 cipher)) in + let count = Cstruct.length buf - fst (Ciphersuite.kn_13 (Ciphersuite.privprot13 cipher)) in let left' = Int32.sub left (Int32.of_int count) in if left' < 0l then Error (`Fatal `Toomany0rttbytes) else Ok left' in @@ -491,7 +491,7 @@ let handle_raw_record state (hdr, buf as record : raw_record) = >>= fun () -> let trial = match hs.machina with | Server13 (AwaitEndOfEarlyData13 _) | Server13 Established13 -> false - | Server13 _ -> hs.early_data_left > 0l && Cstruct.len hs.hs_fragment = 0 + | Server13 _ -> hs.early_data_left > 0l && Cstruct.length hs.hs_fragment = 0 | _ -> false in decrypt ~trial version state.decryptor hdr.content_type buf @@ -707,9 +707,9 @@ let client config = let ch'_raw = Writer.assemble_handshake (ClientHello ch') in let binders_len = binders_len incomplete_psks in - let ch_part = Cstruct.(sub ch'_raw 0 (len ch'_raw - binders_len)) in + let ch_part = Cstruct.(sub ch'_raw 0 (length ch'_raw - binders_len)) in let binder = Handshake_crypto13.finished early_secret.hash binder_key ch_part in - let blen = Cstruct.len binder in + let blen = Cstruct.length binder in let prefix = Cstruct.create 3 in Cstruct.BE.set_uint16 prefix 0 (blen + 1) ; Cstruct.set_uint8 prefix 2 blen ; diff --git a/lib/handshake_client.ml b/lib/handshake_client.ml index 26c899ff..b7c1d87c 100644 --- a/lib/handshake_client.ml +++ b/lib/handshake_client.ml @@ -63,8 +63,8 @@ let default_client_hello config = in let sessionid = match config.use_reneg, config.cached_session with - | _, Some { session_id ; extended_ms ; _ } when extended_ms && not (Cstruct.len session_id = 0) -> Some session_id - | false, Some { session_id ; _ } when not (Cstruct.len session_id = 0) -> Some session_id + | _, Some { session_id ; extended_ms ; _ } when extended_ms && not (Cstruct.length session_id = 0) -> Some session_id + | false, Some { session_id ; _ } when not (Cstruct.length session_id = 0) -> Some session_id | _ -> None in let ch = { @@ -82,7 +82,7 @@ let common_server_hello_validation config reneg (sh : server_hello) (ch : client match reneg, data with | Some (cvd, svd), Some x -> guard (Cstruct.equal (cvd <+> svd) x) (`Fatal `InvalidRenegotiation) | Some _, None -> Error (`Fatal `NoSecureRenegotiation) - | None, Some x -> guard (Cstruct.len x = 0) (`Fatal `InvalidRenegotiation) + | None, Some x -> guard (Cstruct.length x = 0) (`Fatal `InvalidRenegotiation) | None, None -> Ok () in guard (List.mem sh.ciphersuite config.ciphers) @@ -398,7 +398,7 @@ let answer_server_finished state (session : session_data) client_verify fin log Handshake_crypto.finished (state_version state) session.ciphersuite session.common_session_data.master_secret "server finished" log in guard (Cstruct.equal computed fin) (`Fatal `BadFinished) >>= fun () -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let machina = Established and session = { session with renegotiation = (client_verify, computed) } in ({ state with machina = Client machina ; session = `TLS session :: state.session }, []) @@ -409,7 +409,7 @@ let answer_server_finished_resume state (session : session_data) fin raw log = (checksum "client finished" (log @ [raw]), checksum "server finished" log) in guard (Cstruct.equal server fin) (`Fatal `BadFinished) >>= fun () -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let machina = Established and session = { session with renegotiation = (client, server) } in @@ -442,12 +442,12 @@ let answer_hello_request state = let handle_change_cipher_spec cs state packet = match Reader.parse_change_cipher_spec packet, cs with | Ok (), AwaitServerChangeCipherSpec (session, server_ctx, client_verify, log) -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let machina = AwaitServerFinished (session, client_verify, log) in Tracing.cs ~tag:"change-cipher-spec-in" packet ; ({ state with machina = Client machina }, [`Change_dec server_ctx]) | Ok (), AwaitServerChangeCipherSpecResume (session, client_ctx, server_ctx, log) -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let ccs = change_cipher_spec in let machina = AwaitServerFinishedResume (session, log) in Tracing.cs ~tag:"change-cipher-spec-in" packet ; diff --git a/lib/handshake_client13.ml b/lib/handshake_client13.ml index dad1627a..b89f932c 100644 --- a/lib/handshake_client13.ml +++ b/lib/handshake_client13.ml @@ -13,7 +13,7 @@ let answer_server_hello state ch (sh : server_hello) secrets raw log = | None -> Error (`Fatal `InvalidServerHello) | Some cipher -> guard (List.mem cipher (ciphers13 state.config)) (`Fatal `InvalidServerHello) >>= fun () -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> (* TODO: PSK *) (* TODO: early_secret elsewhere *) @@ -80,7 +80,7 @@ let answer_hello_retry_request state (ch : client_hello) hrr _secrets raw log = let new_ch = { ch with extensions = `KeyShare [keyshare] :: other_exts @ cookie} in let new_ch_raw = Writer.assemble_handshake (ClientHello new_ch) in let ch0_data = Mirage_crypto.Hash.digest (Ciphersuite.hash13 hrr.ciphersuite) log in - let ch0_hdr = Writer.assemble_message_hash (Cstruct.len ch0_data) in + let ch0_hdr = Writer.assemble_message_hash (Cstruct.length ch0_data) in let st = AwaitServerHello13 (new_ch, [secret], Cstruct.concat [ ch0_hdr ; ch0_data ; raw ; new_ch_raw ]) in Tracing.sexpf ~tag:"handshake-out" ~f:sexp_of_tls_handshake (ClientHello new_ch); @@ -140,7 +140,7 @@ let answer_finished state (session : session_data13) server_hs_secret client_hs_ let hash = Ciphersuite.hash13 session.ciphersuite13 in let f_data = Handshake_crypto13.finished hash server_hs_secret log in guard (Cstruct.equal fin f_data) (`Fatal `BadFinished) >>= fun () -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> let log = log <+> raw in let server_app_secret, server_app_ctx, client_app_secret, client_app_ctx = Handshake_crypto13.app_ctx session.master_secret log @@ -210,7 +210,7 @@ let answer_session_ticket state st = let handle_key_update state req = match state.session with | `TLS13 session :: _ -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> let server_app_secret, server_ctx = Handshake_crypto13.app_secret_n_1 session.master_secret session.server_app_secret in @@ -250,14 +250,14 @@ let handle_handshake cs hs buf = (match parse_certificates_1_3 cs with | Ok (con, cs) -> (* during handshake, context must be empty! and we'll not get any new certificate from server *) - guard (Cstruct.len con = 0) (`Fatal `InvalidMessage) >>= fun () -> + guard (Cstruct.length con = 0) (`Fatal `InvalidMessage) >>= fun () -> answer_certificate hs sd es ss None cs buf log | Error re -> Error (`Fatal (`ReaderError re))) | AwaitServerCertificate13 (sd, es, ss, sigalgs, log), Certificate cs -> (match parse_certificates_1_3 cs with | Ok (con, cs) -> (* during handshake, context must be empty! and we'll not get any new certificate from server *) - guard (Cstruct.len con = 0) (`Fatal `InvalidMessage) >>= fun () -> + guard (Cstruct.length con = 0) (`Fatal `InvalidMessage) >>= fun () -> answer_certificate hs sd es ss sigalgs cs buf log | Error re -> Error (`Fatal (`ReaderError re))) | AwaitServerCertificateVerify13 (sd, es, ss, sigalgs, log), CertificateVerify cv -> diff --git a/lib/handshake_crypto.ml b/lib/handshake_crypto.ml index 0fc90b49..d213c1f3 100644 --- a/lib/handshake_crypto.ml +++ b/lib/handshake_crypto.ml @@ -5,7 +5,7 @@ open State let (<+>) = Cstruct.append let halve secret = - let size = Cstruct.len secret in + let size = Cstruct.length secret in let half = size - size / 2 in Cstruct.(sub secret 0 half, sub secret (size - half) half) diff --git a/lib/handshake_crypto13.ml b/lib/handshake_crypto13.ml index 21bf08e2..f9feb457 100644 --- a/lib/handshake_crypto13.ml +++ b/lib/handshake_crypto13.ml @@ -7,13 +7,13 @@ let cdiv (x : int) (y : int) = let left_pad_dh group msg = let bytes = cdiv (Mirage_crypto_pk.Dh.modulus_size group) 8 in - let padding = Cstruct.create (bytes - Cstruct.len msg) in + let padding = Cstruct.create (bytes - Cstruct.length msg) in padding <+> msg let not_all_zero = function | Error _ as e -> e | Ok cs -> - let all_zero = Cstruct.create (Cstruct.len cs) in + let all_zero = Cstruct.create (Cstruct.length cs) in if Cstruct.equal all_zero cs then Error (`Fatal `InvalidDH) else @@ -26,7 +26,7 @@ let dh_shared secret share = | `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 + if Cstruct.length 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) @@ -91,11 +91,11 @@ let hkdflabel label context length = and label = let lbl = Cstruct.of_string ("tls13 " ^ label) in let l = Cstruct.create 1 in - Cstruct.set_uint8 l 0 (Cstruct.len lbl) ; + Cstruct.set_uint8 l 0 (Cstruct.length lbl) ; l <+> lbl and context = let l = Cstruct.create 1 in - Cstruct.set_uint8 l 0 (Cstruct.len context) ; + Cstruct.set_uint8 l 0 (Cstruct.length context) ; l <+> context in let lbl = len <+> label <+> context in diff --git a/lib/handshake_server.ml b/lib/handshake_server.ml index cc1033f8..eb42b58b 100644 --- a/lib/handshake_server.ml +++ b/lib/handshake_server.ml @@ -34,7 +34,7 @@ let answer_client_finished state (session : session_data) client_fin raw log = let fin = Finished server in let fin_raw = Writer.assemble_handshake fin in (* we really do not want to have any leftover handshake fragments *) - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let session = { session with renegotiation = (client, server) } and machina = Server Established in @@ -48,7 +48,7 @@ let answer_client_finished_resume state (session : session_data) server_verify c in guard (Cstruct.equal client_verify client_fin) (`Fatal `BadFinished) >>= fun () -> (* we really do not want to have any leftover handshake fragments *) - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let session = { session with renegotiation = (client_verify, server_verify) } and machina = Server Established in @@ -119,7 +119,7 @@ let answer_client_key_exchange_RSA state (session : session_data) kex raw log = configuration option to disable the check. Note that if the check fails, the PreMasterSecret SHOULD be randomized as described below *) (* we do not provide an option to disable the version checking (yet!) *) - match Cstruct.len k == 48, Reader.parse_any_version k with + match Cstruct.length k == 48, Reader.parse_any_version k with | true, Ok c_ver when c_ver = session.client_version -> k | _ -> other in @@ -200,7 +200,7 @@ let server_hello config (client_hello : client_hello) (session : session_data) v | _, `TLS_1_3 -> Packet.downgrade11 | _ -> Cstruct.create 0 in - let rst = Mirage_crypto_rng.generate (32 - Cstruct.len suffix) in + let rst = Mirage_crypto_rng.generate (32 - Cstruct.length suffix) in rst <+> suffix and secren = match reneg with | None -> `SecureRenegotiation (Cstruct.create 0) @@ -210,7 +210,7 @@ let server_hello config (client_hello : client_hello) (session : session_data) v else [] and session_id = - match Cstruct.len session.session_id with + match Cstruct.length session.session_id with | 0 -> Mirage_crypto_rng.generate 32 | _ -> session.session_id and alpn = @@ -461,7 +461,7 @@ let answer_client_hello state (ch : client_hello) raw = let ensure_reneg ciphers their_data = let reneg_cs = List.mem Packet.TLS_EMPTY_RENEGOTIATION_INFO_SCSV ciphers in match reneg_cs, their_data with - | _, Some x -> guard (Cstruct.len x = 0) (`Fatal `InvalidRenegotiation) + | _, Some x -> guard (Cstruct.length x = 0) (`Fatal `InvalidRenegotiation) | true, _ -> Ok () | _ -> Error (`Fatal `NoSecureRenegotiation) @@ -492,7 +492,7 @@ let answer_client_hello state (ch : client_hello) raw = let version = state_version state in let sh, session = server_hello state.config ch session version None in (* we really do not want to have any leftover handshake fragments *) - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let client_ctx, server_ctx = Handshake_crypto.initialise_crypto_ctx version session in @@ -572,7 +572,7 @@ let answer_client_hello_reneg state (ch : client_hello) raw = let handle_change_cipher_spec ss state packet = match Reader.parse_change_cipher_spec packet, ss with | Ok (), AwaitClientChangeCipherSpec (session, server_ctx, client_ctx, log) -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> let ccs = change_cipher_spec in let machina = AwaitClientFinished (session, log) @@ -583,7 +583,7 @@ let handle_change_cipher_spec ss state packet = Ok ({ state with machina = Server machina }, [`Record ccs; `Change_enc server_ctx; `Change_dec client_ctx]) | Ok (), AwaitClientChangeCipherSpecResume (session, client_ctx, server_verify, log) -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let machina = AwaitClientFinishedResume (session, server_verify, log) in Tracing.cs ~tag:"change-cipher-spec-in" packet ; diff --git a/lib/handshake_server13.ml b/lib/handshake_server13.ml index b8b225e3..897facf7 100644 --- a/lib/handshake_server13.ml +++ b/lib/handshake_server13.ml @@ -103,7 +103,7 @@ let answer_client_hello ~hrr state ch raw = | None -> Error (`Fatal (`InvalidClientHello `NoCookie)) | Some c -> (* log is: 254 00 00 length c :: HRR *) - let hash_hdr = Writer.assemble_message_hash (Cstruct.len c) in + let hash_hdr = Writer.assemble_message_hash (Cstruct.length c) in let hrr = { retry_version = `TLS_1_3 ; ciphersuite = cipher ; sessionid = ch.sessionid ; selected_group = group ; extensions = [ `Cookie c ]} in let hs_buf = Writer.assemble_handshake (HelloRetryRequest hrr) in Ok (Cstruct.concat [ hash_hdr ; c ; hs_buf ]) @@ -182,7 +182,7 @@ let answer_client_hello ~hrr state ch raw = let early_secret = secret ~psk:psk.secret () in let binder_key = Handshake_crypto13.derive_secret early_secret "res binder" Cstruct.empty in let binders_len = binders_len ids in - let ch_part = Cstruct.(sub raw 0 (len raw - binders_len)) in + let ch_part = Cstruct.(sub raw 0 (length raw - binders_len)) in let log = Cstruct.append log ch_part in let binder' = Handshake_crypto13.finished early_secret.hash binder_key log in if Cstruct.equal binder binder' then begin @@ -295,7 +295,7 @@ let answer_client_hello ~hrr state ch raw = in let session' = { session' with server_app_secret ; client_app_secret } in - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> (* send sessionticket early *) (* TODO track the nonce across handshakes / newsessionticket messages (i.e. after post-handshake auth) - needs to be unique! *) @@ -397,7 +397,7 @@ let answer_client_finished state fin client_fini dec_ctx st raw log = let hash = Ciphersuite.hash13 session.ciphersuite13 in let data = finished hash client_fini log in guard (Cstruct.equal data fin) (`Fatal `BadFinished) >>= fun () -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>| fun () -> let session' = match st, state.config.Config.ticket_cache with | None, _ | _, None -> session | Some st, Some cache -> @@ -426,7 +426,7 @@ let handle_end_of_early_data state cf hs_ctx cc st buf log = let handle_key_update state req = match state.session with | `TLS13 session :: _ -> - guard (Cstruct.len state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> + guard (Cstruct.length state.hs_fragment = 0) (`Fatal `HandshakeFragmentsNotEmpty) >>= fun () -> let client_app_secret, client_ctx = app_secret_n_1 session.master_secret session.client_app_secret in diff --git a/lib/reader.ml b/lib/reader.ml index 0ca8bab4..69c394ec 100644 --- a/lib/reader.ml +++ b/lib/reader.ml @@ -54,7 +54,7 @@ let parse_version = catch parse_version_exn let parse_any_version = catch parse_any_version_exn let parse_record buf = - if len buf < 5 then + if length buf < 5 then Ok (`Fragment buf) else let typ = get_uint8 buf 0 @@ -66,7 +66,7 @@ let parse_record buf = 2 ^ 14 + 1024 for TLSCompressed 2 ^ 14 for TLSPlaintext *) Error (Overflow x) - | x when 5 + x > len buf -> Ok (`Fragment buf) + | x when 5 + x > length buf -> Ok (`Fragment buf) | x -> match tls_any_version_of_pair version, @@ -117,7 +117,7 @@ let validate_alert (lvl, typ) = | lvl, typ -> (lvl, typ) let parse_alert = catch @@ fun buf -> - if len buf <> 2 then + if length buf <> 2 then raise_trailing_bytes "after alert" else let level = get_uint8 buf 0 in @@ -128,7 +128,7 @@ let parse_alert = catch @@ fun buf -> | _ -> raise_unknown @@ "alert level " ^ string_of_int level let parse_change_cipher_spec buf = - match len buf, get_uint8 buf 0 with + match length buf, get_uint8 buf 0 with | 1, 1 -> Ok () | _ -> Error (Unknown "bad change cipher spec message") @@ -140,7 +140,7 @@ let rec parse_count_list parsef buf acc = function | None , buf' -> parse_count_list parsef buf' acc (pred n) let rec parse_list parsef buf acc = - match len buf with + match length buf with | 0 -> List.rev acc | _ -> match parsef buf with @@ -174,7 +174,7 @@ let parse_ciphersuite buf = | Some cs' -> (Some cs', buf') let parse_hostnames buf = - match len buf with + match length buf with | 0 -> [] | n -> let parsef buf = @@ -193,7 +193,7 @@ let parse_hostnames buf = parse_list parsef (sub buf 2 list_length) [] let parse_fragment_length buf = - if len buf <> 1 then + if length buf <> 1 then raise_trailing_bytes "fragment length" else int_to_max_fragment_length (get_uint8 buf 0) @@ -223,7 +223,7 @@ let parse_supported_groups buf = raise_wrong_length "elliptic curve list" else let cs, rt = parse_count_list parse_named_group (shift buf 2) [] (count / 2) in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "elliptic curves" else cs @@ -248,11 +248,11 @@ let parse_alpn_protocol raw = (Some protocol, shift raw (1 + length)) let parse_alpn_protocols buf = - let length = BE.get_uint16 buf 0 in - if len buf <> length + 2 then + let len = BE.get_uint16 buf 0 in + if length buf <> len + 2 then raise_trailing_bytes "alpn" else - parse_list parse_alpn_protocol (sub buf 2 length) [] + parse_list parse_alpn_protocol (sub buf 2 len) [] let parse_ec_point_format buf = (* this is deprecated, we only check that uncompressed (typ 0) is present *) @@ -270,18 +270,18 @@ let parse_extension buf = function | None -> raise_unknown "maximum fragment length") | RENEGOTIATION_INFO -> let len' = get_uint8 buf 0 in - if len buf <> len' + 1 then + if length buf <> len' + 1 then raise_trailing_bytes "renegotiation" else `SecureRenegotiation (sub buf 1 len') | EXTENDED_MASTER_SECRET -> - if len buf > 0 then + if length buf > 0 then raise_trailing_bytes "extended master secret" else `ExtendedMasterSecret | EC_POINT_FORMATS -> let formats, rt = parse_ec_point_formats buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "ec point formats" else if List.mem true formats then `ECPointFormats @@ -318,7 +318,7 @@ let parse_client_presharedkeys buf = let binders_len = BE.get_uint16 buf (id_len + 2) in let binders = parse_list parse_binder (sub buf (4 + id_len) binders_len) [] in let id_binder = List.combine identities binders in - if len buf <> 4 + binders_len + id_len then + if length buf <> 4 + binders_len + id_len then raise_trailing_bytes "psk" else id_binder @@ -342,7 +342,7 @@ let parse_ext raw = (etype, length, sub raw 4 length) let parse_client_extension raw = - let etype, length, buf = parse_ext raw in + let etype, len, buf = parse_ext raw in let data = match int_to_extension_type etype with | Some SERVER_NAME -> @@ -362,17 +362,17 @@ let parse_client_extension raw = `SupportedGroups gs | Some PADDING -> let rec check = function - | 0 -> `Padding length + | 0 -> `Padding len | n -> let idx = pred n in if get_uint8 buf idx <> 0 then raise_unknown "bad padding in padding extension" else check idx in - check length + check len | Some SIGNATURE_ALGORITHMS -> let algos, rt = parse_signature_algorithms buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "signature algorithms" else `SignatureAlgorithms algos @@ -381,7 +381,7 @@ let parse_client_extension raw = `ALPN protocols | Some KEY_SHARE -> let ll = BE.get_uint16 buf 0 in - if ll + 2 <> len buf then + if ll + 2 <> length buf then raise_unknown "bad key share extension" else let shares = parse_list parse_keyshare_entry (sub buf 2 ll) [] in @@ -390,40 +390,40 @@ let parse_client_extension raw = let ids = parse_client_presharedkeys buf in `PreSharedKeys ids | Some EARLY_DATA -> - if len buf <> 0 then + if length buf <> 0 then raise_trailing_bytes "early data" else `EarlyDataIndication | Some SUPPORTED_VERSIONS -> let versions, rt = parse_supported_versions buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "supported versions" else `SupportedVersions versions | Some POST_HANDSHAKE_AUTH -> - if len buf = 0 then + if length buf = 0 then `PostHandshakeAuthentication else raise_unknown "non-empty post handshake authentication" | Some COOKIE -> let c, rt = parse_cookie buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "cookie" else `Cookie c | Some PSK_KEY_EXCHANGE_MODES -> let modes, rt = parse_psk_key_exchange_modes buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "psk key exchange modes" else `PskKeyExchangeModes modes | Some x -> parse_extension buf x | None -> `UnknownExtension (etype, buf) in - (Some data, shift raw (4 + length)) + (Some data, shift raw (4 + len)) let parse_server_extension raw = - let etype, length, buf = parse_ext raw in + let etype, len, buf = parse_ext raw in let data = match int_to_extension_type etype with | Some SERVER_NAME -> @@ -432,14 +432,14 @@ let parse_server_extension raw = | _ -> raise_unknown "bad server name indication (multiple names)") | Some KEY_SHARE -> (match parse_keyshare_entry buf with - | _, xs when len xs <> 0 -> raise_trailing_bytes "server keyshare" + | _, xs when length xs <> 0 -> raise_trailing_bytes "server keyshare" | None, _ -> raise_unknown "keyshare entry" | Some (g, ks), _ -> match named_group_to_group g with | Some g -> `KeyShare (g, ks) | None -> raise_unknown "keyshare entry") | Some PRE_SHARED_KEY -> - if len buf <> 2 then + if length buf <> 2 then raise_trailing_bytes "server pre_shared_key" else `PreSharedKey (BE.get_uint16 buf 0) @@ -455,10 +455,10 @@ let parse_server_extension raw = | Some x -> parse_extension buf x | None -> `UnknownExtension (etype, buf) in - (Some data, shift raw (4 + length)) + (Some data, shift raw (4 + len)) let parse_encrypted_extension raw = - let etype, length, buf = parse_ext raw in + let etype, len, buf = parse_ext raw in let data = match int_to_extension_type etype with | Some SERVER_NAME -> @@ -474,23 +474,23 @@ let parse_encrypted_extension raw = | [protocol] -> `ALPN protocol | _ -> raise_unknown "bad ALPN (none or multiple names)") | Some EARLY_DATA -> - if len buf <> 0 then + if length buf <> 0 then raise_trailing_bytes "server early_data" else `EarlyDataIndication | Some x -> raise_unknown ("bad encrypted extension " ^ (extension_type_to_string x)) (* TODO maybe unknown instead? *) | None -> `UnknownExtension (etype, buf) in - (Some data, shift raw (4 + length)) + (Some data, shift raw (4 + len)) let parse_retry_extension raw = - let etype, length, buf = parse_ext raw in + let etype, len, buf = parse_ext raw in let data = match int_to_extension_type etype with | Some KEY_SHARE -> begin let group, rt = parse_group buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "key share" else match group with @@ -502,20 +502,20 @@ let parse_retry_extension raw = `SelectedVersion version | Some COOKIE -> let c, rt = parse_cookie buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "cookie" else `Cookie c | _ -> `UnknownExtension (etype, buf) in - (Some data, shift raw (4 + length)) + (Some data, shift raw (4 + len)) let parse_extensions parse_ext buf = - let length = BE.get_uint16 buf 0 in - if len buf <> length + 2 then + let len = BE.get_uint16 buf 0 in + if length buf <> len + 2 then raise_trailing_bytes "extensions" else - parse_list parse_ext (sub buf 2 length) [] + parse_list parse_ext (sub buf 2 len) [] let parse_client_hello buf = let client_version = parse_any_version_exn buf in @@ -525,7 +525,7 @@ let parse_client_hello buf = let ciphersuites, rt = parse_any_ciphersuites (shift buf (35 + slen)) in let _, rt' = parse_compression_methods rt in let extensions = - if len rt' == 0 then [] else parse_extensions parse_client_extension rt' + if length rt' = 0 then [] else parse_extensions parse_client_extension rt' in (* TLS 1.3 mandates PreSharedKeys to be the last extension *) (if List.exists (function `PreSharedKeys _ -> true | _ -> false) extensions then @@ -555,7 +555,7 @@ let parse_server_hello buf = | None -> raise_unknown "unsupported ciphersuite in hello retry request" | Some ciphersuite -> let extensions = - if len rt' == 0 then [] else parse_extensions parse_retry_extension rt' + if length rt' = 0 then [] else parse_extensions parse_retry_extension rt' in let retry_version = match Utils.map_find ~f:(function `SelectedVersion v -> Some v | _ -> None) extensions with @@ -570,7 +570,7 @@ let parse_server_hello buf = HelloRetryRequest { retry_version ; sessionid ; ciphersuite ; selected_group ; extensions } end else begin let extensions = - if len rt' == 0 then [] else parse_extensions parse_server_extension rt' + if length rt' = 0 then [] else parse_extensions parse_server_extension rt' in let server_version = match Utils.map_find ~f:(function `SelectedVersion v -> Some v | _ -> None) extensions with @@ -585,11 +585,11 @@ let parse_certificates_exn buf = let len = get_uint24_len buf in (Some (sub buf 3 len), shift buf (len + 3)) in - let length = get_uint24_len buf in - if len buf <> length + 3 then + let len = get_uint24_len buf in + if length buf <> len + 3 then raise_trailing_bytes "certificates" else - parse_list parsef (sub buf 3 length) [] + parse_list parsef (sub buf 3 len) [] let parse_certificates = catch @@ parse_certificates_exn @@ -608,8 +608,8 @@ let parse_certificate_ext_1_3_exn buf = (Some (cert, exts), rest) let parse_certificate_ext_list_1_3_exn buf = - let length = get_uint24_len buf in - if len buf <> length + 3 then + let len = get_uint24_len buf in + if length buf <> len + 3 then raise_trailing_bytes "certificates" else parse_list parse_certificate_ext_1_3_exn (shift buf 3) [] @@ -643,7 +643,7 @@ let parse_cas buf = let parse_certificate_request_exn buf = let certificate_types, buf' = parse_certificate_types buf in let certificate_authorities, buf' = parse_cas buf' in - if len buf' <> 0 then + if length buf' <> 0 then raise_trailing_bytes "certificate request" else (certificate_types, certificate_authorities) @@ -655,7 +655,7 @@ let parse_certificate_request_1_2_exn buf = let certificate_types, buf' = parse_certificate_types buf in let sigs, buf' = parse_signature_algorithms buf' in let cas, buf' = parse_cas buf' in - if len buf' <> 0 then + if length buf' <> 0 then raise_trailing_bytes "certificate request" else (certificate_types, sigs, cas) @@ -664,17 +664,17 @@ let parse_certificate_request_1_2 = catch parse_certificate_request_1_2_exn let parse_certificate_request_extension raw = - let etype, length, buf = parse_ext raw in + let etype, len, buf = parse_ext raw in let data = match int_to_extension_type etype with | Some SIGNATURE_ALGORITHMS -> let algos, rt = parse_signature_algorithms buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "signature algorithms" else `SignatureAlgorithms algos | Some CERTIFICATE_AUTHORITIES -> let cas, rt = parse_cas buf in - if len rt <> 0 then + if length rt <> 0 then raise_trailing_bytes "certificate authorities" else let cas = List.fold_left (fun cas buf -> @@ -686,7 +686,7 @@ let parse_certificate_request_extension raw = `CertificateAuthorities (List.rev cas) | _ -> `UnknownExtension (etype, buf) in - (Some data, shift raw (4 + length)) + (Some data, shift raw (4 + len)) let parse_certificate_request_1_3_exn buf = let contextlen = get_uint8 buf 0 in @@ -733,7 +733,7 @@ let parse_ec_parameters = catch @@ fun raw -> let parse_digitally_signed_exn buf = let siglen = BE.get_uint16 buf 0 in - if len buf <> siglen + 2 then + if length buf <> siglen + 2 then raise_trailing_bytes "digitally signed" else sub buf 2 siglen @@ -749,17 +749,17 @@ let parse_digitally_signed_1_2 = catch @@ fun buf -> | None -> raise_unknown "hash or signature algorithm" let parse_session_ticket_extension raw = - let etype, length, buf = parse_ext raw in + let etype, len, buf = parse_ext raw in let data = match int_to_extension_type etype with | Some EARLY_DATA -> - if len buf <> 4 then + if length buf <> 4 then raise_unknown "bad early_data extension in session ticket" else let size = BE.get_uint32 buf 0 in `EarlyDataIndication size | _ -> `UnknownExtension (etype, buf) in - (Some data, shift raw (4 + length)) + (Some data, shift raw (4 + len)) let parse_session_ticket buf = let lifetime = BE.get_uint32 buf 0 @@ -773,25 +773,25 @@ let parse_session_ticket buf = { lifetime ; age_add ; nonce ; ticket ; extensions } let parse_client_dh_key_exchange_exn buf = - let length = BE.get_uint16 buf 0 in - if len buf <> length + 2 then + let len = BE.get_uint16 buf 0 in + if length buf <> len + 2 then raise_trailing_bytes "client key exchange" else - sub buf 2 length + sub buf 2 len let parse_client_dh_key_exchange = catch parse_client_dh_key_exchange_exn let parse_client_ec_key_exchange_exn buf = - let length = get_uint8 buf 0 in - if len buf <> length + 1 then + let len = get_uint8 buf 0 in + if length buf <> len + 1 then raise_trailing_bytes "client key exchange" else - sub buf 1 length + sub buf 1 len let parse_client_ec_key_exchange = catch parse_client_ec_key_exchange_exn let parse_keyupdate buf = - if len buf <> 1 then + if length buf <> 1 then raise_trailing_bytes "key update" else match int_to_key_update_request_type (get_uint8 buf 0) with @@ -799,12 +799,12 @@ let parse_keyupdate buf = | None -> raise_unknown "key update content" let parse_handshake_frame buf = - if len buf < 4 then + if length buf < 4 then (None, buf) else let l = get_uint24_len (shift buf 1) in let hslen = l + 4 in - if len buf >= hslen then + if length buf >= hslen then let hs, rest = split buf hslen in (Some hs, rest) else @@ -813,21 +813,21 @@ let parse_handshake_frame buf = let parse_handshake = catch @@ fun buf -> let typ = get_uint8 buf 0 in let handshake_type = int_to_handshake_type typ in - let length = get_uint24_len (shift buf 1) in - if len buf <> length + 4 then + let len = get_uint24_len (shift buf 1) in + if length buf <> len + 4 then raise_trailing_bytes "handshake" else - let payload = sub buf 4 length in + let payload = sub buf 4 len in match handshake_type with | Some HELLO_REQUEST -> - if len payload = 0 then HelloRequest else raise_trailing_bytes "hello request" + if length payload = 0 then HelloRequest else raise_trailing_bytes "hello request" | Some CLIENT_HELLO -> parse_client_hello payload | Some SERVER_HELLO -> parse_server_hello payload | Some CERTIFICATE -> Certificate payload | Some CERTIFICATE_VERIFY -> CertificateVerify payload | Some SERVER_KEY_EXCHANGE -> ServerKeyExchange payload | Some SERVER_HELLO_DONE -> - if len payload = 0 then ServerHelloDone else raise_trailing_bytes "server hello done" + if length payload = 0 then ServerHelloDone else raise_trailing_bytes "server hello done" | Some CERTIFICATE_REQUEST -> CertificateRequest payload | Some CLIENT_KEY_EXCHANGE -> ClientKeyExchange payload | Some FINISHED -> Finished payload diff --git a/lib/writer.ml b/lib/writer.ml index c783a398..c027f290 100644 --- a/lib/writer.ml +++ b/lib/writer.ml @@ -25,7 +25,7 @@ let assemble_hdr version (content_type, payload) = let buf = create 5 in set_uint8 buf 0 (content_type_to_int content_type); assemble_protocol_version_int (shift buf 1) version; - BE.set_uint16 buf 3 (len payload); + BE.set_uint16 buf 3 (length payload); buf <+> payload type len = One | Two | Three @@ -35,15 +35,15 @@ let assemble_list ?none_if_empty lenb f elements = match lenb with | One -> let l = create 1 in - set_uint8 l 0 (len body) ; + set_uint8 l 0 (length body) ; l | Two -> let l = create 2 in - BE.set_uint16 l 0 (len body) ; + BE.set_uint16 l 0 (length body) ; l | Three -> let l = create 3 in - set_uint24_len l (len body) ; + set_uint24_len l (length body) ; l in let b es = Cstruct.concat (List.map f es) in @@ -58,7 +58,7 @@ let assemble_list ?none_if_empty lenb f elements = | None -> full elements let assemble_certificate c = - let length = len c in + let length = length c in let buf = create 3 in set_uint24_len buf length; buf <+> c @@ -117,7 +117,7 @@ let assemble_certificate_types ts = let assemble_cas cas = let ass x = let buf = create 2 in - BE.set_uint16 buf 0 (len x) ; + BE.set_uint16 buf 0 (length x) ; buf <+> x in assemble_list Two ass cas @@ -144,19 +144,19 @@ let assemble_supported_groups groups = let assemble_keyshare_entry (ng, ks) = let g = assemble_named_group ng in let l = create 2 in - BE.set_uint16 l 0 (len ks) ; + BE.set_uint16 l 0 (length ks) ; g <+> l <+> ks let assemble_psk_id (id, age) = let id_len = create 2 in - BE.set_uint16 id_len 0 (len id) ; + BE.set_uint16 id_len 0 (length id) ; let age_buf = create 4 in BE.set_uint32 age_buf 0 age ; id_len <+> id <+> age_buf let assemble_binder b = let b_len = create 1 in - set_uint8 b_len 0 (len b) ; + set_uint8 b_len 0 (length b) ; b_len <+> b let assemble_client_psks psks = @@ -179,7 +179,7 @@ let assemble_supported_versions vs = let assemble_extension = function | `SecureRenegotiation x -> let buf = create 1 in - set_uint8 buf 0 (len x); + set_uint8 buf 0 (length x); (buf <+> x, RENEGOTIATION_INFO) | `ExtendedMasterSecret -> (create 0, EXTENDED_MASTER_SECRET) | `ECPointFormats -> @@ -191,7 +191,7 @@ let assemble_extension = function let assemble_cookie c = let l = create 2 in - BE.set_uint16 l 0 (len c) ; + BE.set_uint16 l 0 (length c) ; l <+> c let assemble_psk_key_exchange_mode mode = @@ -205,7 +205,7 @@ let assemble_psk_key_exchange_modes modes = let assemble_ext (pay, typ) = let buf = Cstruct.create 4 in BE.set_uint16 buf 0 (extension_type_to_int typ); - BE.set_uint16 buf 2 (len pay); + BE.set_uint16 buf 2 (length pay); buf <+> pay let assemble_extensions ?none_if_empty assemble_e es = @@ -214,7 +214,7 @@ let assemble_extensions ?none_if_empty assemble_e es = let assemble_ca ca = let lenbuf = create 2 in let data = X509.Distinguished_name.encode_der ca in - BE.set_uint16 lenbuf 0 (len data) ; + BE.set_uint16 lenbuf 0 (length data) ; lenbuf <+> data let assemble_certificate_authorities cas = @@ -230,7 +230,7 @@ let assemble_certificate_request_extension e = let assemble_certificate_request_1_3 ?(context = Cstruct.empty) exts = let clen = create 1 in - set_uint8 clen 0 (len context) ; + set_uint8 clen 0 (length context) ; let exts = assemble_extensions assemble_certificate_request_extension exts in clen <+> context <+> exts @@ -303,14 +303,14 @@ let assemble_certs_exts cs = let assemble_certificates_1_3 context certs = let l = create 1 in - set_uint8 l 0 (len context) ; + set_uint8 l 0 (length context) ; l <+> context <+> assemble_certs_exts (List.map (fun c -> c, []) certs) let assemble_sid sid = let buf = create 1 in match sid with | None -> buf - | Some s -> set_uint8 buf 0 (len s); buf <+> s + | Some s -> set_uint8 buf 0 (length s); buf <+> s let assemble_client_hello (cl : client_hello) : Cstruct.t = let version = match cl.client_version with @@ -345,22 +345,22 @@ let assemble_client_hello (cl : client_hello) : Cstruct.t = if List.exists (function `PreSharedKeys _ -> true | _ -> false) cl.extensions then Cstruct.empty else - let buflen = len bbuf + len extensions + 4 (* see above, header *) in + let buflen = length bbuf + length extensions + 4 (* see above, header *) in if buflen >= 256 && buflen <= 511 then - match len extensions with + match length extensions with | 0 -> (* need to construct a 2 byte extension length as well *) let l = 512 (* desired length *) - 2 (* extension length *) - 4 (* padding extension header *) - buflen in let l = max l 0 in (* negative size is not good *) let padding = assemble_client_extension (`Padding l) in let extension_length = create 2 in - BE.set_uint16 extension_length 0 (len padding); + BE.set_uint16 extension_length 0 (length padding); extension_length <+> padding | _ -> let l = 512 - 4 (* padding extension header *) - buflen in let l = max l 0 in let padding = assemble_client_extension (`Padding l) in (* extensions include the 16 bit extension length field *) - let elen = len extensions + len padding - 2 (* the 16 bit length field *) in + let elen = length extensions + length padding - 2 (* the 16 bit length field *) in BE.set_uint16 extensions 0 elen; padding else @@ -382,7 +382,7 @@ let assemble_server_hello (sh : server_hello) : Cstruct.t = v <+> sh.server_random <+> sid <+> cs <+> cm <+> extensions let assemble_dh_parameters p = - let plen, glen, yslen = (len p.dh_p, len p.dh_g, len p.dh_Ys) in + let plen, glen, yslen = (length p.dh_p, length p.dh_g, length p.dh_Ys) in let buf = create (2 + 2 + 2 + plen + glen + yslen) in BE.set_uint16 buf 0 plen; blit p.dh_p 0 buf 2 plen; @@ -396,12 +396,12 @@ let assemble_ec_parameters named_curve point = let hdr = create 4 in set_uint8 hdr 0 (ec_curve_type_to_int NAMED_CURVE); BE.set_uint16 hdr 1 (named_group_to_int (group_to_named_group named_curve)); - set_uint8 hdr 3 (len point); + set_uint8 hdr 3 (length point); hdr <+> point let assemble_digitally_signed signature = let lenbuf = create 2 in - BE.set_uint16 lenbuf 0 (len signature); + BE.set_uint16 lenbuf 0 (length signature); lenbuf <+> signature let assemble_digitally_signed_1_2 sigalg signature = @@ -420,21 +420,21 @@ let assemble_session_ticket (se : session_ticket) = let buf = create 9 in BE.set_uint32 buf 0 se.lifetime ; BE.set_uint32 buf 4 se.age_add ; - set_uint8 buf 8 (len se.nonce) ; + set_uint8 buf 8 (length se.nonce) ; let ticketlen = create 2 in - BE.set_uint16 ticketlen 0 (len se.ticket) ; + BE.set_uint16 ticketlen 0 (length se.ticket) ; let exts = assemble_extensions assemble_session_ticket_extension se.extensions in buf <+> se.nonce <+> ticketlen <+> se.ticket <+> exts let assemble_client_dh_key_exchange kex = - let len = len kex in + let len = length kex in let buf = create (len + 2) in BE.set_uint16 buf 0 len; blit kex 0 buf 2 len; buf let assemble_client_ec_key_exchange kex = - let len = len kex in + let len = length kex in let buf = create (len + 1) in set_uint8 buf 0 len; blit kex 0 buf 1 len; @@ -491,7 +491,7 @@ let assemble_handshake hs = (cs, KEY_UPDATE) | EndOfEarlyData -> (create 0, END_OF_EARLY_DATA) in - let pay_len = len payload in + let pay_len = length payload in let buf = assemble_hs payload_type pay_len in buf <+> payload diff --git a/lwt/tls_lwt.ml b/lwt/tls_lwt.ml index cb273e36..04382712 100644 --- a/lwt/tls_lwt.ml +++ b/lwt/tls_lwt.ml @@ -27,7 +27,7 @@ module Lwt_cs = struct and read = naked ~name:"Tls_lwt.read" Lwt_bytes.read let rec write_full fd = function - | cs when Cstruct.len cs = 0 -> return_unit + | cs when Cstruct.length cs = 0 -> return_unit | cs -> write fd cs >>= o (write_full fd) (Cstruct.shift cs) end @@ -92,8 +92,8 @@ module Unix = struct let writeout res = let open Cstruct in - let rlen = len res in - let n = min (len buf) rlen in + let rlen = length res in + let n = min (length buf) rlen in blit res 0 buf 0 n ; t.linger <- (if n < rlen then Some (sub res n (rlen - n)) else None) ; diff --git a/tests/key_derivation.ml b/tests/key_derivation.ml index 63b281cd..661b80a4 100644 --- a/tests/key_derivation.ml +++ b/tests/key_derivation.ml @@ -422,7 +422,7 @@ let processed_payload () = let nonce = Tls.Crypto.aead_nonce write_handshake_iv 0L in let key = Mirage_crypto.Cipher_block.AES.GCM.of_secret write_handshake_key in let adata = Tls.Writer.assemble_hdr `TLS_1_2 (Tls.Packet.APPLICATION_DATA, Cstruct.empty) in - Cstruct.BE.set_uint16 adata 3 (17 + Cstruct.len server_payload) ; + Cstruct.BE.set_uint16 adata 3 (17 + Cstruct.length server_payload) ; let res = Mirage_crypto.Cipher_block.AES.GCM.authenticate_encrypt ~key ~adata ~nonce buf in diff --git a/tests/readertests.ml b/tests/readertests.ml index c003c8b5..e2a16b6f 100644 --- a/tests/readertests.ml +++ b/tests/readertests.ml @@ -427,7 +427,7 @@ let good_dh_param_parser xs _ = let buf = list_to_cstruct xs in match Reader.parse_dh_parameters buf with | Error _ -> assert_failure "dh params parser broken" - | Ok (_, _, rst) -> assert_equal 0 (Cstruct.len rst) + | Ok (_, _, rst) -> assert_equal 0 (Cstruct.length rst) let good_dh_params_tests = List.mapi @@ -438,12 +438,12 @@ let bad_dh_param_parser buf _ = match Reader.parse_dh_parameters buf with | Error _ -> () | Ok (_, _, rst) -> - if Cstruct.len rst == 0 then + if Cstruct.length rst == 0 then assert_failure "dh params parser broken" let bad_dh_params_tests = let param = list_to_cstruct (List.hd good_dhparams) in - let l = Cstruct.len param in + let l = Cstruct.length param in let bad_params = [ param <+> Cstruct.create 1 ; @@ -460,7 +460,7 @@ let bad_dh_params_tests = ] in let lastparam = list_to_cstruct (List.nth good_dhparams 5) in - let l = Cstruct.len lastparam in + let l = Cstruct.length lastparam in let more_bad = [ Cstruct.sub lastparam 0 130 <+> list_to_cstruct [0 ; 5 ; 1] <+> Cstruct.sub lastparam 130 (l - 130) ; @@ -588,7 +588,7 @@ let good_digitally_signed_1_2_tests = let bad_dss_1_2 = let ds = list_to_cstruct (List.hd good_digitally_signed_1_2) in - let l = Cstruct.len ds in + let l = Cstruct.length ds in [ Cstruct.sub ds 2 20 ; Cstruct.sub ds 0 20 ; @@ -632,7 +632,7 @@ let good_digitally_signed_tests = let bad_dss = let ds = Cstruct.shift (list_to_cstruct (List.hd good_digitally_signed_1_2)) 2 in - let l = Cstruct.len ds in + let l = Cstruct.length ds in [ list_to_cstruct [0xff ; 0xff] <+> ds ; list_to_cstruct [0xff ; 0xff] <+> Cstruct.shift ds 2 ; diff --git a/tests/readerwritertests.ml b/tests/readerwritertests.ml index 267a78c1..8829ab34 100644 --- a/tests/readerwritertests.ml +++ b/tests/readerwritertests.ml @@ -24,14 +24,14 @@ let readerwriter_header (v, ct, cs) _ = match Reader.parse_record buf with | Ok (`Record ((hdr, payload), f)) -> let open Core in - assert_equal 0 (Cstruct.len f) ; + assert_equal 0 (Cstruct.length f) ; assert_equal (v :> tls_any_version) hdr.version ; assert_equal ct hdr.content_type ; assert_cs_eq cs payload ; let buf' = Writer.assemble_hdr v (hdr.content_type, payload) in (match Reader.parse_record buf' with | Ok (`Record ((hdr, payload), f)) -> - assert_equal 0 (Cstruct.len f) ; + assert_equal 0 (Cstruct.length f) ; assert_equal (v :> tls_any_version) hdr.version ; assert_equal ct hdr.content_type ; assert_cs_eq cs payload ; @@ -188,14 +188,14 @@ let readerwriter_dh_params params _ = let buf = Writer.assemble_dh_parameters params in match Reader.parse_dh_parameters buf with | Ok (p, raw, rst) -> - assert_equal (Cstruct.len rst) 0 ; + assert_equal (Cstruct.length rst) 0 ; assert_dh_eq p params ; assert_equal buf raw ; (* lets get crazy and do it one more time *) let buf' = Writer.assemble_dh_parameters p in (match Reader.parse_dh_parameters buf' with | Ok (p', raw', rst') -> - assert_equal (Cstruct.len rst') 0 ; + assert_equal (Cstruct.length rst') 0 ; assert_dh_eq p' params ; assert_equal buf raw' ; | Error _ -> assert_failure "inner read and write dh params broken") diff --git a/tls.opam b/tls.opam index caf5e300..350a41de 100644 --- a/tls.opam +++ b/tls.opam @@ -18,7 +18,7 @@ depends: [ "dune" {>= "1.0"} "ppx_sexp_conv" {>= "v0.9.0"} "ppx_cstruct" {>= "3.0.0"} - "cstruct" {>= "4.0.0"} + "cstruct" {>= "6.0.0"} "cstruct-sexp" "sexplib" "mirage-crypto" {>= "0.8.1"}