mirleft · hannesm · Mar 15, 2015 · Mar 15, 2015 · Mar 15, 2015 · Mar 16, 2015
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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,23 +202,21 @@ 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))
     | `Ok anchor -> return anchor
 
   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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 =