commit 700bebacf7e5dd2b820c23d201caca83f25f9f4d
parent bca0e0a6503a41cb85e043d93a604a781807bc35
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 2 Nov 2014 14:17:13 +0100
use wire
Diffstat:
| M | cl-rw.asd | | | 1 | - |
| D | tls-macros.lisp | | | 186 | ------------------------------------------------------------------------------- |
| M | tls.lisp | | | 246 | ++++++++++++++++++++++++++++++++----------------------------------------------- |
| M | wire.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)))
