cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit c8063ea4b3b94cd7947da06815a1a27b94ca1b79
parent 05b035aca3bd5a96b9e42a415e39e955d7388d43
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 21 Sep 2014 17:48:58 +0200

move tls a bit forward

can parse server key exchange and write client key exchange but
doesn't compute correct values yet

Diffstat:
Mtls.lisp | 625+++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------
1 file changed, 401 insertions(+), 224 deletions(-)

diff --git a/tls.lisp b/tls.lisp @@ -29,6 +29,10 @@ ;;gnutls-cli wikipedia.org ;; https://en.wikipedia.org/wiki/Transport_Layer_Security +;; http://msdn.microsoft.com/en-us/library/windows/desktop/aa380513(v=vs.85).aspx +;; http://technet.microsoft.com/en-us/library/cc785811(v=ws.10).aspx +;; https://tools.ietf.org/html/rfc5246 +;; https://tools.ietf.org/html/rfc4492 (defun next-u8 (reader) (rw:next-u8 reader)) @@ -271,31 +275,90 @@ (sha384 . 5) (sha512 . 6)) -(defenum $SignatureAlgorithm (:nbits 8) - (anonymous . 0) - (rsa . 1) - (dsa . 2) - (ecdsa . 3)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defenum $ECCurveType (:nbits 8) + (explicit_prime . 1) + (explicit_char2 . 2) + (named_curve . 3) + #+nil(reserved 248..255)) + +(defenum $NamedCurve (:nbits 16) + (sect163k1 . 1) + (sect163r1 . 2) + (sect163r2 . 3) + (sect193r1 . 4) + (sect193r2 . 5) + (sect233k1 . 6) + (sect233r1 . 7) + (sect239k1 . 8) + (sect283k1 . 9) + (sect283r1 . 10) + (sect409k1 . 11) + (sect409r1 . 12) + (sect571k1 . 13) + (sect571r1 . 14) + (secp160k1 . 15) + (secp160r1 . 16) + (secp160r2 . 17) + (secp192k1 . 18) + (secp192r1 . 19) + (secp224k1 . 20) + (secp224r1 . 21) + (secp256k1 . 22) + (secp256r1 . 23) + (secp384r1 . 24) + (secp521r1 . 25) + ;;reserved (0xfe00..0xfeff) + (arbitrary_explicit_prime_curves . #xff01) + (arbitrary_explicit_char2_curves . #xff02)) + +(defenum %$SignatureHashAlgorithmHash (:nbits 8) + (sha256 . 4)) + +(defenum %$SignatureHashAlgorithmSignature (:nbits 8) + (rsa . 1)) (defun PublicValueEncoding () - ;; If the client has sent a certificate which contains a suitable - ;; Diffie-Hellman key (for fixed_dh client authentication), then - ;; Yc is implicit and does not need to be sent again. In this - ;; case, the client key exchange message will be sent, but it MUST - ;; be empty. - 'implicit) + ;;'implicit + 'explicit) (defun KeyExchangeAlgorithm () - ;; dhe_dss dhe_rsa dh_anon rsa dh_dss dh_rsa - 'dhe_rsa) - -;;;;;;;;;;;;;; + ;;'ecdhe_rsa + 'ec_diffie_hellman) + +;; (defenum $KeyExchangeAlgorithm (:nbits 8) +;; (dhe_dss . 0) +;; (dhe_rsa . 1) +;; (dh_anon . 2) +;; (rsa . 3) +;; (dh_dss . 4) +;; (dh_rsa . 5)) + +;; ECDH_ECDSA Fixed ECDH with ECDSA-signed certificates. +;; ECDHE_ECDSA Ephemeral ECDH with ECDSA signatures. +;; ECDH_RSA Fixed ECDH with RSA-signed certificates. +;; ECDHE_RSA Ephemeral ECDH with RSA signatures. +;; ECDH_anon Anonymous ECDH, no signatures. + +;; (defun ECBasisType () +;; 'ec_basis_trinomial +;; 'ec_basis_pentanomial) + +(defun SignatureAlgorithm () + ;;'anonymous + ;;'rsa + ;;'dsa + 'ecdsa) (defun aname (struc &optional slot) (intern (format nil "~a-~a" struc slot))) +(defun make-octet-buffer (length) + (make-array length + :element-type '(unsigned-byte 8) + :initial-element 0 + :adjustable t + :fill-pointer 0)) + (defun defun-rname-slot (slot) (destructuring-bind (ty na &key length size min max compute next) slot `(,na @@ -425,13 +488,6 @@ (defstruc $Certificate () (%$Certificate list :length u24 :min 0 :max #.(1- (expt 2 24)) :size t)) -(defstruc $ClientDiffieHellmanPublic () - (computed type :compute (PublicValueEncoding)) - ((ecase type - (implicit) - (explicit $dh_Yc)) - dh_public)) - (defstruc $ClientHello () ($ContentVersion #+nil $ProtocolVersion version) ($Random random) @@ -440,19 +496,6 @@ ($CompressionMethod compression_methods :length u8 :min 1 :max #.(1- (expt 2 8)) :size t) ($Extension extensions :length u16 :min 0 :max #.(1- (expt 2 16)) :size t)) -(defstruc $ClientKeyExchange () - (computed type :compute (KeyExchangeAlgorithm)) - ((ecase type - (rsa $EncryptedPreMasterSecret) - ((dhe_dss dhe_rsa dh_dss dh_rsa dh_anon) $ClientDiffieHellmanPublic)) - keys)) - -(defstruc $dh_Yc () - (u8 data :length u16 :min 1 :max #.(1- (expt 2 16)))) - -(defstruc $EncryptedPreMasterSecret () - ($PreMasterSecret pubkey_encrypted)) - (defstruc $Extension () ($ExtensionType type) #+nil @@ -466,6 +509,134 @@ (signature_algorithms)) (u8 data :length u16 :min 0 :max #.(1- (expt 2 16)) :size t)) +(defstruc $ServerDHParams () + (u8 dh_p :length u16 :min 1 :max #.(1- (expt 2 16))) + (u8 dh_g :length u16 :min 1 :max #.(1- (expt 2 16))) + (u8 dh_Ys :length u16 :min 1 :max #.(1- (expt 2 16)))) + +(defstruc $signed_params () + (u8 client_random :size 32) + (u8 server_random :size 32) + ($ServerDHParams params2)) + +(defstruc %$ServerDHParams () + ($ServerDHParams params) + ($signed_params signed_params)) + +(defstruc $ECCurve () + (u8 a :length u8 :min 1) + (u8 b :length u8 :min 1)) + +(defstruc $ECPoint () + (u8 data :length u8 :min 1 :size t)) + +;; (defstruc %$ExplicitPrime () +;; opaque prime_p <1..2^8-1> +;; ECCurve curve +;; ECPoint base +;; opaque order <1..2^8-1> +;; opaque cofactor <1..2^8-1>) + +;; (defstruc %$ExplicitChar2 () +;; uint16 m +;; ECBasisType basis +;; select (basis) { +;; case ec_trinomial: +;; opaque k <1..2^8-1> +;; case ec_pentanomial: +;; opaque k1 <1..2^8-1> +;; opaque k2 <1..2^8-1> +;; opaque k3 <1..2^8-1> +;; } +;; ECCurve curve +;; ECPoint base +;; opaque order <1..2^8-1> +;; opaque cofactor <1..2^8-1>) + +(defstruc $ECParameters () + ($ECCurveType curve_type) + ((ecase curve_type + ;;(explicit_prime %$ExplicitPrime) + ;;(explicit_char2 %$ExplicitChar2) + (named_curve $NamedCurve)) + data)) + +(defstruc $ServerECDHParams () + ($ECParameters curve_params) + ($ECPoint public)) + +(defstruc %$ECSASignature () ;; digitally-signed + (%$SignatureHashAlgorithm algorithm) + (u16 length #+nil :compute #+nil(ShaSize)) + (u8 sha_hash :size length)) + +(defstruc %$SignatureHashAlgorithm () + (%$SignatureHashAlgorithmHash hash) + (%$SignatureHashAlgorithmSignature signature)) + +(defstruc $Signature () + (computed algorithm :compute (SignatureAlgorithm)) + ((ecase algorithm + (ecdsa %$ECSASignature)) + data)) + +(defstruc %$ServerECDHParams () + ($ServerECDHParams params) + ($Signature signed_params)) + +(defstruc $ServerKeyExchange () + ;;(u8 data :length u16 :min 1 :max #.(1- (expt 2 16))) + (computed type :compute (KeyExchangeAlgorithm)) + ((ecase type + ;;(dh_anon $ServerDHParams) + ;;((dhe_dss dhe_rsa) %$ServerDHParams) + (ec_diffie_hellman %$ServerECDHParams) + #+nil((rsa dh_dss dh_rsa))) + data)) + +(defstruc $SessionID () + (u8 data :length u8 :min 0 :max 32 :size t)) + +(defstruc $Random () + (u32 gmt_unix_time) + (u8 random_bytes :size 28)) + +(defstruc $ServerHello () + ($ContentVersion #+nil ProtocolVersion version) + ($Random random) + ($SessionID session_id) + ($CipherSuite cipher_suite) + ($CompressionMethod compression_method) + ($Extension extensions :length u16 :min 0 :max #.(1- (expt 2 16)) :size t)) + +(defstruc $dh_Yc () + (u8 data :length u16 :min 1 :max #.(1- (expt 2 16)))) + +(defstruc $EncryptedPreMasterSecret () + ($PreMasterSecret pubkey_encrypted)) + +(defstruc $ClientDiffieHellmanPublic () + (computed type :compute (PublicValueEncoding)) + ((ecase type + (implicit) + (explicit $dh_Yc)) + dh_public)) + +(defstruc $ClientECDiffieHellmanPublic () + (computed type :compute (PublicValueEncoding)) + ((ecase type + (implicit) + (explicit $ECPoint)) ;; ecdh_Yc + ecdh_public)) + +(defstruc $ClientKeyExchange () + (computed type :compute (KeyExchangeAlgorithm)) + ((ecase type + ;;(rsa $EncryptedPreMasterSecret) + ;;((dhe_dss dhe_rsa dh_dss dh_rsa dh_anon) $ClientDiffieHellmanPublic) + (ec_diffie_hellman $ClientECDiffieHellmanPublic)) + data)) + (defstruc $Handshake () ($HandshakeType type) ((ecase type @@ -474,17 +645,13 @@ (CLIENT_KEY_EXCHANGE $ClientKeyExchange) (SERVER_HELLO $ServerHello) (SERVER_HELLO_DONE) - (SERVER_KEY_EXCHANGE #+nil $ServerKeyExchange)) + (SERVER_KEY_EXCHANGE $ServerKeyExchange)) data :length u24)) (defstruc $PreMasterSecret () ($ContentVersion #+nil ProtocolVersion client_version) (u8 random :size 46)) -(defstruc $Random () - (u32 gmt_unix_time) - (u8 random_bytes :size 28)) - (defstruc $Record () ($ContentType type) (u16 #+nil ContentVersion version) @@ -495,44 +662,6 @@ #+nil (u8 data :length u16 :min 1 :max 16383 :size t)) -#+nil -(defstruc $ServerDHParams () ;;;; - (u8 dh_p :min 1 :max #.(1- (expt 2 16)) :size t) - (u8 dh_g :min 1 :max #.(1- (expt 2 16)) :size t) - (u8 dh_Ys :min 1 :max #.(1- (expt 2 16)) :size t)) - -(defstruc %$ServerDHParams2 () - ($ServerDHParams params) - ($signed_params signed_params)) - -(defstruc $ServerHello () - ($ContentVersion #+nil ProtocolVersion version) - ($Random random) - ($SessionID session_id) - ($CipherSuite cipher_suite) - ($CompressionMethod compression_method) - ($Extension extensions :length u16 :min 0 :max #.(1- (expt 2 16)) :size t)) - -#+nil -(defstruc $ServerKeyExchange () - (u8 data :min 1 :max #.(1- (expt 2 16)) :size t) - #+nil - ($KeyExchangeAlgorithm type) - #+nil - ((ecase type - (dh_anon $ServerDHParams) - ((dhe_dss dhe_rsa) %$ServerDHParams2) - ((rsa dh_dss dh_rsa))) - data)) - -(defstruc $SessionID () - (u8 data :length u8 :min 0 :max 32 :size t)) - -(defstruc $signed_params () - (u8 client_random :size 32) - (u8 server_random :size 32) - ($ServerDHParams params2)) - ;; struct { ;; HashAlgorithm hash ;; SignatureAlgorithm signature @@ -541,13 +670,6 @@ ;; SignatureAndHashAlgorithm ;; supported_signature_algorithms<2..2^16-1> -(defun make-octet-buffer (length) - (make-array length - :element-type '(unsigned-byte 8) - :initial-element 0 - :adjustable t - :fill-pointer 0)) - (defun random-octets (length) (loop for i from 0 below length @@ -558,122 +680,156 @@ ;;(universal-time-to-unix (encode-universal-time 19 22 23 28 7 2014 0)) ;; TODO broken -(defun test () - (let ((b (make-octet-buffer 100))) - (write-$Record - (rw:writer b) - (make-$Record - :type 'HANDSHAKE - :version ($ContentVersion 'SSL3.0) - :data (make-$Handshake - :type 'CLIENT_HELLO - :data (make-$ClientHello - :version 'TLS1.2 - :random (make-$Random - :gmt_unix_time (universal-time-to-unix (get-universal-time)) - :random_bytes (random-octets 28)) - :session_id (make-$SessionID #+nil :data #+nil(random-octets 32)) - :cipher_suites '(TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 - TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 - TLS_ECDHE_ECDSA_WITH_CAMELLIA_128_GCM_SHA256 - TLS_ECDHE_ECDSA_WITH_CAMELLIA_256_GCM_SHA384 - TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA - TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 - TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA - TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 - TLS_ECDHE_ECDSA_WITH_CAMELLIA_128_CBC_SHA256 - TLS_ECDHE_ECDSA_WITH_CAMELLIA_256_CBC_SHA384 - TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA - TLS_ECDHE_ECDSA_WITH_RC4_128_SHA - TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 - TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 - TLS_ECDHE_RSA_WITH_CAMELLIA_128_GCM_SHA256 - TLS_ECDHE_RSA_WITH_CAMELLIA_256_GCM_SHA384 - TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA - TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256 - TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA - TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384 - TLS_ECDHE_RSA_WITH_CAMELLIA_128_CBC_SHA256 - TLS_ECDHE_RSA_WITH_CAMELLIA_256_CBC_SHA384 - TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA - TLS_ECDHE_RSA_WITH_RC4_128_SHA - TLS_RSA_WITH_AES_128_GCM_SHA256 - TLS_RSA_WITH_AES_256_GCM_SHA384 - TLS_RSA_WITH_CAMELLIA_128_GCM_SHA256 - TLS_RSA_WITH_CAMELLIA_256_GCM_SHA384 - TLS_RSA_WITH_AES_128_CBC_SHA - TLS_RSA_WITH_AES_128_CBC_SHA256 - TLS_RSA_WITH_AES_256_CBC_SHA - TLS_RSA_WITH_AES_256_CBC_SHA256 - TLS_RSA_WITH_CAMELLIA_128_CBC_SHA - TLS_RSA_WITH_CAMELLIA_128_CBC_SHA256 - TLS_RSA_WITH_CAMELLIA_256_CBC_SHA - TLS_RSA_WITH_CAMELLIA_256_CBC_SHA256 - TLS_RSA_WITH_3DES_EDE_CBC_SHA - TLS_RSA_WITH_RC4_128_SHA - TLS_RSA_WITH_RC4_128_MD5 - TLS_DHE_RSA_WITH_AES_128_GCM_SHA256 - TLS_DHE_RSA_WITH_AES_256_GCM_SHA384 - TLS_DHE_RSA_WITH_CAMELLIA_128_GCM_SHA256 - TLS_DHE_RSA_WITH_CAMELLIA_256_GCM_SHA384 - TLS_DHE_RSA_WITH_AES_128_CBC_SHA - TLS_DHE_RSA_WITH_AES_128_CBC_SHA256 - TLS_DHE_RSA_WITH_AES_256_CBC_SHA - TLS_DHE_RSA_WITH_AES_256_CBC_SHA256 - TLS_DHE_RSA_WITH_CAMELLIA_128_CBC_SHA - TLS_DHE_RSA_WITH_CAMELLIA_128_CBC_SHA256 - TLS_DHE_RSA_WITH_CAMELLIA_256_CBC_SHA - TLS_DHE_RSA_WITH_CAMELLIA_256_CBC_SHA256 - TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA - TLS_DHE_DSS_WITH_AES_128_GCM_SHA256 - TLS_DHE_DSS_WITH_AES_256_GCM_SHA384 - TLS_DHE_DSS_WITH_CAMELLIA_128_GCM_SHA256 - TLS_DHE_DSS_WITH_CAMELLIA_256_GCM_SHA384 - TLS_DHE_DSS_WITH_AES_128_CBC_SHA - TLS_DHE_DSS_WITH_AES_128_CBC_SHA256 - TLS_DHE_DSS_WITH_AES_256_CBC_SHA - TLS_DHE_DSS_WITH_AES_256_CBC_SHA256 - TLS_DHE_DSS_WITH_CAMELLIA_128_CBC_SHA - TLS_DHE_DSS_WITH_CAMELLIA_128_CBC_SHA256 - TLS_DHE_DSS_WITH_CAMELLIA_256_CBC_SHA - TLS_DHE_DSS_WITH_CAMELLIA_256_CBC_SHA256 - TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA - TLS_DHE_DSS_WITH_RC4_128_SHA) - :compression_methods (list 'null) - :extensions (list - (make-$Extension :type 'status_request - :data '(1 0 0 0 0)) - (make-$Extension :type 'server_name - :data '(0 #x10 0 0 #xd #x77 #x69 #x6b #x69 #x70 #x65 #x64 #x69 #x61 #x2e #x6f #x72 #x67)) - (make-$Extension :type 'renegotiation_info - :data '(0)) - (make-$Extension :type 'SessionTicket_TLS :data nil) - (make-$Extension :type 'elliptic_curves - :data '(0 10 0 #x13 0 #x15 0 #x17 0 #x18 0 #x19)) - (make-$Extension :type 'ec_point_formats - :data '(1 0)) - (make-$Extension :type 'signature_algorithms - :data '(0 #x1a 4 1 4 2 4 3 5 1 5 3 6 1 6 3 3 1 3 2 3 3 2 1 2 2 2 3))))))) - b)) - -;;(print (test)) - -(defun test2 () - (let ((b (make-octet-buffer 100))) - (write-$Record - (rw:writer b) - (make-$Record - :type 'HANDSHAKE - :version ($ContentVersion 'SSL3.0) - :data (make-$Handshake - :type 'CLIENT_KEY_EXCHANGE - :data (make-$ClientKeyExchange - :keys (make-$ClientDiffieHellmanPublic - :dh_public nil))))) - b)) - -;;(print (test2)) +(defun write-client-hello (writer client-random client-hello-time) + (write-$Record + writer + (make-$Record + :type 'HANDSHAKE + :version ($ContentVersion 'SSL3.0) + :data (make-$Handshake + :type 'CLIENT_HELLO + :data (make-$ClientHello + :version 'TLS1.2 + :random (make-$Random + :gmt_unix_time client-hello-time + :random_bytes client-random) + :session_id (make-$SessionID #+nil :data #+nil(random-octets 32)) + :cipher_suites '( + ;; TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 + ;; TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 + ;; TLS_ECDHE_ECDSA_WITH_CAMELLIA_128_GCM_SHA256 + ;; TLS_ECDHE_ECDSA_WITH_CAMELLIA_256_GCM_SHA384 + ;; TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA + ;; TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 + ;; TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA + ;; TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 + ;; TLS_ECDHE_ECDSA_WITH_CAMELLIA_128_CBC_SHA256 + ;; TLS_ECDHE_ECDSA_WITH_CAMELLIA_256_CBC_SHA384 + ;; TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA + ;; TLS_ECDHE_ECDSA_WITH_RC4_128_SHA + TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 + ;; TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 + ;; TLS_ECDHE_RSA_WITH_CAMELLIA_128_GCM_SHA256 + ;; TLS_ECDHE_RSA_WITH_CAMELLIA_256_GCM_SHA384 + ;; TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA + ;; TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256 + ;; TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA + ;; TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384 + ;; TLS_ECDHE_RSA_WITH_CAMELLIA_128_CBC_SHA256 + ;; TLS_ECDHE_RSA_WITH_CAMELLIA_256_CBC_SHA384 + ;; TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA + ;; TLS_ECDHE_RSA_WITH_RC4_128_SHA + ;; TLS_RSA_WITH_AES_128_GCM_SHA256 + ;; TLS_RSA_WITH_AES_256_GCM_SHA384 + ;; TLS_RSA_WITH_CAMELLIA_128_GCM_SHA256 + ;; TLS_RSA_WITH_CAMELLIA_256_GCM_SHA384 + ;; TLS_RSA_WITH_AES_128_CBC_SHA + ;; TLS_RSA_WITH_AES_128_CBC_SHA256 + ;; TLS_RSA_WITH_AES_256_CBC_SHA + ;; TLS_RSA_WITH_AES_256_CBC_SHA256 + ;; TLS_RSA_WITH_CAMELLIA_128_CBC_SHA + ;; TLS_RSA_WITH_CAMELLIA_128_CBC_SHA256 + ;; TLS_RSA_WITH_CAMELLIA_256_CBC_SHA + ;; TLS_RSA_WITH_CAMELLIA_256_CBC_SHA256 + ;; TLS_RSA_WITH_3DES_EDE_CBC_SHA + ;; TLS_RSA_WITH_RC4_128_SHA + ;; TLS_RSA_WITH_RC4_128_MD5 + ;; TLS_DHE_RSA_WITH_AES_128_GCM_SHA256 + ;; TLS_DHE_RSA_WITH_AES_256_GCM_SHA384 + ;; TLS_DHE_RSA_WITH_CAMELLIA_128_GCM_SHA256 + ;; TLS_DHE_RSA_WITH_CAMELLIA_256_GCM_SHA384 + ;; TLS_DHE_RSA_WITH_AES_128_CBC_SHA + ;; TLS_DHE_RSA_WITH_AES_128_CBC_SHA256 + ;; TLS_DHE_RSA_WITH_AES_256_CBC_SHA + ;; TLS_DHE_RSA_WITH_AES_256_CBC_SHA256 + ;; TLS_DHE_RSA_WITH_CAMELLIA_128_CBC_SHA + ;; TLS_DHE_RSA_WITH_CAMELLIA_128_CBC_SHA256 + ;; TLS_DHE_RSA_WITH_CAMELLIA_256_CBC_SHA + ;; TLS_DHE_RSA_WITH_CAMELLIA_256_CBC_SHA256 + ;; TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA + ;; TLS_DHE_DSS_WITH_AES_128_GCM_SHA256 + ;; TLS_DHE_DSS_WITH_AES_256_GCM_SHA384 + ;; TLS_DHE_DSS_WITH_CAMELLIA_128_GCM_SHA256 + ;; TLS_DHE_DSS_WITH_CAMELLIA_256_GCM_SHA384 + ;; TLS_DHE_DSS_WITH_AES_128_CBC_SHA + ;; TLS_DHE_DSS_WITH_AES_128_CBC_SHA256 + ;; TLS_DHE_DSS_WITH_AES_256_CBC_SHA + ;; TLS_DHE_DSS_WITH_AES_256_CBC_SHA256 + ;; TLS_DHE_DSS_WITH_CAMELLIA_128_CBC_SHA + ;; TLS_DHE_DSS_WITH_CAMELLIA_128_CBC_SHA256 + ;; TLS_DHE_DSS_WITH_CAMELLIA_256_CBC_SHA + ;; TLS_DHE_DSS_WITH_CAMELLIA_256_CBC_SHA256 + ;; TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA + ;; TLS_DHE_DSS_WITH_RC4_128_SHA + ) + :compression_methods (list 'null) + :extensions (list + (make-$Extension :type 'status_request + :data '(1 0 0 0 0)) + (make-$Extension :type 'server_name + :data '(0 #x10 0 0 #xd #x77 #x69 #x6b #x69 #x70 #x65 #x64 #x69 #x61 #x2e #x6f #x72 #x67)) + (make-$Extension :type 'renegotiation_info + :data '(0)) + (make-$Extension :type 'SessionTicket_TLS :data nil) + (make-$Extension :type 'elliptic_curves + :data '(0 10 0 #x13 0 #x15 0 #x17 0 #x18 0 #x19)) + (make-$Extension :type 'ec_point_formats + :data '(1 0)) + (make-$Extension :type 'signature_algorithms + :data '(0 #x1a 4 1 4 2 4 3 5 1 5 3 6 1 6 3 3 1 3 2 3 3 2 1 2 2 2 3)))))))) + +(defun write-client-key-exchange (writer) + (write-$Record + writer + (make-$Record + :type 'HANDSHAKE + :version ($ContentVersion 'SSL3.0) + :data (make-$Handshake + :type 'CLIENT_KEY_EXCHANGE + :data (make-$ClientKeyExchange + :type 'dhe_rsa + :data (make-$ClientECDiffieHellmanPublic + :type 'explicit + :ecdh_public (make-$ECPoint + :data #(3 1 4 1 5 9)))))))) ;; TODO compute properly + +(defun next-server-hello (reader client-hello-time) + (let ((x (next-$Record reader))) + ;;(print x) + (let ((x ($Record-data x))) + (let ((x ($Handshake-data x))) + (assert (eq 'TLS1.2 ($ServerHello-version x))) + (assert (eq 'TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 + ($ServerHello-cipher_suite x))) + (let ((x ($ServerHello-random x))) + (assert (<= 0 (- ($Random-gmt_unix_time x) client-hello-time) 1)) + ($Random-random_bytes x)))))) + +(defun next-server-certificate (reader) + (let ((x (next-$Record reader))) + ;;(print x) + (let ((x ($Record-data x))) + (let ((x ($Handshake-data x))) + (loop + for x in ($Certificate-list x) + collect (%$Certificate-der x)))))) + +(defun next-server-key-exchange (reader) ;; TODO + (let ((x (next-$Record reader))) + ;;(print x) + (let ((x ($Record-data x))) + (let ((x ($Handshake-data x))) + (etypecase x + ($ServerKeyExchange (print x))))))) + +(defun next-server-hello-done (reader) + (let ((x (next-$Record reader))) + ;;(print x) + (let ((x ($Record-data x))) + (assert (eq 'SERVER_HELLO_DONE ($Handshake-type x))) + (assert (not ($Handshake-data x)))))) +#+nil (let ((saved (test))) (with-open-file (s "/tmp/a" :direction :output @@ -685,25 +841,46 @@ (next-$Record (rw:byte-reader s)) #+nil(next-$ClientHello (record-reader (rw:byte-reader s))))) -(with-open-stream (s (rw.socket:make-tcp-client-socket "wikipedia.org" 443)) - (write-sequence (test) s) ;; client hello - (finish-output s) - (print - (list (next-$Record (rw:byte-reader s)) ;; server hello - (next-$Record (rw:byte-reader s)) ;; certificate - (next-$Record (rw:byte-reader s)) ;; server key exchange - (next-$Record (rw:byte-reader s)) ;; server hello done - )) - ;;TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 - ;; client key exchange - (write-sequence (test2) s) - ;; change cipher spec - ;; multiple handshake messages - (finish-output) - #+nil - (list (next-$Record (rw:byte-reader s)) ;; new session ticket - (next-$Record (rw:byte-reader s)) ;; change cipher spec - (next-$Record (rw:byte-reader s)) ;; encrypted handshake message - ) - ;; encrypted app data - ) +(defun packet-writer (stream) + (let ((b (make-octet-buffer 42))) + (lambda (x) + (case x + (flush + (write-sequence b stream) + (finish-output stream) + (setf (fill-pointer b) 0)) + (t + (vector-push-extend x b))) + x))) + +(defun flush (writer) + (funcall writer 'flush)) + +(defun %tls-connect (reader writer) + (let ((client-random (random-octets 28)) + (client-hello-time (universal-time-to-unix (get-universal-time)))) + (write-client-hello writer client-random client-hello-time) + (flush writer) + (let ((server-random (next-server-hello reader client-hello-time)) + (server-certificates (next-server-certificate reader))) + (next-server-key-exchange reader) + ;; TODO certificate request + (next-server-hello-done reader) + ;; TODO certificate + (write-client-key-exchange writer) + ;; TODO certificate verify + ;; change cipher spec <<<<<<<<<<<<<<<<<<<< + ;; multiple handshake messages + (flush writer) + (next-$Record reader) ;; expecting alert handshake failure + #+nil + (list (next-$Record r) ;; new session ticket + (next-$Record r) ;; change cipher spec + (next-$Record r) ;; encrypted handshake message + )))) + +(defun tls-connect (hostname &optional (port 443)) + (with-open-stream (s (rw.socket:make-tcp-client-socket hostname port)) + (%tls-connect (rw:byte-reader s) (packet-writer s)))) + +;;(tls-connect "wikipedia.org")