cl-rw

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

commit 700bebacf7e5dd2b820c23d201caca83f25f9f4d
parent bca0e0a6503a41cb85e043d93a604a781807bc35
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun,  2 Nov 2014 14:17:13 +0100

use wire

Diffstat:
Mcl-rw.asd | 1-
Dtls-macros.lisp | 186-------------------------------------------------------------------------------
Mtls.lisp | 246++++++++++++++++++++++++++++++++-----------------------------------------------
Mwire.lisp | 5+++--
4 files changed, 103 insertions(+), 335 deletions(-)

diff --git a/cl-rw.asd b/cl-rw.asd @@ -51,5 +51,4 @@ (:file "der") (:file "wire") (:file "dns") - (:file "tls-macros") ;; TODO use wire! (:file "tls"))) diff --git a/tls-macros.lisp b/tls-macros.lisp @@ -1,186 +0,0 @@ -;;; 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) - -(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)))))))) - -(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))) diff --git a/tls.lisp b/tls.lisp @@ -20,6 +20,9 @@ ;;; 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 @@ -31,38 +34,11 @@ ;; https://tools.ietf.org/html/rfc5246 ;; https://tools.ietf.org/html/rfc4492 -(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)) - -(defenum $AlertLevel (:nbits 8) +(rw.wire:defenum $AlertLevel (:nbits 8) (WARNING . 1) (FATAL . 2)) -(defenum $AlertDescription (:nbits 8) +(rw.wire:defenum $AlertDescription (:nbits 8) (CLOSE_NOTIFY . 0) (UNEXPECTED_MESSAGE . 10) (BAD_RECORD_MAC . 20) @@ -89,7 +65,7 @@ (NO_RENEGOTIATION . 100) (UNSUPPORTED_EXTENSION . 110)) -(defenum $CipherSuite (:nbits 16) +(rw.wire: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) @@ -177,7 +153,7 @@ (TLS_RSA_WITH_RC4_128_MD5 . #X0004) (TLS_RSA_WITH_RC4_128_SHA . #X0005)) -(defenum $ClientCertificateType (:nbits 8) +(rw.wire:defenum $ClientCertificateType (:nbits 8) (rsa_sign . 1) (dss_sign . 2) (rsa_fixed_dh . 3) @@ -186,20 +162,20 @@ (dss_ephemeral_dh_RESERVED . 6) (fortezza_dms_RESERVED . 20)) -(defenum $CompressionMethod (:nbits 8) +(rw.wire:defenum $CompressionMethod (:nbits 8) (null . 0)) -(defenum $ContentType (:nbits 8) +(rw.wire:defenum $ContentType (:nbits 8) (CHANGE_CIPHER_SPEC . 20) (ALERT . 21) (HANDSHAKE . 22) (APPLICATION_DATA . 23)) -(defenum $ContentVersion (:nbits 16) +(rw.wire:defenum $ContentVersion (:nbits 16) (SSL3.0 . #x0300) (TLS1.2 . #x0303)) -(defenum $ExtensionType (:nbits 16) +(rw.wire:defenum $ExtensionType (:nbits 16) (ec_point_formats . #x000b) (elliptic_curves . #x000a) (renegotiation_info . #xff01) @@ -208,7 +184,7 @@ (signature_algorithms . #x000d) (status_request . #x0005)) -(defenum $HandshakeType (:nbits 8) +(rw.wire:defenum $HandshakeType (:nbits 8) (HELLO_REQUEST . 0) (CLIENT_HELLO . 1) (SERVER_HELLO . 2) @@ -220,7 +196,7 @@ (CLIENT_KEY_EXCHANGE . 16) (FINISHED . 20)) -(defenum $HashAlgorithm (:nbits 8) +(rw.wire:defenum $HashAlgorithm (:nbits 8) (none . 0) (md5 . 1) (sha1 . 2) @@ -229,13 +205,13 @@ (sha384 . 5) (sha512 . 6)) -(defenum $ECCurveType (:nbits 8) +(rw.wire:defenum $ECCurveType (:nbits 8) (explicit_prime . 1) (explicit_char2 . 2) (named_curve . 3) #+nil(reserved 248..255)) -(defenum $NamedCurve (:nbits 16) +(rw.wire:defenum $NamedCurve (:nbits 16) (sect163k1 . 1) (sect163r1 . 2) (sect163r2 . 3) @@ -265,10 +241,10 @@ (arbitrary_explicit_prime_curves . #xff01) (arbitrary_explicit_char2_curves . #xff02)) -(defenum %$SignatureHashAlgorithmSignature (:nbits 8) +(rw.wire:defenum %$SignatureHashAlgorithmSignature (:nbits 8) (rsa . 1)) -(defenum $ECPointFormat (:nbits 8) +(rw.wire:defenum $ECPointFormat (:nbits 8) (uncompressed . 0) (ansiX962_compressed_prime . 1) (ansiX962_compressed_char2 . 2) @@ -282,7 +258,7 @@ ;;'ecdhe_rsa 'ec_diffie_hellman) -;; (defenum $KeyExchangeAlgorithm (:nbits 8) +;; (rw.wire:defenum $KeyExchangeAlgorithm (:nbits 8) ;; (dhe_dss . 0) ;; (dhe_rsa . 1) ;; (dh_anon . 2) @@ -306,35 +282,28 @@ ;;'dsa 'ecdsa) -(defun make-octet-buffer (length) - (make-array length - :element-type '(unsigned-byte 8) - :initial-element 0 - :adjustable t - :fill-pointer 0)) - -(defstruc $Alert () +(rw.wire:defstruc $Alert () ($AlertLevel level) ($AlertDescription description)) #+nil -(defstruc $ASN.1Cert () - (u8 data :min 0 :max #.(1- (expt 2 24)))) +(rw.wire:defstruc $ASN.1Cert () + (rw.wire: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)))) +(rw.wire:defstruc %$Certificate () + (rw.wire:u8 #+nil $ASN.1Cert data :length rw.wire:u24 :min 0 :max #.(1- (expt 2 24))) + (rw.wire::computed der :next (rw.der:decode (rw:reader data)))) -(defstruc $Certificate () - (%$Certificate list :length u24 :min 0 :max #.(1- (expt 2 24)) :size t)) +(rw.wire:defstruc $Certificate () + (%$Certificate list :length rw.wire:u24 :min 0 :max #.(1- (expt 2 24)) :size t)) -(defstruc %$ECPointFormatList () - ($ECPointFormat ec_point_format_list :length u8 :min 1 :size t)) +(rw.wire:defstruc %$ECPointFormatList () + ($ECPointFormat ec_point_format_list :length rw.wire:u8 :min 1 :size t)) -(defstruc $ECPointFormatList () - (%$ECPointFormatList data :length u16)) +(rw.wire:defstruc $ECPointFormatList () + (%$ECPointFormatList data :length rw.wire:u16)) -(defstruc $Extension () +(rw.wire:defstruc $Extension () ($ExtensionType type) ((ecase type ;;(status_request) @@ -345,51 +314,51 @@ (ec_point_formats $ECPointFormatList) #+nil(signature_algorithms)) data) - #+nil(u8 data :length u16 :min 0 :max #.(1- (expt 2 16)) :size t)) + #+nil(rw.wire:u8 data :length rw.wire:u16 :min 0 :max #.(1- (expt 2 16)) :size t)) -(defstruc $ClientHello () +(rw.wire: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 $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) + ($CipherSuite cipher_suites :length rw.wire:u16 :min 2 :max #.(- (expt 2 16) 2) :size t) + ($CompressionMethod compression_methods :length rw.wire:u8 :min 1 :max #.(1- (expt 2 8)) :size t) + ($Extension extensions :length rw.wire:u16 :min 0 :max #.(1- (expt 2 16)) :size t)) + +(rw.wire:defstruc $ServerDHParams () + (rw.wire:u8 dh_p :length rw.wire:u16 :min 1 :max #.(1- (expt 2 16))) + (rw.wire:u8 dh_g :length rw.wire:u16 :min 1 :max #.(1- (expt 2 16))) + (rw.wire:u8 dh_Ys :length rw.wire:u16 :min 1 :max #.(1- (expt 2 16)))) + +(rw.wire:defstruc $signed_params () + (rw.wire:u8 client_random :size 32) + (rw.wire:u8 server_random :size 32) ($ServerDHParams params2)) -(defstruc %$ServerDHParams () +(rw.wire:defstruc %$ServerDHParams () ($ServerDHParams params) ($signed_params signed_params)) -(defstruc $ECCurve () - (u8 a :length u8 :min 1) - (u8 b :length u8 :min 1)) +(rw.wire:defstruc $ECCurve () + (rw.wire:u8 a :length rw.wire:u8 :min 1) + (rw.wire:u8 b :length rw.wire: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 -(defstruc $ECPoint () - ;;(u8 data :length u8 :min 1 :size t) - (u8 length) - (u8 #+nil $ECPointFormat format #+nil :check #+nil(= 4 format)) ;; 4=uncompressed 2|3=compressed - ;;(computed format :compute (progn (assert (= 4 %format)) %format)) - (u8 x :size (floor length 2)) - (u8 y :size (floor length 2))) - -;; (defstruc %$ExplicitPrime () +(rw.wire:defstruc $ECPoint () + ;;(rw.wire:u8 data :length rw.wire:u8 :min 1 :size t) + (rw.wire:u8 length) + (rw.wire: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.wire:u8 x :size (floor length 2)) + (rw.wire: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>) -;; (defstruc %$ExplicitChar2 () +;; (rw.wire:defstruc %$ExplicitChar2 () ;; uint16 m ;; ECBasisType basis ;; select (basis) { @@ -405,7 +374,7 @@ ;; opaque order <1..2^8-1> ;; opaque cofactor <1..2^8-1>) -(defstruc $ECParameters () +(rw.wire:defstruc $ECParameters () ($ECCurveType curve_type) ((ecase curve_type ;;(explicit_prime %$ExplicitPrime) @@ -413,32 +382,32 @@ (named_curve $NamedCurve)) data)) -(defstruc $ServerECDHParams () +(rw.wire:defstruc $ServerECDHParams () ($ECParameters curve_params) ($ECPoint public)) -(defstruc %$SignatureHashAlgorithm () +(rw.wire:defstruc %$SignatureHashAlgorithm () ($HashAlgorithm hash) (%$SignatureHashAlgorithmSignature signature)) -(defstruc %$ECSASignature () ;; digitally-signed +(rw.wire:defstruc %$ECSASignature () ;; digitally-signed (%$SignatureHashAlgorithm algorithm) - (u16 length #+nil :compute #+nil(ShaSize)) - (u8 sha_hash :size length)) + (rw.wire:u16 length #+nil :compute #+nil(ShaSize)) + (rw.wire:u8 sha_hash :size length)) -(defstruc $Signature () - (computed algorithm :compute (SignatureAlgorithm)) +(rw.wire:defstruc $Signature () + (rw.wire::computed algorithm :compute (SignatureAlgorithm)) ((ecase algorithm (ecdsa %$ECSASignature)) data)) -(defstruc %$ServerECDHParams () +(rw.wire:defstruc %$ServerECDHParams () ($ServerECDHParams params) ($Signature signed_params)) -(defstruc $ServerKeyExchange () - ;;(u8 data :length u16 :min 1 :max #.(1- (expt 2 16))) - (computed type :compute (KeyExchangeAlgorithm)) +(rw.wire:defstruc $ServerKeyExchange () + ;;(rw.wire:u8 data :length rw.wire:u16 :min 1 :max #.(1- (expt 2 16))) + (rw.wire::computed type :compute (KeyExchangeAlgorithm)) ((ecase type ;;(dh_anon $ServerDHParams) ;;((dhe_dss dhe_rsa) %$ServerDHParams) @@ -446,50 +415,50 @@ #+nil((rsa dh_dss dh_rsa))) data)) -(defstruc $SessionID () - (u8 data :length u8 :min 0 :max 32 :size t)) +(rw.wire:defstruc $SessionID () + (rw.wire:u8 data :length rw.wire:u8 :min 0 :max 32 :size t)) -(defstruc $Random () - (u32 gmt_unix_time) - (u8 random_bytes :size 28)) +(rw.wire:defstruc $Random () + (rw.wire:u32 gmt_unix_time) + (rw.wire:u8 random_bytes :size 28)) -(defstruc $ServerHello () +(rw.wire: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)) + ($Extension extensions :length rw.wire:u16 :min 0 :max #.(1- (expt 2 16)) :size t)) -(defstruc $dh_Yc () - (u8 data :length u16 :min 1 :max #.(1- (expt 2 16)))) +(rw.wire:defstruc $dh_Yc () + (rw.wire:u8 data :length rw.wire:u16 :min 1 :max #.(1- (expt 2 16)))) -(defstruc $EncryptedPreMasterSecret () +(rw.wire:defstruc $EncryptedPreMasterSecret () ($PreMasterSecret pubkey_encrypted)) -(defstruc $ClientDiffieHellmanPublic () - (computed type :compute (PublicValueEncoding)) +(rw.wire:defstruc $ClientDiffieHellmanPublic () + (rw.wire::computed type :compute (PublicValueEncoding)) ((ecase type (implicit) (explicit $dh_Yc)) dh_public)) -(defstruc $ClientECDiffieHellmanPublic () - (computed type :compute (PublicValueEncoding)) +(rw.wire:defstruc $ClientECDiffieHellmanPublic () + (rw.wire::computed type :compute (PublicValueEncoding)) ((ecase type (implicit) (explicit $ECPoint)) ;; ecdh_Yc ecdh_public)) -(defstruc $ClientKeyExchange () - (computed type :compute (KeyExchangeAlgorithm)) +(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)) -(defstruc $Handshake () +(rw.wire:defstruc $Handshake () ($HandshakeType type) ((ecase type (CERTIFICATE $Certificate) @@ -498,21 +467,21 @@ (SERVER_HELLO $ServerHello) (SERVER_HELLO_DONE) (SERVER_KEY_EXCHANGE $ServerKeyExchange)) - data :length u24)) + data :length rw.wire:u24)) -(defstruc $PreMasterSecret () +(rw.wire:defstruc $PreMasterSecret () ($ContentVersion #+nil ProtocolVersion client_version) - (u8 random :size 46)) + (rw.wire:u8 random :size 46)) -(defstruc $Record () +(rw.wire:defstruc $Record () ($ContentType type) - (u16 #+nil ContentVersion version) + (rw.wire:u16 #+nil ContentVersion version) ((ecase type (ALERT $Alert) (HANDSHAKE $Handshake)) - data :length u16 :min 1 :max 16383) + data :length rw.wire:u16 :min 1 :max 16383) #+nil - (u8 data :length u16 :min 1 :max 16383 :size t)) + (rw.wire:u8 data :length rw.wire:u16 :min 1 :max 16383 :size t)) ;; struct { ;; HashAlgorithm hash @@ -691,7 +660,7 @@ (assert (zerop m)) (let* ((x (ash n m)) (nbytes (ceiling (log x 256))) - (b (make-octet-buffer nbytes)) + (b (rw.wire:make-octet-buffer nbytes)) (w (rw:writer b))) (loop for i from (1- nbytes) downto 0 @@ -718,7 +687,7 @@ (assert (eq 'ec_diffie_hellman ($ServerKeyExchange-type x))) (let ((x ($ServerKeyExchange-data x))) (let ((x (%$serverecdhparams-params x))) - (let ((b (make-octet-buffer 42))) + (let ((b (rw.wire:make-octet-buffer 42))) (write-$ServerECDHParams (rw:writer b) x) #+nil(print (list :@@@ :params b))) (let ((x ($serverecdhparams-public x))) @@ -750,26 +719,11 @@ (next-$Record (rw:byte-reader s)) #+nil(next-$ClientHello (record-reader (rw:byte-reader s))))) -(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) + (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 @@ -781,7 +735,7 @@ ;; TODO certificate verify ;; change cipher spec <<<<<<<<<<<<<<<<<<<< ;; multiple handshake messages - (flush writer) + (rw.wire:flush writer) (next-$Record reader) ;; expecting alert handshake failure #+nil (list (next-$Record r) ;; new session ticket @@ -791,6 +745,6 @@ (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 (rw:byte-reader s) (rw.wire:packet-writer s)))) ;;(tls-connect "wikipedia.org") diff --git a/wire.lisp b/wire.lisp @@ -25,6 +25,7 @@ (:export :defenum :defstruc :flush + :make-octet-buffer :packet-writer :u8 :u16 @@ -153,7 +154,7 @@ `(let ((r (rw:reader b))) ,(r1)))))) (size - ;;(assert (eq 'u8 ty)) + ;;(assert (eq 'u8 ty)) ;; TODO how? `(loop for i from 0 below ,size collect ,(r1))) (t `(let ((v ,(r1))) @@ -210,7 +211,7 @@ (,(wname length) w l)) (loop for e across b do (write-u8 w e)))) (size - ;;(assert (eq 'u8 ty)) + ;;(assert (eq 'u8 ty)) ;; TODO how? `(let ((v (,(aname name na) x))) ,@ (when (or min max (integerp size)) `((let ((l (length v)))