diff --git a/_oasis b/_oasis index 0b0d6355..81824863 100644 --- a/_oasis +++ b/_oasis @@ -25,7 +25,7 @@ Library "tls" Modules : Tracing, Ciphersuite, Packet, Core, Printer, Reader, Writer, Config, Engine - InternalModules : Control, Sexp_ext, Crypto, Utils, + InternalModules : Control, Crypto, Utils, State, Handshake_common, Handshake_crypto, Handshake_server, Handshake_client Pack : true diff --git a/_tags b/_tags index 3e65a14d..bf8cf626 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 5eb87f1a9699084a7ce0fa5335b76193) +# DO NOT EDIT (digest: 23e4e9c6084252c78d7e3c085c6f050c) # Ignore VCS directories, you can use the same kind of rule outside # OASIS_START/STOP if you want to exclude directories that contains # useless stuff for the build process @@ -26,7 +26,6 @@ true: annot, bin_annot "lib/config.cmx": for-pack(Tls) "lib/engine.cmx": for-pack(Tls) "lib/control.cmx": for-pack(Tls) -"lib/sexp_ext.cmx": for-pack(Tls) "lib/crypto.cmx": for-pack(Tls) "lib/utils.cmx": for-pack(Tls) "lib/state.cmx": for-pack(Tls) diff --git a/lib/core.ml b/lib/core.ml index 9a848840..276863b7 100644 --- a/lib/core.ml +++ b/lib/core.ml @@ -6,8 +6,6 @@ open Nocrypto open Packet open Ciphersuite -module Cstruct_s = Sexp_ext.Cstruct_s - type tls_version = | TLS_1_0 | TLS_1_1 @@ -73,16 +71,16 @@ type extension = | MaxFragmentLength of max_fragment_length | EllipticCurves of named_curve_type list | ECPointFormats of ec_point_format list - | SecureRenegotiation of Cstruct_s.t + | SecureRenegotiation of Cstruct.t | Padding of int | SignatureAlgorithms of (Hash.hash * signature_algorithm_type) list - | UnknownExtension of (int * Cstruct_s.t) + | UnknownExtension of (int * Cstruct.t) with sexp type ('a, 'b) hello = { version : 'b; - random : Cstruct_s.t; - sessionid : Cstruct_s.t option; + random : Cstruct.t; + sessionid : Cstruct.t option; ciphersuites : 'a; extensions : extension list } with sexp @@ -94,45 +92,45 @@ type server_hello = (ciphersuite, tls_version) hello with sexp type rsa_parameters = { - rsa_modulus : Cstruct_s.t; - rsa_exponent : Cstruct_s.t; + rsa_modulus : Cstruct.t; + rsa_exponent : Cstruct.t; } with sexp type dh_parameters = { - dh_p : Cstruct_s.t; - dh_g : Cstruct_s.t; - dh_Ys : Cstruct_s.t; + dh_p : Cstruct.t; + dh_g : Cstruct.t; + dh_Ys : Cstruct.t; } with sexp type ec_curve = { - a : Cstruct_s.t; - b : Cstruct_s.t + a : Cstruct.t; + b : Cstruct.t } with sexp type ec_prime_parameters = { - prime : Cstruct_s.t; + prime : Cstruct.t; curve : ec_curve; - base : Cstruct_s.t; - order : Cstruct_s.t; - cofactor : Cstruct_s.t; - public : Cstruct_s.t + base : Cstruct.t; + order : Cstruct.t; + cofactor : Cstruct.t; + public : Cstruct.t } with sexp type ec_char_parameters = { m : int; basis : ec_basis_type; - ks : Cstruct_s.t list; + ks : Cstruct.t list; curve : ec_curve; - base : Cstruct_s.t; - order : Cstruct_s.t; - cofactor : Cstruct_s.t; - public : Cstruct_s.t + base : Cstruct.t; + order : Cstruct.t; + cofactor : Cstruct.t; + public : Cstruct.t } with sexp type ec_parameters = | ExplicitPrimeParameters of ec_prime_parameters | ExplicitCharParameters of ec_char_parameters - | NamedCurveParameters of (named_curve_type * Cstruct_s.t) + | NamedCurveParameters of (named_curve_type * Cstruct.t) with sexp type tls_handshake = @@ -140,12 +138,12 @@ type tls_handshake = | ServerHelloDone | ClientHello of client_hello | ServerHello of server_hello - | Certificate of Cstruct_s.t list - | ServerKeyExchange of Cstruct_s.t - | CertificateRequest of Cstruct_s.t - | ClientKeyExchange of Cstruct_s.t - | CertificateVerify of Cstruct_s.t - | Finished of Cstruct_s.t + | Certificate of Cstruct.t list + | ServerKeyExchange of Cstruct.t + | CertificateRequest of Cstruct.t + | ClientKeyExchange of Cstruct.t + | CertificateVerify of Cstruct.t + | Finished of Cstruct.t with sexp type tls_alert = alert_level * alert_type diff --git a/lib/engine.ml b/lib/engine.ml index c7840a06..88f9cd9d 100644 --- a/lib/engine.ml +++ b/lib/engine.ml @@ -102,7 +102,7 @@ let new_state config role = fragment = Cstruct.create 0 ; } -type raw_record = tls_hdr * Cstruct_s.t with sexp +type raw_record = tls_hdr * Cstruct.t with sexp (* well-behaved pure encryptor *) let encrypt (version : tls_version) (st : crypto_state) ty buf = diff --git a/lib/sexp_ext.ml b/lib/sexp_ext.ml deleted file mode 100644 index 0ff90100..00000000 --- a/lib/sexp_ext.ml +++ /dev/null @@ -1,75 +0,0 @@ - -open Sexplib -open Sexp - -module Cstruct_s = struct - - type t = Cstruct.t - - let (h_of_b, b_of_h) = - let arr = Array.create 256 "" - and ht = Hashtbl.create 256 in - for i = 0 to 255 do - let str = Printf.sprintf "%02x" i in - arr.(i) <- str ; - Hashtbl.add ht str i - done ; - (Array.get arr, Hashtbl.find ht) - - let t_of_sexp sexp = - - let failure msg sexp = - Conv.of_sexp_error ("Cstruct_s.t_of_sexp: " ^ msg ^ " needed") sexp in - - let rec measure a = function - | Atom _ -> a + 1 - | List xs -> List.fold_left measure a xs - - and write i cs l1 = function - | (Atom str as sexp)::l2 -> - let b = - try b_of_h str with Not_found -> failure "hex byte" sexp in - Cstruct.set_uint8 cs i b ; - write (succ i) cs l1 l2 - | sexp :: _ -> failure "atom" sexp - | [] -> - match l1 with - | List l2::l1' -> write i cs l1' l2 - | sexp ::_ -> failure "inner list" sexp - | [] -> () - in - match sexp with - | Atom _ -> failure "list" sexp - | List list as exp -> - let cs = Cstruct.create (measure 0 exp) in - ( write 0 cs list [] ; cs ) - - - let cs_fold_bytes ~f ~init cs = - let acc = ref init in - for i = 0 to Cstruct.len cs - 1 do - acc := f !acc i Cstruct.(get_uint8 cs i) - done ; - !acc - - let sexp_of_t cs = - let of_list list = List (List.rev list) in - let append big = function - | [] -> big - | small -> of_list small :: big in - let (l1, l2) = - cs_fold_bytes - ~f:(fun (l1, l2 as acc) i b -> - let (l1, l2) = - if i mod 16 = 0 then - (append l1 l2, []) - else acc in - (l1, Atom (h_of_b b) :: l2)) - ~init:([], []) - cs in - of_list @@ append l1 l2 - -end - -let record kvs = - List List.(map (fun (k, v) -> (List [Atom k; v])) kvs) diff --git a/lib/state.ml b/lib/state.ml index ed11a504..c5f92b80 100644 --- a/lib/state.ml +++ b/lib/state.ml @@ -18,8 +18,8 @@ type 'k stream_state = { (* initialisation vector style, depending on TLS version *) type iv_mode = - | Iv of Cstruct_s.t (* traditional CBC (reusing last cipherblock) *) - | Random_iv (* TLS 1.1 and higher explicit IV (we use random) *) + | Iv of Cstruct.t (* traditional CBC (reusing last cipherblock) *) + | Random_iv (* TLS 1.1 and higher explicit IV (we use random) *) with sexp type 'k cbc_cipher = (module Cipher_block.T.CBC with type key = 'k) type 'k cbc_state = { @@ -43,42 +43,36 @@ type cipher_st = | CBC : 'k cbc_state -> cipher_st | CCM : 'k ccm_state -> cipher_st -(* context of a TLS connection (both in and out has each one of these) *) -type crypto_context = { - sequence : int64 ; (* sequence number *) - cipher_st : cipher_st ; (* cipher state *) -} - (* Sexplib stubs -- rethink how to play with crypto. *) - let sexp_of_cipher_st = function | Stream _ -> Sexp.(Atom "") | CBC _ -> Sexp.(Atom "") | CCM _ -> Sexp.(Atom "") -let crypto_context_of_sexp _ = failwith "can't parse crypto context from sexp" -and sexp_of_crypto_context cc = - Sexp_ext.record [ - "sequence" , sexp_of_int64 cc.sequence ; - "cipher_st", sexp_of_cipher_st cc.cipher_st - ] - +let cipher_st_of_sexp = + Conv.of_sexp_error "cipher_st_of_sexp: not implemented" (* *** *) +(* context of a TLS connection (both in and out has each one of these) *) +type crypto_context = { + sequence : int64 ; (* sequence number *) + cipher_st : cipher_st ; (* cipher state *) +} with sexp + (* the raw handshake log we need to carry around *) -type hs_log = Cstruct_s.t list with sexp +type hs_log = Cstruct.t list with sexp (* the master secret of a TLS connection *) -type master_secret = Cstruct_s.t with sexp +type master_secret = Cstruct.t with sexp (* diffie hellman group and secret *) type dh_sent = Dh.group * Dh.secret with sexp (* a collection of client and server verify bytes for renegotiation *) -type reneg_params = Cstruct_s.t * Cstruct_s.t +type reneg_params = Cstruct.t * Cstruct.t with sexp type session_data = { - server_random : Cstruct_s.t ; (* 32 bytes random from the server hello *) - client_random : Cstruct_s.t ; (* 32 bytes random from the client hello *) + server_random : Cstruct.t ; (* 32 bytes random from the server hello *) + client_random : Cstruct.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 : X509.t list ; @@ -113,10 +107,10 @@ type client_handshake_state = | AwaitCertificate_RSA of session_data * hs_log (* certificate expected with RSA key exchange *) | AwaitCertificate_DHE_RSA of session_data * hs_log (* certificate expected with DHE_RSA key exchange *) | AwaitServerKeyExchange_DHE_RSA of session_data * hs_log (* server key exchange expected with DHE_RSA *) - | AwaitCertificateRequestOrServerHelloDone of session_data * Cstruct_s.t * Cstruct_s.t * hs_log (* server hello done expected, client key exchange and premastersecret are ready *) - | AwaitServerHelloDone of session_data * (Hash.hash * Packet.signature_algorithm_type) list option * Cstruct_s.t * Cstruct_s.t * hs_log (* server hello done expected, client key exchange and premastersecret are ready *) - | AwaitServerChangeCipherSpec of session_data * crypto_context * Cstruct_s.t * hs_log (* change cipher spec expected *) - | AwaitServerFinished of session_data * Cstruct_s.t * hs_log (* finished expected with a hmac over all handshake packets *) + | AwaitCertificateRequestOrServerHelloDone of session_data * Cstruct.t * Cstruct.t * hs_log (* server hello done expected, client key exchange and premastersecret are ready *) + | AwaitServerHelloDone of session_data * (Hash.hash * Packet.signature_algorithm_type) list option * Cstruct.t * Cstruct.t * hs_log (* server hello done expected, client key exchange and premastersecret are ready *) + | AwaitServerChangeCipherSpec of session_data * crypto_context * Cstruct.t * hs_log (* change cipher spec expected *) + | AwaitServerFinished of session_data * Cstruct.t * hs_log (* finished expected with a hmac over all handshake packets *) | Established (* handshake successfully completed *) with sexp @@ -131,7 +125,7 @@ type handshake_state = { protocol_version : tls_version ; machina : handshake_machina_state ; (* state machine state *) config : Config.config ; (* given config *) - hs_fragment : Cstruct_s.t (* handshake messages can be fragmented, leftover from before *) + hs_fragment : Cstruct.t (* handshake messages can be fragmented, leftover from before *) } with sexp (* connection state: initially None, after handshake a crypto context *) @@ -139,7 +133,7 @@ type crypto_state = crypto_context option with sexp (* record consisting of a content type and a byte vector *) -type record = Packet.content_type * Cstruct_s.t with sexp +type record = Packet.content_type * Cstruct.t with sexp (* response returned by a handler *) type rec_resp = [ @@ -164,7 +158,7 @@ type state = { handshake : handshake_state ; (* the current handshake state *) decryptor : crypto_state ; (* the current decryption state *) encryptor : crypto_state ; (* the current encryption state *) - fragment : Cstruct_s.t ; (* the leftover fragment from TCP fragmentation *) + fragment : Cstruct.t ; (* the leftover fragment from TCP fragmentation *) } with sexp type error = [ diff --git a/lib/tls.mlpack b/lib/tls.mlpack index 3b4034e5..b6356134 100644 --- a/lib/tls.mlpack +++ b/lib/tls.mlpack @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 1d66ab051ef4df1447d1c59846d81167) +# DO NOT EDIT (digest: d676bd6a020b72d862191f5554fccfe4) Tracing Ciphersuite Packet @@ -10,7 +10,6 @@ Writer Config Engine Control -Sexp_ext Crypto Utils State diff --git a/lib/tracing.ml b/lib/tracing.ml index f4f9d2d6..322fa7f8 100644 --- a/lib/tracing.ml +++ b/lib/tracing.ml @@ -28,6 +28,6 @@ let sexpf ~tag ~f x = sexp ~tag @@ lazy (f x) let sexpfs ~tag ~f xs = if is_tracing () then List.iter (sexpf ~tag ~f) xs -let cs ~tag = sexpf ~tag ~f:Sexp_ext.Cstruct_s.sexp_of_t +let cs ~tag = sexpf ~tag ~f:Cstruct.sexp_of_t let css ~tag css = if is_tracing () then List.iter (cs ~tag) css diff --git a/opam b/opam index 183d1a25..5e87a904 100644 --- a/opam +++ b/opam @@ -18,7 +18,7 @@ remove: [ "ocamlfind" "remove" "tls" ] depends: [ "ocamlfind" - "cstruct" {>= "1.2.0"} + "cstruct" {>= "1.6.0"} "type_conv" "sexplib" "nocrypto" {>= "0.4.0"} diff --git a/setup.ml b/setup.ml index 7d8ab6fa..5303b5ce 100644 --- a/setup.ml +++ b/setup.ml @@ -1,7 +1,7 @@ -(* setup.ml generated for the first time by OASIS v0.4.4 *) +(* setup.ml generated for the first time by OASIS v0.4.5 *) (* OASIS_START *) -(* DO NOT EDIT (digest: 87d85e18d17ae7d9c6926bd7d7b8a951) *) +(* DO NOT EDIT (digest: 45395e00447a198f9c66994428f6c6c7) *) (* Regenerated by OASIS v0.4.5 Visit http://oasis.forge.ocamlcore.org for more information and @@ -6996,7 +6996,6 @@ let setup_t = lib_internal_modules = [ "Control"; - "Sexp_ext"; "Crypto"; "Utils"; "State"; @@ -7481,7 +7480,8 @@ let setup_t = }; oasis_fn = Some "_oasis"; oasis_version = "0.4.5"; - oasis_digest = Some "\003\142\227u\205\211V\185-\131B\191P\153\168O"; + oasis_digest = + Some "\234P\187\"\029\201\027\253\145\030\212\152h\196\165\242"; oasis_exec = None; oasis_setup_args = []; setup_update = false