cl-rw

tls.lisp (25156B)

---

 ;;; Copyright (C) 2014 Tomas Hlavaty <tom@logand.com>
 ;;;
 ;;; Permission is hereby granted, free of charge, to any person
 ;;; obtaining a copy of this software and associated documentation
 ;;; files (the "Software"), to deal in the Software without
 ;;; restriction, including without limitation the rights to use, copy,
 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
 ;;; of the Software, and to permit persons to whom the Software is
 ;;; furnished to do so, subject to the following conditions:
 ;;;
 ;;; The above copyright notice and this permission notice shall be
 ;;; included in all copies or substantial portions of the Software.
 ;;;
 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
 ;;; DEALINGS IN THE SOFTWARE.
 
 (defpackage :rw.tls
   (:use :cl))
 
 (in-package :rw.tls)
 
 ;; broken stuff: rc4 md5 sha1 aescbc rsa1024 rsa-keyxchg ecdsa
 
 ;; good: dhe ecdhe aesgcm pfs; better 512hash rsa4096+ aes256+
 
 ;;tshark -i wlp3s0 -V >~/git/cl-rw/tls.log
 ;;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
 
 (rw.wire:defenum $AlertLevel (:type rw:u8)
   (WARNING . 1)
   (FATAL   . 2))
 
 (rw.wire:defenum $AlertDescription (:type rw:u8)
   (CLOSE_NOTIFY                .   0)
   (UNEXPECTED_MESSAGE          .  10)
   (BAD_RECORD_MAC              .  20)
   (DECRYPTION_FAILED_RESERVED  .  21)
   (RECORD_OVERFLOW             .  22)
   (DECOMPRESSION_FAILURE       .  30)
   (HANDSHAKE_FAILURE           .  40)
   (NO_CERTIFICATE_RESERVED     .  41)
   (BAD_CERTIFICATE             .  42)
   (UNSUPPORTED_CERTIFICATE     .  43)
   (CERTIFICATE_REVOKED         .  44)
   (CERTIFICATE_EXPIRED         .  45)
   (CERTIFICATE_UNKNOWN         .  46)
   (ILLEGAL_PARAMETER           .  47)
   (UNKNOWN_CA                  .  48)
   (ACCESS_DENIED               .  49)
   (DECODE_ERROR                .  50)
   (DECRYPT_ERROR               .  51)
   (EXPORT_RESTRICTION_RESERVED .  60)
   (PROTOCOL_VERSION            .  70)
   (INSUFFICIENT_SECURITY       .  71)
   (INTERNAL_ERROR              .  80)
   (USER_CANCELED               .  90)
   (NO_RENEGOTIATION            . 100)
   (UNSUPPORTED_EXTENSION       . 110))
 
 (rw.wire:defenum $CipherSuite (:type rw:u16be)
   (TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA . #X0013)
   (TLS_DHE_DSS_WITH_AES_128_CBC_SHA . #X0032)
   (TLS_DHE_DSS_WITH_AES_128_CBC_SHA256 . #X0040)
   (TLS_DHE_DSS_WITH_AES_128_GCM_SHA256 . #X00A2)
   (TLS_DHE_DSS_WITH_AES_256_CBC_SHA . #X0038)
   (TLS_DHE_DSS_WITH_AES_256_CBC_SHA256 . #X006A)
   (TLS_DHE_DSS_WITH_AES_256_GCM_SHA384 . #X00A3)
   (TLS_DHE_DSS_WITH_CAMELLIA_128_CBC_SHA . #X0044)
   (TLS_DHE_DSS_WITH_CAMELLIA_128_CBC_SHA256 . #X00BD)
   (TLS_DHE_DSS_WITH_CAMELLIA_128_GCM_SHA256 . #XC080)
   (TLS_DHE_DSS_WITH_CAMELLIA_256_CBC_SHA . #X0087)
   (TLS_DHE_DSS_WITH_CAMELLIA_256_CBC_SHA256 . #X00C3)
   (TLS_DHE_DSS_WITH_CAMELLIA_256_GCM_SHA384 . #XC081)
   (TLS_DHE_DSS_WITH_RC4_128_SHA . #X0066)
   (TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA . #X0016)
   (TLS_DHE_RSA_WITH_AES_128_CBC_SHA . #X0033)
   (TLS_DHE_RSA_WITH_AES_128_CBC_SHA256 . #X0067)
   (TLS_DHE_RSA_WITH_AES_128_GCM_SHA256 . #X009E)
   (TLS_DHE_RSA_WITH_AES_256_CBC_SHA . #X0039)
   (TLS_DHE_RSA_WITH_AES_256_CBC_SHA256 . #X006B)
   (TLS_DHE_RSA_WITH_AES_256_GCM_SHA384 . #X009F)
   (TLS_DHE_RSA_WITH_CAMELLIA_128_CBC_SHA . #X0045)
   (TLS_DHE_RSA_WITH_CAMELLIA_128_CBC_SHA256 . #X00BE)
   (TLS_DHE_RSA_WITH_CAMELLIA_128_GCM_SHA256 . #XC07C)
   (TLS_DHE_RSA_WITH_CAMELLIA_256_CBC_SHA . #X0088)
   (TLS_DHE_RSA_WITH_CAMELLIA_256_CBC_SHA256 . #X00C4)
   (TLS_DHE_RSA_WITH_CAMELLIA_256_GCM_SHA384 . #XC07D)
   (TLS_DH_ANON_WITH_3DES_EDE_CBC_SHA . #X001B)
   (TLS_DH_ANON_WITH_AES_128_CBC_SHA . #X0034)
   (TLS_DH_ANON_WITH_AES_128_CBC_SHA256 . #X006C)
   (TLS_DH_ANON_WITH_AES_256_CBC_SHA . #X003A)
   (TLS_DH_ANON_WITH_AES_256_CBC_SHA256 . #X006D)
   (TLS_DH_ANON_WITH_RC4_128_MD5 . #X0018)
   (TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA . #X000D)
   (TLS_DH_DSS_WITH_AES_128_CBC_SHA . #X0030)
   (TLS_DH_DSS_WITH_AES_128_CBC_SHA256 . #X003E)
   (TLS_DH_DSS_WITH_AES_256_CBC_SHA . #X0036)
   (TLS_DH_DSS_WITH_AES_256_CBC_SHA256 . #X0068)
   (TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA . #X0010)
   (TLS_DH_RSA_WITH_AES_128_CBC_SHA . #X0031)
   (TLS_DH_RSA_WITH_AES_128_CBC_SHA256 . #X003F)
   (TLS_DH_RSA_WITH_AES_256_CBC_SHA . #X0037)
   (TLS_DH_RSA_WITH_AES_256_CBC_SHA256 . #X0069)
   (TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA . #XC008)
   (TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA . #XC009)
   (TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256 . #XC023)
   (TLS_ECDHE_ECDSA_WITH_AES_128_GCM_SHA256 . #XC02B)
   (TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA . #XC00A)
   (TLS_ECDHE_ECDSA_WITH_AES_256_CBC_SHA384 . #XC024)
   (TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384 . #XC02C)
   (TLS_ECDHE_ECDSA_WITH_CAMELLIA_128_CBC_SHA256 . #XC072)
   (TLS_ECDHE_ECDSA_WITH_CAMELLIA_128_GCM_SHA256 . #XC086)
   (TLS_ECDHE_ECDSA_WITH_CAMELLIA_256_CBC_SHA384 . #XC073)
   (TLS_ECDHE_ECDSA_WITH_CAMELLIA_256_GCM_SHA384 . #XC087)
   (TLS_ECDHE_ECDSA_WITH_RC4_128_SHA . #XC007)
   (TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA . #XC012)
   (TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA . #XC013)
   (TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256 . #XC027)
   (TLS_ECDHE_RSA_WITH_AES_128_GCM_SHA256 . #XC02F)
   (TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA . #XC014)
   (TLS_ECDHE_RSA_WITH_AES_256_CBC_SHA384 . #XC028)
   (TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384 . #XC030)
   (TLS_ECDHE_RSA_WITH_CAMELLIA_128_CBC_SHA256 . #XC076)
   (TLS_ECDHE_RSA_WITH_CAMELLIA_128_GCM_SHA256 . #XC08A)
   (TLS_ECDHE_RSA_WITH_CAMELLIA_256_CBC_SHA384 . #XC077)
   (TLS_ECDHE_RSA_WITH_CAMELLIA_256_GCM_SHA384 . #XC08B)
   (TLS_ECDHE_RSA_WITH_RC4_128_SHA . #XC011)
   (TLS_NULL_WITH_NULL_NULL . #X0000)
   (TLS_RSA_WITH_3DES_EDE_CBC_SHA . #X000A)
   (TLS_RSA_WITH_AES_128_CBC_SHA . #X002F)
   (TLS_RSA_WITH_AES_128_CBC_SHA256 . #X003C)
   (TLS_RSA_WITH_AES_128_GCM_SHA256 . #X009C)
   (TLS_RSA_WITH_AES_256_CBC_SHA . #X0035)
   (TLS_RSA_WITH_AES_256_CBC_SHA256 . #X003D)
   (TLS_RSA_WITH_AES_256_GCM_SHA384 . #X009D)
   (TLS_RSA_WITH_CAMELLIA_128_CBC_SHA . #X0041)
   (TLS_RSA_WITH_CAMELLIA_128_CBC_SHA256 . #X00BA)
   (TLS_RSA_WITH_CAMELLIA_128_GCM_SHA256 . #XC07A)
   (TLS_RSA_WITH_CAMELLIA_256_CBC_SHA . #X0084)
   (TLS_RSA_WITH_CAMELLIA_256_CBC_SHA256 . #X00C0)
   (TLS_RSA_WITH_CAMELLIA_256_GCM_SHA384 . #XC07B)
   (TLS_RSA_WITH_NULL_MD5 . #X0001)
   (TLS_RSA_WITH_NULL_SHA . #X0002)
   (TLS_RSA_WITH_NULL_SHA256 . #X003B)
   (TLS_RSA_WITH_RC4_128_MD5 . #X0004)
   (TLS_RSA_WITH_RC4_128_SHA . #X0005))
 
 (rw.wire:defenum $ClientCertificateType (:type rw:u8)
   (rsa_sign                  . 1)
   (dss_sign                  . 2)
   (rsa_fixed_dh              . 3)
   (dss_fixed_dh              . 4)
   (rsa_ephemeral_dh_RESERVED . 5)
   (dss_ephemeral_dh_RESERVED . 6)
   (fortezza_dms_RESERVED     . 20))
 
 (rw.wire:defenum $CompressionMethod (:type rw:u8)
   (null . 0))
 
 (rw.wire:defenum $ContentType (:type rw:u8)
   (CHANGE_CIPHER_SPEC . 20)
   (ALERT              . 21)
   (HANDSHAKE          . 22)
   (APPLICATION_DATA   . 23))
 
 (rw.wire:defenum $ContentVersion (:type rw:u16be)
   (SSL3.0 . #x0300)
   (TLS1.2 . #x0303))
 
 (rw.wire:defenum $ExtensionType (:type rw:u16be)
   (ec_point_formats     . #x000b)
   (elliptic_curves      . #x000a)
   (renegotiation_info   . #xff01)
   (SessionTicket_TLS    . #x0023)
   (server_name          . #x0000)
   (signature_algorithms . #x000d)
   (status_request       . #x0005))
 
 (rw.wire:defenum $HandshakeType (:type rw:u8)
   (HELLO_REQUEST       .  0)
   (CLIENT_HELLO        .  1)
   (SERVER_HELLO        .  2)
   (CERTIFICATE         . 11)
   (SERVER_KEY_EXCHANGE . 12)
   (CERTIFICATE_REQUEST . 13)
   (SERVER_HELLO_DONE   . 14)
   (CERTIFICATE_VERIFY  . 15)
   (CLIENT_KEY_EXCHANGE . 16)
   (FINISHED            . 20))
 
 (rw.wire:defenum $HashAlgorithm (:type rw:u8)
   (none   . 0)
   (md5    . 1)
   (sha1   . 2)
   (sha224 . 3)
   (sha256 . 4)
   (sha384 . 5)
   (sha512 . 6))
 
 (rw.wire:defenum $ECCurveType (:type rw:u8)
   (explicit_prime . 1)
   (explicit_char2 . 2)
   (named_curve    . 3)
   #+nil(reserved 248..255))
 
 (rw.wire:defenum $NamedCurve (:type rw:u16be)
   (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))
 
 (rw.wire:defenum %$SignatureHashAlgorithmSignature (:type rw:u8)
   (rsa . 1))
 
 (rw.wire:defenum $ECPointFormat (:type rw:u8)
   (uncompressed . 0)
   (ansiX962_compressed_prime . 1)
   (ansiX962_compressed_char2 . 2)
   #+nil(reserved 248..255))
 
 (defun PublicValueEncoding ()
   ;;'implicit
   'explicit)
 
 (defun KeyExchangeAlgorithm ()
   ;;'ecdhe_rsa
   'ec_diffie_hellman)
 
 ;; (rw.wire:defenum $KeyExchangeAlgorithm (:type rw:u8)
 ;;   (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)
 
 (rw.wire:defstruc $Alert ()
   ($AlertLevel level)
   ($AlertDescription description))
 
 #+nil
 (rw.wire:defstruc $ASN.1Cert ()
   (rw:u8 data :min 0 :max #.(1- (expt 2 24))))
 
 (rw.wire:defstruc %$Certificate ()
   (rw:u8 #+nil $ASN.1Cert data :length rw:u24be :min 0 :max #.(1- (expt 2 24)))
   (rw.wire::computed der :next (rw.der:next-der (rw:reader data))))
 
 (rw.wire:defstruc $Certificate ()
   (%$Certificate list :length rw:u24be :min 0 :max #.(1- (expt 2 24)) :size t))
 
 (rw.wire:defstruc %$ECPointFormatList ()
   ($ECPointFormat ec_point_format_list :length rw:u8 :min 1 :size t))
 
 (rw.wire:defstruc $ECPointFormatList ()
   (%$ECPointFormatList data :length rw:u16be))
 
 (rw.wire:defstruc $Extension ()
   ($ExtensionType type)
   ((ecase type
      ;;(status_request)
      ;;(server_name)
      ;;(renegotiation_info)
      ;;(SessionTicket_TLS)
      ;;(elliptic_curves)
      (ec_point_formats $ECPointFormatList)
      #+nil(signature_algorithms))
    data)
   #+nil(rw:u8 data :length rw:u16be :min 0 :max #.(1- (expt 2 16)) :size t))
 
 (rw.wire:defstruc $ClientHello ()
   ($ContentVersion #+nil $ProtocolVersion version)
   ($Random random)
   ($SessionID session_id)
   ($CipherSuite cipher_suites :length rw:u16be :min 2 :max #.(- (expt 2 16) 2) :size t)
   ($CompressionMethod compression_methods :length rw:u8 :min 1 :max #.(1- (expt 2 8)) :size t)
   ($Extension extensions :length rw:u16be :min 0 :max #.(1- (expt 2 16)) :size t))
 
 (rw.wire:defstruc $ServerDHParams ()
   (rw:u8 dh_p :length rw:u16be :min 1 :max #.(1- (expt 2 16)))
   (rw:u8 dh_g :length rw:u16be :min 1 :max #.(1- (expt 2 16)))
   (rw:u8 dh_Ys :length rw:u16be :min 1 :max #.(1- (expt 2 16))))
 
 (rw.wire:defstruc $signed_params ()
   (rw:u8 client_random :size 32)
   (rw:u8 server_random :size 32)
   ($ServerDHParams params2))
 
 (rw.wire:defstruc %$ServerDHParams ()
   ($ServerDHParams params)
   ($signed_params signed_params))
 
 (rw.wire:defstruc $ECCurve ()
   (rw:u8 a :length rw:u8 :min 1)
   (rw:u8 b :length rw:u8 :min 1))
 
 ;;http://stackoverflow.com/questions/10936171/how-do-i-compress-or-encode-the-elliptic-curve-public-key-and-put-it-over-the-ne
 (rw.wire:defstruc $ECPoint ()
   ;;(rw:u8 data :length rw:u8 :min 1 :size t)
   (rw:u8 length)
   (rw:u8 #+nil $ECPointFormat format #+nil :check #+nil(= 4 format)) ;; 4=uncompressed 2|3=compressed
   ;;(rw.wire::computed format :compute (progn (assert (= 4 %format)) %format))
   (rw:u8 x :size (floor length 2))
   (rw:u8 y :size (floor length 2)))
 
 
 ;; (rw.wire: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>)
 
 ;; (rw.wire: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>)
 
 (rw.wire:defstruc $ECParameters ()
   ($ECCurveType curve_type)
   ((ecase curve_type
      ;;(explicit_prime %$ExplicitPrime)
      ;;(explicit_char2 %$ExplicitChar2)
      (named_curve $NamedCurve))
    data))
 
 (rw.wire:defstruc $ServerECDHParams ()
   ($ECParameters curve_params)
   ($ECPoint public))
 
 (rw.wire:defstruc %$SignatureHashAlgorithm ()
   ($HashAlgorithm hash)
   (%$SignatureHashAlgorithmSignature signature))
 
 (rw.wire:defstruc %$ECSASignature () ;; digitally-signed
   (%$SignatureHashAlgorithm algorithm)
   (rw:u16be length #+nil :compute #+nil(ShaSize))
   (rw:u8 sha_hash :size length))
 
 (rw.wire:defstruc $Signature ()
   (rw.wire::computed algorithm :compute (SignatureAlgorithm))
   ((ecase algorithm
      (ecdsa %$ECSASignature))
    data))
 
 (rw.wire:defstruc %$ServerECDHParams ()
   ($ServerECDHParams params)
   ($Signature signed_params))
 
 (rw.wire:defstruc $ServerKeyExchange ()
   ;;(rw:u8 data :length rw:u16be :min 1 :max #.(1- (expt 2 16)))
   (rw.wire::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))
 
 (rw.wire:defstruc $SessionID ()
   (rw:u8 data :length rw:u8 :min 0 :max 32 :size t))
 
 (rw.wire:defstruc $Random ()
   (rw:u32be gmt_unix_time)
   (rw:u8 random_bytes :size 28))
 
 (rw.wire:defstruc $ServerHello ()
   ($ContentVersion #+nil ProtocolVersion version)
   ($Random random)
   ($SessionID session_id)
   ($CipherSuite cipher_suite)
   ($CompressionMethod compression_method)
   ($Extension extensions :length rw:u16be :min 0 :max #.(1- (expt 2 16)) :size t))
 
 (rw.wire:defstruc $dh_Yc ()
   (rw:u8 data :length rw:u16be :min 1 :max #.(1- (expt 2 16))))
 
 (rw.wire:defstruc $EncryptedPreMasterSecret ()
   ($PreMasterSecret pubkey_encrypted))
 
 (rw.wire:defstruc $ClientDiffieHellmanPublic ()
   (rw.wire::computed type :compute (PublicValueEncoding))
   ((ecase type
      (implicit)
      (explicit $dh_Yc))
    dh_public))
 
 (rw.wire:defstruc $ClientECDiffieHellmanPublic ()
   (rw.wire::computed type :compute (PublicValueEncoding))
   ((ecase type
      (implicit)
      (explicit $ECPoint)) ;; ecdh_Yc
    ecdh_public))
 
 (rw.wire:defstruc $ClientKeyExchange ()
   (rw.wire::computed type :compute (KeyExchangeAlgorithm))
   ((ecase type
      ;;(rsa $EncryptedPreMasterSecret)
      ;;((dhe_dss dhe_rsa dh_dss dh_rsa dh_anon) $ClientDiffieHellmanPublic)
      (ec_diffie_hellman $ClientECDiffieHellmanPublic))
    data))
 
 (rw.wire:defstruc $Handshake ()
   ($HandshakeType type)
   ((ecase type
      (CERTIFICATE $Certificate)
      (CLIENT_HELLO $ClientHello)
      (CLIENT_KEY_EXCHANGE $ClientKeyExchange)
      (SERVER_HELLO $ServerHello)
      (SERVER_HELLO_DONE)
      (SERVER_KEY_EXCHANGE $ServerKeyExchange))
    data :length rw:u24be))
 
 (rw.wire:defstruc $PreMasterSecret ()
   ($ContentVersion #+nil ProtocolVersion client_version)
   (rw:u8 random :size 46))
 
 (rw.wire:defstruc $Record ()
   ($ContentType type)
   (rw:u16be #+nil ContentVersion version)
   ((ecase type
      (ALERT $Alert)
      (HANDSHAKE $Handshake))
    data :length rw:u16be :min 1 :max 16383)
   #+nil
   (rw:u8 data :length rw:u16be :min 1 :max 16383 :size t))
 
 ;; struct {
 ;;          HashAlgorithm hash
 ;;          SignatureAlgorithm signature
 ;;    } SignatureAndHashAlgorithm
 
 ;;    SignatureAndHashAlgorithm
 ;;     supported_signature_algorithms<2..2^16-1>
 
 (defun random-octets (length)
   (loop
      for i from 0 below length
      collect (random 256)))
 
 (defun universal-time-to-unix (x)
   (- x #.(encode-universal-time 0 0 0 1 1 1970 0)))
 
 ;;(universal-time-to-unix (encode-universal-time 19 22 23 28 7 2014 0)) ;; TODO broken
 
 (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_RSA_WITH_AES_128_GCM_SHA256
                                    ;; TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384
                                    ;; TLS_DHE_RSA_WITH_AES_256_GCM_SHA384
                                    )
                   :compression_methods (list 'null)
                   :extensions (list
                                #+nil
                                (make-$Extension :type 'status_request
                                                 :data '(1 0 0 0 0))
                                #+nil
                                (make-$Extension :type 'server_name
                                                 :data '(0 #x10 0 0 #xd #x77 #x69 #x6b #x69 #x70 #x65 #x64 #x69 #x61 #x2e #x6f #x72 #x67))
                                #+nil
                                (make-$Extension :type 'renegotiation_info
                                                 :data '(0))
                                #+nil
                                (make-$Extension :type 'SessionTicket_TLS :data nil)
                                #+nil
                                (make-$Extension :type 'elliptic_curves ;; TODO
                                                 :data '(0 10 0 #x13 0 #x15 0 #x17 0 #x18 0 #x19))
                                (make-$Extension
                                 :type 'ec_point_formats ;; TODO
                                 :data (make-$ECPointFormatList
                                        :data
                                        (make-%$ECPointFormatList
                                         :ec_point_format_list
                                         '(uncompressed))))
                                #+nil
                                (make-$Extension :type 'signature_algorithms ;; TODO
                                                 :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
                                        :length 65
                                        :format 4 ;;'uncompressed
                                        :x #(47 33 158 197 200 79 233 37 253 19
                                             101 180 145 99 27 72 189 79 195 35
                                             43 226 40 247 85 134 48 189 7 134
                                             71 97)
                                        :y #(26 90 191 31 48 24 153 65 243 211
                                             213 24 113 9 11 139 111 253 83 190
                                             215 197 143 219 71 194 44 136 240
                                             78 112 25))))))))
 
 (defun next-server-hello (reader client-hello-time)
   (let ((x (next-$Record reader)))
     (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))
         ;; TODO server hello extensions
         ))))
 
 (defun next-server-certificate (reader)
   (let ((x (next-$Record reader)))
     (let ((x ($Record-data x)))
       (let ((x ($Handshake-data x)))
         (loop
            for x in ($Certificate-list x)
            collect (%$Certificate-der x))))))
 (defun der-decode-bit-string (x)
   (destructuring-bind (tag m n) x
     (assert (eq 'rw.der::bit-string tag))
     (assert (zerop m))
     (let* ((x (ash n m))
            (nbytes (ceiling (integer-length x) 8))
            (b (rw.wire:make-octet-buffer nbytes))
            (w (rw:writer b)))
       (loop
          for i from (1- nbytes) downto 0
          do (rw:write-u8 w (ldb (byte 8 (* 8 i)) x)))
       (rw.der:next-der (rw:reader b)))))
 
 (defun certificate-r-s (x)
   (labels ((rec (x)
              (when (consp x)
                (when (equal (car x)
                             '((rw.der::oid 1 2 840 113549 1 1 1) nil))
                  (assert (not (cddr x)))
                  (destructuring-bind (r s) (der-decode-bit-string (cadr x))
                    ;;(print (list :@@@ r s))
                    (return-from certificate-r-s (values r s))))
                (mapc #'rec x))))
     (rec x)))
 
 (defun next-server-key-exchange (reader client-random server-random server-certificates)
   (certificate-r-s (car server-certificates)) ;; TODO r s
   (let ((x (next-$Record reader)))
     (let ((x ($Record-data x)))
       (let ((x ($Handshake-data x)))
         (assert (eq 'ec_diffie_hellman ($ServerKeyExchange-type x)))
         (let ((x ($ServerKeyExchange-data x)))
           (let ((x (%$serverecdhparams-params x)))
             (let ((b (rw.wire:make-octet-buffer 42)))
               (write-$ServerECDHParams (rw:writer b) x)
               #+nil(print (list :@@@ :params b)))
             (let ((x ($serverecdhparams-public x)))
               ))
           (let ((x (%$serverecdhparams-signed_params x)))
             (assert (eq 'ecdsa ($signature-algorithm x)))
             (let ((x ($signature-data x)))
               (let ((hash (%$ecsasignature-sha_hash x)))
                 #+nil(print (list :@@@ :hash hash)))))
           ;; TODO check signed params
           (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
                      :if-exists :supersede
                      :if-does-not-exist :create
                      :element-type '(unsigned-byte 8))
     (write-sequence saved s))
   (with-open-file (s "/tmp/a" :element-type '(unsigned-byte 8))
     (next-$Record (rw:byte-reader s))
     #+nil(next-$ClientHello (record-reader (rw:byte-reader s)))))
 
 (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)
     (rw.wire:flush writer)
     (let ((server-random (next-server-hello reader client-hello-time))
           (server-certificates (next-server-certificate reader)))
       (next-server-key-exchange reader client-random server-random
                                 server-certificates)
       ;; TODO certificate request
       (next-server-hello-done reader)
       ;; TODO certificate
       (write-client-key-exchange writer)
       ;; TODO certificate verify
       ;; change cipher spec <<<<<<<<<<<<<<<<<<<<
       ;; multiple handshake messages
       (rw.wire: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) (rw.wire:packet-writer s))))
 
 ;;(tls-connect "wikipedia.org")
 ;;(tls-connect "127.1" 5556)