cl-rw

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

commit 53c86fc6436925699a59d165936c83f980f5b53e
parent 9b173e2b93cc88b06b8fd7f29cd1655edc3df89f
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun,  3 Aug 2014 21:04:19 +0200

tls added

Diffstat:
Atls.lisp | 709+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 709 insertions(+), 0 deletions(-)

diff --git a/tls.lisp b/tls.lisp @@ -0,0 +1,709 @@ +;;; 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) + +;;tshark -i wlp3s0 -V >~/git/cl-rw/tls.log +;;gnutls-cli wikipedia.org + +;; https://en.wikipedia.org/wiki/Transport_Layer_Security + +(defun next-u8 (reader) + (rw:next-u8 reader)) + +(defun next-u16 (reader) + (rw:next-u16 reader)) + +(defun next-u24 (reader) + (rw:next-u24 reader)) + +(defun next-u32 (reader) + (rw:next-u32 reader)) + +(defun write-u8 (writer x) + (rw:write-u8 writer x)) + +(defun write-u16 (writer x) + (rw:write-u16 writer x)) + +(defun write-u24 (writer x) + (assert (<= 0 x #.(1- (expt 2 24)))) + (write-u8 writer (ash x -16)) + (write-u8 writer (logand #xff (ash x -8))) + (write-u8 writer (logand #xff x))) + +(defun write-u32 (writer x) + (rw:write-u32 writer x)) + +(defun fname (x) + (intern (format nil "~a" x))) + +(defun mname (x) + (intern (format nil "MAKE-~a" x))) + +(defun rname (x) + (intern (format nil "NEXT-~a" x))) + +(defun wname (x) + (intern (format nil "WRITE-~a" x))) + +(defmacro defenum (name (&key nbits) &body alist) + (let ((fname (fname name)) + (sname (intern (format nil "~a-SYMBOLS" name))) + (cname (intern (format nil "~a-CODES" name))) + (rname (rname name)) + (wname (wname name))) + `(let* ((alist ',alist) + (symbols (mapcar #'car alist)) + (codes (mapcar #'cdr alist))) + (defun ,fname (x) + (etypecase x + (symbol (cdr (assoc x alist))) + (integer (car (rassoc x alist))))) + (defun ,sname () symbols) + (defun ,cname () codes) + (defun ,rname (reader) + (let ((z (,fname (, (ecase nbits + (8 'rw:next-u8) + (16 'rw:next-u16)) + reader)))) + (assert z) + z)) + (defun ,wname (writer x) + (, (ecase nbits + (8 'rw:write-u8) + (16 'rw:write-u16)) + writer + (etypecase x + (symbol (,fname x)) + (integer (when (member x codes) x)))))))) + +(defenum $AlertLevel (:nbits 8) + (WARNING . 1) + (FATAL . 2)) + +(defenum $AlertDescription (:nbits 8) + (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)) + +(defenum $CipherSuite (:nbits 16) + (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)) + +(defenum $ClientCertificateType (:nbits 8) + (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)) + +(defenum $CompressionMethod (:nbits 8) + (null . 0)) + +(defenum $ContentType (:nbits 8) + (CHANGE_CIPHER_SPEC . 20) + (ALERT . 21) + (HANDSHAKE . 22) + (APPLICATION_DATA . 23)) + +(defenum $ContentVersion (:nbits 16) + (SSL3.0 . #x0300) + (TLS1.2 . #x0303)) + +(defenum $ExtensionType (:nbits 16) + (ec_point_formats . #x000b) + (elliptic_curves . #x000a) + (renegotiation_info . #xff01) + (SessionTicket_TLS . #x0023) + (server_name . #x0000) + (signature_algorithms . #x000d) + (status_request . #x0005)) + +(defenum $HandshakeType (:nbits 8) + (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)) + +(defenum $HashAlgorith (:nbits 8) + (none . 0) + (md5 . 1) + (sha1 . 2) + (sha224 . 3) + (sha256 . 4) + (sha384 . 5) + (sha512 . 6)) + +(defenum $SignatureAlgorithm (:nbits 8) + (anonymous . 0) + (rsa . 1) + (dsa . 2) + (ecdsa . 3)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(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) + +(defun KeyExchangeAlgorithm () + ;; dhe_dss dhe_rsa dh_anon rsa dh_dss dh_rsa + 'dhe_rsa) + +;;;;;;;;;;;;;; + +(defun aname (struc &optional slot) + (intern (format nil "~a-~a" struc slot))) + +(defun defun-rname-slot (slot) + (destructuring-bind (ty na &key length size min max compute next) slot + `(,na + , (flet ((r1 () + (if (listp ty) + `(ecase ,(cadr ty) + ,@(loop + for (nm ty) in (cddr ty) + collect (if ty + `(,nm (,(rname ty) r)) + `(,nm)))) + `(,(rname ty) r)))) + (cond + ((or compute next) + (assert (eq 'computed ty)) + (assert (not (or length size min max))) + (or compute next)) + (length + `(let ((l (,(rname length) r)) + (b (make-octet-buffer 100))) + ,@(when min `((assert (<= ,min l)))) + ,@(when max `((assert (<= l ,max)))) + ,@(when (integerp size) `((assert (= l ,size)))) + (dotimes (i l) + (vector-push-extend (next-u8 r) b)) + ,(if (eq 'u8 ty) + 'b + (if size + `(let ((r (rw:peek-reader (rw:reader b)))) + (loop + while (rw:peek r) + collect ,(r1))) + `(let ((r (rw:reader b))) + ,(r1)))))) + (size + (assert (eq 'u8 ty)) + `(loop for i from 0 below ,size collect ,(r1))) + (t + `(let ((v ,(r1))) + ,@(when min `((assert (<= ,min v)))) + ,@(when max `((assert (<= v ,max)))) + v))))))) + +(defun defun-rname (name slots) + `(defun ,(rname name) (r) + (let* (,@(mapcar 'defun-rname-slot slots)) + (,(mname name) + ,@(loop + for slot in slots + appending (let ((na (cadr slot))) + (list (intern (symbol-name na) :keyword) na))))))) + +(defun defun-wname (name slots) + `(defun ,(wname name) (w x) + ,@(loop + for slot in slots + collect + (destructuring-bind (ty na &key length size min max compute next) slot + (flet ((w1 () + (if (listp ty) + (ecase (car ty) + (ecase `(ecase (,(aname name (cadr ty)) x) + ,@(loop + for (nm ty) in (cddr ty) + collect + (if ty + `(,nm (,(wname ty) w v)) + `(,nm)))))) + `(,(wname ty) w v)))) + (cond + ((or compute next) + (assert (eq 'computed ty)) + (assert (not (or length size min max))) + (when compute + `(setf (,(aname name na) x) ,compute))) + (length + `(let ((v (,(aname name na) x)) + (b (make-octet-buffer 100))) + (let ((w (rw:writer b))) + ,(cond + (size + `(if (listp v) + (loop for v in v do ,(w1)) + (loop for v across v do ,(w1)))) + (t (w1)))) + (let ((l (length b))) + ,@(when min `((assert (<= ,min l)))) + ,@(when max `((assert (<= l ,max)))) + ,@(when (integerp size) `((assert (= l ,size)))) + (,(wname length) w l)) + (loop for e across b do (write-u8 w e)))) + (size + (assert (eq 'u8 ty)) + `(let ((v (,(aname name na) x))) + ,@ (when (or min max (integerp size)) + `((let ((l (length v))) + ,@(when min `((assert (<= ,min l)))) + ,@(when max `((assert (<= l ,max)))) + ,@(when (integerp size) `((assert (= l ,size))))))) + (if (listp v) + (loop for v in v do ,(w1)) + (loop for v across v do ,(w1))))) + (t + `(let ((v (,(aname name na) x))) + ,@(when min `((assert (<= ,min v)))) + ,@(when max `((assert (<= v ,max)))) + ,(w1))))))))) + +(defmacro defstruc (name () &body slots) + `(progn + (defstruct ,(fname name) ,@(mapcar #'cadr slots)) + ,(defun-rname name slots) + ,(defun-wname name slots))) + +(defstruc $Alert () + ($AlertLevel level) + ($AlertDescription description)) + +#+nil +(defstruc $ASN.1Cert () + (u8 data :min 0 :max #.(1- (expt 2 24)))) + +(defstruc %$Certificate () + (u8 #+nil $ASN.1Cert data :length u24 :min 0 :max #.(1- (expt 2 24))) + (computed der :next (rw.der:decode (rw:reader data)))) + +(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) + ($SessionID session_id) + ($CipherSuite cipher_suites :length u16 :min 2 :max #.(- (expt 2 16) 2) :size t) + ($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 + (ecase type + (status_request) + (server_name) + (renegotiation_info) + (SessionTicket_TLS) + (elliptic_curves) + (ec_point_formats) + (signature_algorithms)) + (u8 data :length u16 :min 0 :max #.(1- (expt 2 16)) :size t)) + +(defstruc $Handshake () + ($HandshakeType type) + ((ecase type + (CERTIFICATE $Certificate) + (CLIENT_HELLO $ClientHello) + (CLIENT_KEY_EXCHANGE $ClientKeyExchange) + (SERVER_HELLO $ServerHello) + (SERVER_HELLO_DONE) + (SERVER_KEY_EXCHANGE #+nil $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) + ((ecase type + (ALERT $Alert) + (HANDSHAKE $Handshake)) + data :length u16 :min 1 :max 16383) + #+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 +;; } SignatureAndHashAlgorithm + +;; 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 + 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 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)) + +(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))))) + +(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 + )