diff --git a/CHANGES.md b/CHANGES.md index 90ffcba3..7a8d3a1a 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,11 @@ * SCSV server-side downgrade prevention (contributed by Gabriel de Perthuis @g2p #5) * remove RC4 ciphers from default config #8 * support for AEAD ciphers, currently CCM #191 +* proper bounds checking of handshake fragments #255 +* disable application data between CCS and Finished #237 +* remove secure renegotiation configuration option #256 +* expose epoch in mirage interface +* error reporting #246 0.3.0 (2014-12-21): * X509_lwt provides `Fingerprints and `Hex_fingerprints constructor for diff --git a/README.md b/README.md index a27cda6c..5bce0855 100644 --- a/README.md +++ b/README.md @@ -139,23 +139,6 @@ functional style, without any side effects. [CVE-2014-3466]: https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2014-3466 [CVE-2014-0224]: https://cve.mitre.org/cgi-bin/cvename.cgi?name=CVE-2014-0224 - -**** - -Posts in the TLS series: - - - [Introducing transport layer security (TLS) in pure OCaml][tls-intro] - - [OCaml-TLS: building the nocrypto library core][nocrypto-intro] - - [OCaml-TLS: adventures in X.509 certificate parsing and validation][x509-intro] - - [OCaml-TLS: ASN.1 and notation embedding][asn1-intro] - - [OCaml-TLS: the protocol implementation and mitigations to known attacks][tls-api] - -[tls-intro]: http://openmirage.org/blog/introducing-ocaml-tls -[nocrypto-intro]: http://openmirage.org/blog/introducing-nocrypto -[x509-intro]: http://openmirage.org/blog/introducing-x509 -[asn1-intro]: http://openmirage.org/blog/introducing-asn1 -[tls-api]: http://openmirage.org/blog/ocaml-tls-api-internals-attacks-mitigation - ### Implemented standards - RFC 2246 - TLS Protocol version 1.0 @@ -165,6 +148,7 @@ Posts in the TLS series: - RFC 4366 - TLS Extensions (notably Server Name Indication - SNI) - RFC 5246 - TLS Protocol version 1.2 - RFC 5746 - TLS Renegotiation Indication Extension +- RFC 7465 - Prohibiting RC4 Cipher Suites - draft-ietf-tls-padding-00 - A TLS padding extension - draft-mathewson-no-gmtunixtime - No UNIX time in client and server hello - draft-ietf-tls-downgrade-scsv - Reject client-flagged version downgrades diff --git a/lib/config.ml b/lib/config.ml index 8e10cce1..5617d86d 100644 --- a/lib/config.ml +++ b/lib/config.ml @@ -6,7 +6,7 @@ open Core open Sexplib.Std -type certchain = Certificate.certificate list * Rsa.priv with sexp +type certchain = X509.Certificate.certificate list * Rsa.priv with sexp type own_cert = [ | `None @@ -99,7 +99,7 @@ let validate_common config = invalid "set of ciphers is empty" module CertTypeUsageOrdered = struct - type t = Certificate.key_type * Asn_grammars.Extension.key_usage + type t = X509.Certificate.key_type * X509.Certificate.key_usage let compare = compare end module CertTypeUsageSet = Set.Make(CertTypeUsageOrdered) @@ -109,16 +109,16 @@ let validate_certificate_chain = function let pub = Rsa.pub_of_priv priv in if Rsa.pub_bits pub < min_rsa_key_size then invalid "RSA key too short!" ; - ( match Certificate.cert_pubkey s with + ( match X509.Certificate.cert_pubkey s with | Some (`RSA pub') when pub = pub' -> () | _ -> invalid "public / private key combination" ) ; ( match init_and_last chain with | Some (ch, trust) -> (* TODO: verify that certificates are x509 v3 if TLS_1_2 *) - ( match Certificate.verify_chain_of_trust ~anchors:[trust] (s :: ch) with + ( match X509.Certificate.verify_chain_of_trust ~anchors:[trust] (s :: ch) with | `Ok _ -> () | `Fail x -> invalid ("certificate chain does not validate: " ^ - (Certificate.certificate_failure_to_string x)) ) + (X509.Certificate.certificate_failure_to_string x)) ) | None -> () ) | _ -> invalid "certificate" @@ -136,7 +136,7 @@ let non_overlapping cs = filter_map cs ~f:(function | (s :: _, _) -> Some s | _ -> None) - |> List.map Certificate.cert_hostnames + |> List.map X509.Certificate.cert_hostnames in List.map (fun xs -> List.fold_right StringSet.add xs StringSet.empty) nameslists in @@ -178,8 +178,8 @@ let validate_server config = not (CertTypeUsageSet.for_all (fun (t, u) -> List.exists (fun c -> - Certificate.supports_keytype c t && - Certificate.supports_usage ~not_present:true c u) + X509.Certificate.supports_keytype c t && + X509.Certificate.supports_usage ~not_present:true c u) server_certs) typeusage) then diff --git a/lib/config.mli b/lib/config.mli index 01fe37c4..52ae4784 100644 --- a/lib/config.mli +++ b/lib/config.mli @@ -4,7 +4,7 @@ open Core (** Configuration of the TLS stack *) (** certificate chain and private key of the first certificate *) -type certchain = Certificate.certificate list * Nocrypto.Rsa.priv +type certchain = X509.Certificate.certificate list * Nocrypto.Rsa.priv (** polymorphic variant of own certificates *) type own_cert = [ diff --git a/lib/engine.ml b/lib/engine.ml index 33c708a5..72b22b08 100644 --- a/lib/engine.ml +++ b/lib/engine.ml @@ -12,9 +12,9 @@ type fatal = State.fatal type failure = State.failure with sexp let alert_of_authentication_failure = function - | Certificate.SelfSigned _ -> Packet.UNKNOWN_CA - | Certificate.NoTrustAnchor -> Packet.UNKNOWN_CA - | Certificate.CertificateExpired _ -> Packet.CERTIFICATE_EXPIRED + | X509.Certificate.SelfSigned _ -> Packet.UNKNOWN_CA + | X509.Certificate.NoTrustAnchor -> Packet.UNKNOWN_CA + | X509.Certificate.CertificateExpired _ -> Packet.CERTIFICATE_EXPIRED | _ -> Packet.BAD_CERTIFICATE let alert_of_error = function @@ -571,10 +571,10 @@ open Sexplib.Conv type epoch_data = { protocol_version : tls_version ; ciphersuite : Ciphersuite.ciphersuite ; - peer_certificate : Certificate.certificate list ; + peer_certificate : X509.Certificate.certificate list ; peer_name : string option ; - trust_anchor : Certificate.certificate option ; - own_certificate : Certificate.certificate list ; + trust_anchor : X509.Certificate.certificate option ; + own_certificate : X509.Certificate.certificate list ; own_private_key : Nocrypto.Rsa.priv option ; own_name : string option ; master_secret : master_secret ; diff --git a/lib/engine.mli b/lib/engine.mli index abb2c436..d6a8a36f 100644 --- a/lib/engine.mli +++ b/lib/engine.mli @@ -2,7 +2,7 @@ (** failures which can be mitigated by reconfiguration *) type error = [ - | `AuthenticationFailure of Certificate.certificate_failure + | `AuthenticationFailure of X509.Certificate.certificate_failure | `NoConfiguredCiphersuite of Ciphersuite.ciphersuite list | `NoConfiguredVersion of Core.tls_version | `NoConfiguredHash of Nocrypto.Hash.hash list @@ -102,10 +102,10 @@ val server : Config.server -> state type epoch_data = { protocol_version : Core.tls_version ; ciphersuite : Ciphersuite.ciphersuite ; - peer_certificate : Certificate.certificate list ; + peer_certificate : X509.Certificate.certificate list ; peer_name : string option ; - trust_anchor : Certificate.certificate option ; - own_certificate : Certificate.certificate list ; + trust_anchor : X509.Certificate.certificate option ; + own_certificate : X509.Certificate.certificate list ; own_private_key : Nocrypto.Rsa.priv option ; own_name : string option ; master_secret : State.master_secret ; diff --git a/lib/handshake_client.ml b/lib/handshake_client.ml index a36a3c35..2093df02 100644 --- a/lib/handshake_client.ml +++ b/lib/handshake_client.ml @@ -108,18 +108,17 @@ let answer_server_hello_renegotiate state session ch (sh : server_hello) raw log ({ state with machina = Client machina }, []) let validate_keytype_usage certificates ciphersuite = - let open Certificate in let keytype, usage = Ciphersuite.(o required_keytype_and_usage ciphersuite_kex ciphersuite) in match certificates with | [] -> fail (`Fatal `NoCertificateReceived) | cert :: _ -> - guard (supports_keytype cert keytype) (`Fatal `NotRSACertificate) >>= fun () -> - guard (supports_usage ~not_present:true cert usage) (`Fatal `InvalidCertificateUsage) >>= fun () -> + guard (X509.Certificate.supports_keytype cert keytype) (`Fatal `NotRSACertificate) >>= fun () -> + guard (X509.Certificate.supports_usage ~not_present:true cert usage) (`Fatal `InvalidCertificateUsage) >>= fun () -> guard - (supports_extended_usage cert `Server_auth || - supports_extended_usage ~not_present:true cert `Any) + (X509.Certificate.supports_extended_usage cert `Server_auth || + X509.Certificate.supports_extended_usage ~not_present:true cert `Any) (`Fatal `InvalidCertificateExtendedUsage) let answer_certificate_RSA state session cs raw log = @@ -221,7 +220,7 @@ let answer_server_hello_done state session sigalgs kex premaster raw log = ( match session.client_auth, session.own_private_key with | true, Some p -> - let cert = Certificate (List.map Certificate.cs_of_cert session.own_certificate) in + let cert = Certificate (List.map X509.Certificate.cs_of_cert session.own_certificate) in let ccert = Writer.assemble_handshake cert in let to_sign = log @ [ raw ; ccert ; ckex ] in let data = Cs.appends to_sign in diff --git a/lib/handshake_common.ml b/lib/handshake_common.ml index 84af543d..0c93089c 100644 --- a/lib/handshake_common.ml +++ b/lib/handshake_common.ml @@ -153,14 +153,14 @@ let signature version data sig_algs hashes private_key = | None -> fail (`Error (`NoConfiguredHash client_hashes)) | Some hash -> return hash ) >|= fun hash_algo -> let hash = Hash.digest hash_algo data in - let cs = Asn_grammars.pkcs1_digest_info_to_cstruct (hash_algo, hash) in + let cs = X509.Certificate.pkcs1_digest_info_to_cstruct (hash_algo, hash) in let sign = Rsa.PKCS1.sign private_key cs in Writer.assemble_digitally_signed_1_2 hash_algo Packet.RSA sign let peer_rsa_key = function | [] -> fail (`Fatal `NoCertificateReceived) | cert::_ -> - match Certificate.cert_pubkey cert with + match X509.Certificate.cert_pubkey cert with | Some (`RSA key) -> return key | _ -> fail (`Fatal `NotRSACertificate) @@ -181,7 +181,7 @@ let verify_digitally_signed version data signature_data certificates = ( match parse_digitally_signed_1_2 data with | Or_error.Ok (hash_algo, Packet.RSA, signature) -> let compare_hashes should data = - match Asn_grammars.pkcs1_digest_info_of_cstruct should with + match X509.Certificate.pkcs1_digest_info_of_cstruct should with | Some (hash_algo', target) when hash_algo = hash_algo' -> guard (Crypto.digest_eq hash_algo ~target data) (`Fatal `RSASignatureMismatch) | _ -> fail (`Fatal `HashAlgorithmMismatch) @@ -202,8 +202,6 @@ let verify_digitally_signed version data signature_data certificates = verifier signature signature_data let validate_chain authenticator certificates hostname = - let open Certificate in - let authenticate authenticator host certificates = match authenticator ?host certificates with | `Fail err -> fail (`Error (`AuthenticationFailure err)) @@ -211,14 +209,14 @@ let validate_chain authenticator certificates hostname = and key_size min cs = let check c = - match Certificate.cert_pubkey c with + match X509.Certificate.cert_pubkey c with | Some (`RSA key) when Rsa.pub_bits key >= min -> true | _ -> false in guard (List.for_all check cs) (`Fatal `KeyTooSmall) and parse_certificates certs = - let certificates = filter_map ~f:parse certs in + let certificates = filter_map ~f:X509.Certificate.parse certs in guard (List.length certs = List.length certificates) (`Fatal `BadCertificateChain) >|= fun () -> certificates diff --git a/lib/handshake_server.ml b/lib/handshake_server.ml index d76d815e..5f925f64 100644 --- a/lib/handshake_server.ml +++ b/lib/handshake_server.ml @@ -113,7 +113,7 @@ let sig_algs client_hello = let rec find_matching host certs = match certs with | (s::_, _) as chain ::xs -> - if Certificate.supports_hostname s host then + if X509.Certificate.supports_hostname s host then Some chain else find_matching host xs @@ -142,7 +142,7 @@ let agreed_cert certs hostname = let agreed_cipher cert requested = let type_usage_matches cipher = let cstyp, csusage = Ciphersuite.(required_keytype_and_usage @@ ciphersuite_kex cipher) in - Certificate.(supports_keytype cert cstyp && supports_usage ~not_present:true cert csusage) + X509.Certificate.(supports_keytype cert cstyp && supports_usage ~not_present:true cert csusage) in List.filter type_usage_matches requested @@ -202,7 +202,7 @@ let answer_client_hello_common state reneg ch raw = match session.own_certificate with | [] -> [] | certs -> - let cert = Certificate (List.map Certificate.cs_of_cert certs) in + let cert = Certificate (List.map X509.Certificate.cs_of_cert certs) in (* Tracing.sexpf ~tag:"handshake-out" ~f:sexp_of_tls_handshake cert ; *) [ Writer.assemble_handshake cert ] diff --git a/lib/state.ml b/lib/state.ml index 1644f0e3..b604d1bb 100644 --- a/lib/state.ml +++ b/lib/state.ml @@ -81,9 +81,9 @@ type session_data = { client_random : Cstruct_s.t ; (* 32 bytes random from the client hello *) client_version : tls_any_version ; (* version in client hello (needed in RSA client key exchange) *) ciphersuite : Ciphersuite.ciphersuite ; - peer_certificate : Certificate.certificate list ; - trust_anchor : Certificate.certificate option ; - own_certificate : Certificate.certificate list ; + peer_certificate : X509.Certificate.certificate list ; + trust_anchor : X509.Certificate.certificate option ; + own_certificate : X509.Certificate.certificate list ; own_private_key : Nocrypto.Rsa.priv option ; master_secret : master_secret ; renegotiation : reneg_params ; (* renegotiation data *) @@ -168,7 +168,7 @@ type state = { } with sexp type error = [ - | `AuthenticationFailure of Certificate.certificate_failure + | `AuthenticationFailure of X509.Certificate.certificate_failure | `NoConfiguredCiphersuite of Ciphersuite.ciphersuite list | `NoConfiguredVersion of tls_version | `NoConfiguredHash of Hash.hash list diff --git a/lwt/x509_lwt.ml b/lwt/x509_lwt.ml index de8c9a0d..0c007e7e 100644 --- a/lwt/x509_lwt.ml +++ b/lwt/x509_lwt.ml @@ -1,7 +1,7 @@ open Lwt -type priv = X509.Cert.t list * X509.PK.t +type priv = X509.Parser.Cert.t list * X509.Parser.PK.t type authenticator = X509.Authenticator.t @@ -49,17 +49,17 @@ let extension str = let private_of_pems ~cert ~priv_key = lwt certs = catch_invalid_arg - (read_file cert >|= X509.Cert.of_pem_cstruct) + (read_file cert >|= X509.Parser.Cert.of_pem_cstruct) (o failure @@ Printf.sprintf "Private certificates (%s): %s" cert) and pk = catch_invalid_arg - (read_file priv_key >|= X509.PK.of_pem_cstruct1) + (read_file priv_key >|= X509.Parser.PK.of_pem_cstruct1) (o failure @@ Printf.sprintf "Private key (%s): %s" priv_key) in return (certs, pk) let certs_of_pem path = catch_invalid_arg - (read_file path >|= X509.Cert.of_pem_cstruct) + (read_file path >|= X509.Parser.Cert.of_pem_cstruct) (o failure @@ Printf.sprintf "Certificates in %s: %s" path) let certs_of_pem_dir path = @@ -81,6 +81,6 @@ let authenticator param = | `Ca_dir path -> certs_of_pem_dir path >|= of_cas | `Fingerprints (hash, fps) -> return (fingerp hash fps) | `Hex_fingerprints (hash, fps) -> - let fps = List.map (fun (n, v) -> (n, X509.Cs.dotted_hex_to_cs v)) fps in + let fps = List.map (fun (n, v) -> (n, X509.Parser.Cs.dotted_hex_to_cs v)) fps in return (fingerp hash fps) | `No_authentication_I'M_STUPID -> return X509.Authenticator.null diff --git a/lwt/x509_lwt.mli b/lwt/x509_lwt.mli index fd1de5e6..742a5ee7 100644 --- a/lwt/x509_lwt.mli +++ b/lwt/x509_lwt.mli @@ -1,11 +1,11 @@ -type priv = X509.Cert.t list * X509.PK.t +type priv = X509.Parser.Cert.t list * X509.Parser.PK.t type authenticator = X509.Authenticator.t val private_of_pems : cert:Lwt_io.file_name -> priv_key:Lwt_io.file_name -> priv Lwt.t -val certs_of_pem : Lwt_io.file_name -> X509.Cert.t list Lwt.t -val certs_of_pem_dir : Lwt_io.file_name -> X509.Cert.t list Lwt.t +val certs_of_pem : Lwt_io.file_name -> X509.Parser.Cert.t list Lwt.t +val certs_of_pem_dir : Lwt_io.file_name -> X509.Parser.Cert.t list Lwt.t val authenticator : [ `Ca_file of Lwt_io.file_name diff --git a/mirage/tls_mirage.ml b/mirage/tls_mirage.ml index c3c2d60f..b707224a 100644 --- a/mirage/tls_mirage.ml +++ b/mirage/tls_mirage.ml @@ -225,15 +225,15 @@ module X509 (KV : V1_LWT.KV_RO) (C : V1.CLOCK) = struct | `CAs -> let time = C.time () in read_full kv ca_roots_file - >|= X509.Cert.of_pem_cstruct + >|= X509.Parser.Cert.of_pem_cstruct >|= X509.Authenticator.chain_of_trust ~time let certificate kv = let read name = lwt certs = - read_full kv (path name ^ ".pem") >|= X509.Cert.of_pem_cstruct + read_full kv (path name ^ ".pem") >|= X509.Parser.Cert.of_pem_cstruct and pk = - read_full kv (path name ^ ".key") >|= X509.PK.of_pem_cstruct1 in + read_full kv (path name ^ ".key") >|= X509.Parser.PK.of_pem_cstruct1 in return (certs, pk) in function | `Default -> read default_cert | `Name name -> read name diff --git a/mirage/tls_mirage.mli b/mirage/tls_mirage.mli index 0fb592b6..1743d64d 100644 --- a/mirage/tls_mirage.mli +++ b/mirage/tls_mirage.mli @@ -39,5 +39,5 @@ end module X509 (KV : V1_LWT.KV_RO) (C : V1.CLOCK) : sig val authenticator : KV.t -> [< `Noop | `CAs ] -> X509.Authenticator.t Lwt.t val certificate : KV.t -> [< `Default | `Name of string ] - -> (X509.Cert.t list * X509.PK.t) Lwt.t + -> (X509.Parser.Cert.t list * X509.Parser.PK.t) Lwt.t end diff --git a/opam b/opam index fd8497ec..d0db4e62 100644 --- a/opam +++ b/opam @@ -23,7 +23,7 @@ depends: [ "type_conv" "sexplib" "nocrypto" {>= "0.3.0"} - "x509" {>= "0.2.1"} + "x509" {>= "0.3.0"} "camlp4" ] depopts: [ diff --git a/tests/feedback.ml b/tests/feedback.ml index 309356e8..a0f2722a 100644 --- a/tests/feedback.ml +++ b/tests/feedback.ml @@ -70,7 +70,7 @@ let loop_chatter ~certificate ~loops ~size = let load_priv () = let cs1 = Testlib.cs_mmap "./certificates/server.pem" and cs2 = Testlib.cs_mmap "./certificates/server.key" in - X509.(Cert.of_pem_cstruct cs1, PK.of_pem_cstruct1 cs2) + X509.Parser.(Cert.of_pem_cstruct cs1, PK.of_pem_cstruct1 cs2) let _ = let loops =