Skip to content

reduce the errors #505

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 12 commits into from
Aug 21, 2024
Merged

reduce the errors #505

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
12 commits
Select commit Hold shift + click to select a range
988f64e
remove errors that are never constructed
hannesm Aug 21, 2024
fc89dfa
condense bad certificate errors
hannesm Aug 21, 2024
61606ed
remove NoCertificateConfigured error
hannesm Aug 21, 2024
5bd9af9
provide a better error for unknown content types
hannesm Aug 21, 2024
3371817
condense DH errors
hannesm Aug 21, 2024
7cb96be
condense reader errors
hannesm Aug 21, 2024
52ee03e
condense all the errors
hannesm Aug 21, 2024
a622778
push all remaining alerts into UNKNOWN
hannesm Aug 21, 2024
67fdb70
reduce extension types to those we actually use
hannesm Aug 21, 2024
4271c5b
reduce further enums in packet.ml (client_certificate_type, compressi…
hannesm Aug 21, 2024
e4e9c95
improve error message (fix #491)
hannesm Aug 21, 2024
d9da18c
re-introduce BadECDH, reduce Fmt.to_to_string usage
hannesm Aug 21, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion lib/core.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,8 @@ let split_str ?(start = 0) str off =
String.sub str start off,
String.sub str (start + off) (String.length str - off - start)

let map_reader_error r = Result.map_error (fun re -> `Fatal (`ReaderError re)) r
let map_reader_error r =
Result.map_error (fun e -> `Fatal e) r

type tls13 = [ `TLS_1_3 ]

Expand Down
120 changes: 39 additions & 81 deletions lib/engine.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,6 @@ open State

type state = State.state

type client_hello_errors = State.client_hello_errors
type error = State.error
type fatal = State.fatal
type failure = State.failure
Expand All @@ -18,60 +17,20 @@ let alert_of_error = function
| `NoConfiguredSignatureAlgorithm _ -> Packet.HANDSHAKE_FAILURE
| `AuthenticationFailure err -> alert_of_authentication_failure err
| `NoMatchingCertificateFound _ -> Packet.UNRECOGNIZED_NAME
| `NoCertificateConfigured -> Packet.HANDSHAKE_FAILURE
| `CouldntSelectCertificate -> Packet.HANDSHAKE_FAILURE

let alert_of_fatal = function
| `NoSecureRenegotiation -> Packet.HANDSHAKE_FAILURE
| `NoSupportedGroup -> Packet.HANDSHAKE_FAILURE
| `MACUnderflow -> Packet.BAD_RECORD_MAC
| `MACMismatch -> Packet.BAD_RECORD_MAC
| `RecordOverflow _ -> Packet.RECORD_OVERFLOW
| `UnknownRecordVersion _ -> Packet.PROTOCOL_VERSION
| `UnknownContentType _ -> Packet.UNEXPECTED_MESSAGE
| `ReaderError (Reader.UnknownVersion _) -> Packet.PROTOCOL_VERSION
| `ReaderError (Reader.TrailingBytes _) -> Packet.UNEXPECTED_MESSAGE
| `ReaderError Reader.Underflow -> Packet.DECODE_ERROR
| `ReaderError _ -> Packet.ILLEGAL_PARAMETER
| `CannotHandleApplicationDataYet -> Packet.UNEXPECTED_MESSAGE
| `NoHeartbeat -> Packet.UNEXPECTED_MESSAGE
| `BadRecordVersion _ -> Packet.PROTOCOL_VERSION
| `InvalidRenegotiation -> Packet.HANDSHAKE_FAILURE
| `InvalidServerHello -> Packet.UNSUPPORTED_EXTENSION
| `InvalidRenegotiationVersion _ -> Packet.HANDSHAKE_FAILURE
| `NoCertificateReceived -> Packet.HANDSHAKE_FAILURE
| `NoCertificateVerifyReceived -> Packet.HANDSHAKE_FAILURE
| `NotRSACertificate -> Packet.BAD_CERTIFICATE
| `InvalidCertificateUsage -> Packet.BAD_CERTIFICATE
| `InvalidCertificateExtendedUsage -> Packet.BAD_CERTIFICATE
| `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
| `UnexpectedCCS -> Packet.UNEXPECTED_MESSAGE
| `UnexpectedHandshake _ -> Packet.UNEXPECTED_MESSAGE
| `SignatureVerificationFailed _ -> Packet.HANDSHAKE_FAILURE
| `SigningFailed _ -> Packet.HANDSHAKE_FAILURE
| `KeyTooSmall -> Packet.INSUFFICIENT_SECURITY
| `BadCertificateChain -> Packet.BAD_CERTIFICATE
| `InvalidClientHello `NoSignatureAlgorithmsExtension
| `InvalidClientHello `NoKeyShareExtension
| `InvalidClientHello `NoSupportedGroupExtension -> Packet.MISSING_EXTENSION
| `InvalidClientHello (`NotSetSupportedGroup _)
| `InvalidClientHello (`NotSetKeyShare _)
| `InvalidClientHello (`NotSubsetKeyShareSupportedGroup _) -> Packet.ILLEGAL_PARAMETER
| `InvalidClientHello _ -> Packet.HANDSHAKE_FAILURE
| `InappropriateFallback -> Packet.INAPPROPRIATE_FALLBACK
| `NoApplicationProtocol -> Packet.NO_APPLICATION_PROTOCOL
| `HelloRetryRequest -> Packet.HANDSHAKE_FAILURE (* TODO check *)
| `InvalidMessage -> Packet.HANDSHAKE_FAILURE
| `Toomany0rttbytes -> Packet.UNEXPECTED_MESSAGE
| `MissingContentType -> Packet.UNEXPECTED_MESSAGE
| `Downgrade12 | `Downgrade11 -> Packet.ILLEGAL_PARAMETER
| `WriteHalfClosed -> Packet.UNEXPECTED_MESSAGE
| `Protocol_version _ -> Packet.PROTOCOL_VERSION
| `Unexpected _ -> Packet.UNEXPECTED_MESSAGE
| `Decode _ -> Packet.DECODE_ERROR
| `Handshake _ -> Packet.HANDSHAKE_FAILURE
| `Bad_mac -> Packet.BAD_RECORD_MAC
| `Record_overflow _ -> Packet.RECORD_OVERFLOW
| `Unsupported_extension -> Packet.UNSUPPORTED_EXTENSION
| `Bad_certificate _ -> Packet.BAD_CERTIFICATE
| `Missing_extension _ -> Packet.MISSING_EXTENSION
| `Inappropriate_fallback -> Packet.INAPPROPRIATE_FALLBACK
| `No_application_protocol -> Packet.NO_APPLICATION_PROTOCOL

let alert_of_failure = function
| `Error x -> Packet.FATAL, alert_of_error x
Expand Down Expand Up @@ -191,13 +150,13 @@ let verify_mac sequence mac mac_k ty ver decrypted =
let module H = (val Digestif.module_of_hash' mac) in
String.length decrypted - H.digest_size
in
let* () = guard (macstart >= 0) (`Fatal `MACUnderflow) in
let* () = guard (macstart >= 0) (`Fatal (`Decode "MAC underflow")) in
let (body, mmac) = split_str decrypted macstart in
let cmac =
let ver = pair_of_tls_version ver in
let hdr = Crypto.pseudo_header sequence ty ver (String.length body) in
Crypto.mac mac mac_k hdr body in
let* () = guard (String.equal cmac mmac) (`Fatal `MACMismatch) in
let* () = guard (String.equal cmac mmac) (`Fatal `Bad_mac) in
Ok body


