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:
| M | tls.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")