Expand All @@ -215,7 +174,7 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
https://www.openssl.org/~bodo/tls-cbc.txt *)
let mask_decrypt_failure seq mac mac_k =
let* _ = compute_mac seq mac mac_k buf in
Error (`Fatal `MACMismatch)
Error (`Fatal `Bad_mac)
in

let dec ctx =
Expand All @@ -236,7 +195,7 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
Ok (CBC { c with iv_mode = Iv iv' }, msg)
| Random_iv ->
if String.length buf < Crypto.cbc_block c.cipher then
Error (`Fatal `MACUnderflow)
Error (`Fatal (`Decode "MAC underflow"))
else
let iv, buf = split_str buf (Crypto.cbc_block c.cipher) in
let* msg, _ = dec iv buf in
Expand All @@ -246,7 +205,7 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
if c.explicit_nonce then
let explicit_nonce_len = 8 in
if String.length buf < explicit_nonce_len then
Error (`Fatal `MACUnderflow)
Error (`Fatal (`Decode "MAC underflow"))
else
let explicit_nonce, buf = split_str buf explicit_nonce_len in
let adata =
Expand All @@ -255,7 +214,7 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
and nonce = c.nonce ^ explicit_nonce
in
match Crypto.decrypt_aead ~cipher:c.cipher ~key:c.cipher_secret ~nonce ~adata buf with
| None -> Error (`Fatal `MACMismatch)
| None -> Error (`Fatal `Bad_mac)
| Some x -> Ok (AEAD c, x)
else
(* RFC 7905: no explicit nonce, instead TLS 1.3 construction is adapted *)
Expand All @@ -265,7 +224,7 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
and nonce = Crypto.aead_nonce c.nonce seq
in
(match Crypto.decrypt_aead ~adata ~cipher:c.cipher ~key:c.cipher_secret ~nonce buf with
| None -> Error (`Fatal `MACMismatch)
| None -> Error (`Fatal `Bad_mac)
| Some x -> Ok (AEAD c, x))
in
match st, version with
Expand All @@ -288,12 +247,12 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
let nonce = Crypto.aead_nonce c.nonce ctx.sequence in
let unpad x =
let rec eat = function
| -1 -> Error (`Fatal `MissingContentType)
| -1 -> Error (`Fatal (`Unexpected (`Message "missing content type")))
| idx -> match String.get_uint8 x idx with
| 0 -> eat (pred idx)
| n -> match Packet.int_to_content_type n with
| Some ct -> Ok (String.sub x 0 idx, ct)
| None -> Error (`Fatal `MACUnderflow) (* TODO better error? *)
| None -> Error (`Fatal (`Unexpected (`Content_type n)))
in
eat (pred (String.length x))
in
Expand All @@ -303,12 +262,14 @@ let decrypt ?(trial = false) (version : tls_version) (st : crypto_state) ty buf
if trial then
Ok (Some ctx, "", Packet.APPLICATION_DATA)
else
Error (`Fatal `MACMismatch)
Error (`Fatal `Bad_mac)
| Some x ->
let* data, ty = unpad x in
Ok (Some { ctx with sequence = Int64.succ ctx.sequence }, data, ty))
| _ -> Error (`Fatal `InvalidMessage))
| _ -> Error (`Fatal `InvalidMessage))
| _ -> Error (`Fatal (`Handshake (`Message "unexpected cipher state (must be AEAD)"))))
| ct ->
let msg = "unexpected content type (TLS 1.3, encrypted) " ^ Packet.content_type_to_string ct in
Error (`Fatal (`Handshake (`Message msg))))
| Some ctx, _ ->
let* st', msg = dec ctx in
let ctx' = { cipher_st = st' ; sequence = Int64.succ ctx.sequence } in
Expand All @@ -322,19 +283,9 @@ let rec separate_records : string -> ((tls_hdr * string) list * string, failure)
| Ok (`Record (packet, fragment)) ->
let* tl, frag = separate_records fragment in
Ok (packet :: tl, frag)
| Error (Overflow x) ->
Tracing.cs ~tag:"buf-in" buf ;
Error (`Fatal (`RecordOverflow x))
| Error (UnknownVersion v) ->
Tracing.cs ~tag:"buf-in" buf ;
Error (`Fatal (`UnknownRecordVersion v))
| Error (UnknownContent c) ->
Tracing.cs ~tag:"buf-in" buf ;
Error (`Fatal (`UnknownContentType c))
| Error e ->
Tracing.cs ~tag:"buf-in" buf ;
Error (`Fatal (`ReaderError e))

Error (`Fatal e)

let encrypt_records encryptor version records =
let rec split = function
Expand Down Expand Up @@ -415,7 +366,7 @@ let handle_change_cipher_spec = function
| Server13 AwaitClientHelloHRR13
| Server13 (AwaitClientCertificate13 _)
| Server13 (AwaitClientFinished13 _) -> (fun s _ -> Ok (s, []))
| _ -> (fun _ _ -> Error (`Fatal `UnexpectedCCS))
| _ -> (fun _ _ -> Error (`Fatal (`Unexpected (`Message "change cipher spec"))))

and handle_handshake = function
| Client cs -> Handshake_client.handle_handshake cs
Expand Down Expand Up @@ -443,7 +394,7 @@ let handle_packet hs buf = function
(Tracing.cs ~tag:"application-data-in" buf;
Ok (hs, [], non_empty buf, false))
else
Error (`Fatal `CannotHandleApplicationDataYet)
Error (`Fatal (`Unexpected (`Message "application data")))

| Packet.CHANGE_CIPHER_SPEC ->
let* hs, items = handle_change_cipher_spec hs.machina hs buf in
Expand All @@ -465,7 +416,10 @@ let decrement_early_data hs ty buf =
let bytes left cipher =
let count = String.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'
if left' < 0l then
Error (`Fatal (`Unexpected (`Message "too many 0RTT bytes")))
else
Ok left'
in
if ty = Packet.APPLICATION_DATA && early_data hs then
let cipher = match hs.session with
Expand All @@ -489,8 +443,12 @@ let handle_raw_record state (hdr, buf as record : raw_record) =
| Client (AwaitServerHello _), _ -> Ok ()
| Server AwaitClientHello, _ -> Ok ()
| Server13 AwaitClientHelloHRR13, _ -> Ok ()
| _, `TLS_1_3 -> guard (hdr.version = `TLS_1_2) (`Fatal (`BadRecordVersion hdr.version))
| _, v -> guard (version_eq hdr.version v) (`Fatal (`BadRecordVersion hdr.version))
| _, `TLS_1_3 ->
guard (hdr.version = `TLS_1_2)
(`Fatal (`Protocol_version (`Bad_record hdr.version)))
| _, v ->
guard (version_eq hdr.version v)
(`Fatal (`Protocol_version (`Bad_record hdr.version)))
in
let trial = match hs.machina with
| Server13 (AwaitEndOfEarlyData13 _) | Server13 Established13 -> false
Expand Down Expand Up @@ -630,7 +588,7 @@ let reneg ?authenticator ?acceptable_cas ?cert st =

let key_update ?(request = true) state =
if state.write_closed then
Error (`Fatal `WriteHalfClosed)
Error (`Fatal (`Unexpected (`Message "write half already closed")))
else
let* state', out = Handshake_common.output_key_update ~request state in
let _, outbuf = send_records state [out] in
Expand Down
83 changes: 24 additions & 59 deletions lib/engine.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,70 +59,35 @@ type error = [
| `NoConfiguredVersions of Core.tls_version list
| `NoConfiguredSignatureAlgorithm of Core.signature_algorithm list
| `NoMatchingCertificateFound of string
| `NoCertificateConfigured
| `CouldntSelectCertificate
]

type client_hello_errors = [
| `EmptyCiphersuites
| `NotSetCiphersuites of Packet.any_ciphersuite list
| `NoSupportedCiphersuite of Packet.any_ciphersuite list
| `NotSetExtension of Core.client_extension list
| `NoSignatureAlgorithmsExtension
| `NoGoodSignatureAlgorithms of Core.signature_algorithm list
| `NoKeyShareExtension
| `NoSupportedGroupExtension
| `NotSetSupportedGroup of Packet.named_group list
| `NotSetKeyShare of (Packet.named_group * string) list
| `NotSubsetKeyShareSupportedGroup of (Packet.named_group list * (Packet.named_group * string) list)
| `Has0rttAfterHRR
| `NoCookie
]

(** failures from received garbage or lack of features *)
type fatal = [
| `NoSecureRenegotiation
| `NoSupportedGroup
| `NoVersions of Core.tls_any_version list
| `ReaderError of Reader.error
| `NoCertificateReceived
| `NoCertificateVerifyReceived
| `NotRSACertificate
| `KeyTooSmall
| `SignatureVerificationFailed of string
| `SigningFailed of string
| `BadCertificateChain
| `MACMismatch
| `MACUnderflow
| `RecordOverflow of int
| `UnknownRecordVersion of int * int
| `UnknownContentType of int
| `CannotHandleApplicationDataYet
| `NoHeartbeat
| `BadRecordVersion of Core.tls_any_version
| `BadFinished
| `HandshakeFragmentsNotEmpty
| `InsufficientDH
| `InvalidDH
| `BadECDH of Mirage_crypto_ec.error
| `InvalidRenegotiation
| `InvalidClientHello of client_hello_errors
| `InvalidServerHello
| `InvalidRenegotiationVersion of Core.tls_version
| `InappropriateFallback
| `UnexpectedCCS
| `UnexpectedHandshake of Core.tls_handshake
| `InvalidCertificateUsage
| `InvalidCertificateExtendedUsage
| `InvalidSession
| `NoApplicationProtocol
| `HelloRetryRequest
| `InvalidMessage
| `Toomany0rttbytes
| `MissingContentType
| `Downgrade12
| `Downgrade11
| `WriteHalfClosed
| `Protocol_version of [
| `None_supported of Core.tls_any_version list
| `Unknown_record of int * int
| `Bad_record of Core.tls_any_version
]
| `Unexpected of [
| `Content_type of int
| `Message of string
| `Handshake of Core.tls_handshake
]
| `Decode of string
| `Handshake of [
| `Message of string
| `Fragments
| `BadDH of string
| `BadECDH of Mirage_crypto_ec.error
]
| `Bad_certificate of string
| `Missing_extension of string
| `Bad_mac
| `Record_overflow of int
| `Unsupported_extension
| `Inappropriate_fallback
| `No_application_protocol
]

(** type of failures *)
Expand Down
Loading