cl-rw

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

commit ed055f88e82498a15a60ed42ada7a48f905b146c
parent 35980a88b773e09e9ab64afbee3161ec3424edec
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun,  7 Dec 2014 17:05:40 +0100

deal with little and big endian

Diffstat:
Mdns.lisp | 40++++++++++++++++++++--------------------
Mrw.lisp | 115++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------
Mtls.lisp | 99++++++++++++++++++++++++++++++++++++++++---------------------------------------
Mwire.lisp | 56++++++++++----------------------------------------------
4 files changed, 185 insertions(+), 125 deletions(-)

diff --git a/dns.lisp b/dns.lisp @@ -111,7 +111,7 @@ (rw:write-u8 writer (length b)) (rw:write-octets writer b))) -(rw.wire:defenum $type (:nbits 16) +(rw.wire:defenum $type (:type rw:u16be) (A . 1) (NS . 2) (MD . 3) @@ -137,7 +137,7 @@ (MAILA . 254) (ANY . 255)) -(rw.wire:defenum $class (:nbits 16) +(rw.wire:defenum $class (:type rw:u16be) (IN . 1) (CS . 2) (CH . 3) @@ -158,30 +158,30 @@ ($name emailbx)) (rw.wire:defstruc $mx () - (rw.wire:u16 preference) + (rw:u16be preference) ($name name)) (rw.wire:defstruc $soa () ($name mname) ($name rname) - (rw.wire:u32 serial) - (rw.wire:u32 refresh) - (rw.wire:u32 retry) - (rw.wire:u32 expire) - (rw.wire:u32 minimum)) + (rw:u32be serial) + (rw:u32be refresh) + (rw:u32be retry) + (rw:u32be expire) + (rw:u32be minimum)) (rw.wire:defstruc $srv () - (rw.wire:u16 priority) - (rw.wire:u16 weight) - (rw.wire:u16 port) + (rw:u16be priority) + (rw:u16be weight) + (rw:u16be port) ($name target)) (rw.wire:defstruc $resource () ($name name) ($type type) ($class class) - (rw.wire:u32 ttl) - #+nil(rw.wire:u8 data :length rw.wire:u16) + (rw:u32be ttl) + #+nil(rw:u8 data :length rw:u16be) ((ecase type (A $ipv4-address) (AAAA $ipv6-address) @@ -201,15 +201,15 @@ (SRV $srv) #+nil(TXT $txt) ;; 1+ char-strings #+nil(WKS $wks)) - data :length rw.wire:u16)) + data :length rw:u16be)) (rw.wire:defstruc $message () - (rw.wire:u16 tid) - (rw.wire:u16 flags) - (rw.wire:u16 nquestion) - (rw.wire:u16 nanswer) - (rw.wire:u16 nauthority) - (rw.wire:u16 nadditional) + (rw:u16be tid) + (rw:u16be flags) + (rw:u16be nquestion) + (rw:u16be nanswer) + (rw:u16be nauthority) + (rw:u16be nadditional) ($question question :size nquestion) ($resource answer :size nanswer) ($resource authority :size nauthority) diff --git a/rw.lisp b/rw.lisp @@ -22,7 +22,8 @@ (defpackage :rw (:use :cl) - (:export :byte-reader + (:export :*endian* + :byte-reader :byte-writer :char-reader :char-writer @@ -33,8 +34,14 @@ :next :next-octets :next-u16 + :next-u16be + :next-u16le :next-u24 + :next-u24be + :next-u24le :next-u32 + :next-u32be + :next-u32le :next-u8 :next-z0 :peek @@ -45,11 +52,28 @@ :skip :slurp :till + :u8 + :u16 + :u16be + :u16le + :u24 + :u24be + :u24le + :u32 + :u32be + :u32le :wrap-reader :wrap-writer :write-octets :write-u16 + :write-u16be + :write-u16le + :write-u24 + :write-u24be + :write-u24le :write-u32 + :write-u32be + :write-u32le :write-u8 :writer)) @@ -234,22 +258,56 @@ (assert (<= 0 x 255)) x)) -(defun next-u16 (reader) ;; TODO little endian +(defparameter *endian* (or (find :little-endian *features*) + (find :big-endian *features*))) + +(defun next-u16be (reader) (let? x (next-u8 reader) (let? y (next-u8 reader) (logior (ash x 8) y)))) -(defun next-u24 (reader) ;; TODO little endian +(defun next-u16le (reader) + (let? x (next-u8 reader) + (let? y (next-u8 reader) + (logior (ash y 8) x)))) + +(defun next-u16 (reader) + (ecase *endian* + (:big-endian (next-u16be reader)) + (:little-endian (next-u16le reader)))) + +(defun next-u24be (reader) (let? x (next-u8 reader) (let? y (next-u8 reader) (let? z (next-u8 reader) (logior (ash x 16) (ash y 8) z))))) -(defun next-u32 (reader) ;; TODO little endian - (let? x (next-u16 reader) - (let? y (next-u16 reader) +(defun next-u24le (reader) + (let? x (next-u8 reader) + (let? y (next-u8 reader) + (let? z (next-u8 reader) + (logior (ash z 16) (ash y 8) x))))) + +(defun next-u24 (reader) + (ecase *endian* + (:big-endian (next-u24be reader)) + (:little-endian (next-u24le reader)))) + +(defun next-u32be (reader) + (let? x (next-u16be reader) + (let? y (next-u16be reader) (logior (ash x 16) y)))) +(defun next-u32le (reader) + (let? x (next-u16le reader) + (let? y (next-u16le reader) + (logior (ash y 16) x)))) + +(defun next-u32 (reader) + (ecase *endian* + (:big-endian (next-u32be reader)) + (:little-endian (next-u32le reader)))) + (defun next-octets (reader n) (let ((z (make-array n :element-type '(unsigned-byte 8) @@ -290,15 +348,52 @@ (assert (<= 0 x 255)) (funcall writer x)) -(defun write-u16 (writer x) ;; TODO little endian +(defun write-u16be (writer x) (assert (<= 0 x 65535)) (write-u8 writer (ash x -8)) (write-u8 writer (logand #xff x))) -(defun write-u32 (writer x) ;; TODO little endian +(defun write-u16le (writer x) + (assert (<= 0 x 65535)) + (write-u8 writer (logand #xff x)) + (write-u8 writer (ash x -8))) + +(defun write-u16 (writer x) + (ecase *endian* + (:big-endian (write-u16be writer x)) + (:little-endian (write-u16le writer x)))) + +(defun write-u24be (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-u24le (writer x) + (assert (<= 0 x #.(1- (expt 2 24)))) + (write-u8 writer (logand #xff x)) + (write-u8 writer (logand #xff (ash x -8))) + (write-u8 writer (ash x -16))) + +(defun write-u24 (writer x) + (ecase *endian* + (:big-endian (write-u24be writer x)) + (:little-endian (write-u24le writer x)))) + +(defun write-u32be (writer x) (assert (<= 0 x #.(1- (expt 2 32)))) - (write-u16 writer (ash x -16)) - (write-u16 writer (logand #xffff x))) + (write-u16be writer (ash x -16)) + (write-u16be writer (logand #xffff x))) + +(defun write-u32le (writer x) + (assert (<= 0 x #.(1- (expt 2 32)))) + (write-u16le writer (logand #xffff x)) + (write-u16le writer (ash x -16))) + +(defun write-u32 (writer x) + (ecase *endian* + (:big-endian (write-u32be writer x)) + (:little-endian (write-u32le writer x)))) (defun copy (reader writer) (do (x) diff --git a/tls.lisp b/tls.lisp @@ -34,11 +34,11 @@ ;; https://tools.ietf.org/html/rfc5246 ;; https://tools.ietf.org/html/rfc4492 -(rw.wire:defenum $AlertLevel (:nbits 8) +(rw.wire:defenum $AlertLevel (:type rw:u8) (WARNING . 1) (FATAL . 2)) -(rw.wire:defenum $AlertDescription (:nbits 8) +(rw.wire:defenum $AlertDescription (:type rw:u8) (CLOSE_NOTIFY . 0) (UNEXPECTED_MESSAGE . 10) (BAD_RECORD_MAC . 20) @@ -65,7 +65,7 @@ (NO_RENEGOTIATION . 100) (UNSUPPORTED_EXTENSION . 110)) -(rw.wire:defenum $CipherSuite (:nbits 16) +(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) @@ -153,7 +153,7 @@ (TLS_RSA_WITH_RC4_128_MD5 . #X0004) (TLS_RSA_WITH_RC4_128_SHA . #X0005)) -(rw.wire:defenum $ClientCertificateType (:nbits 8) +(rw.wire:defenum $ClientCertificateType (:type rw:u8) (rsa_sign . 1) (dss_sign . 2) (rsa_fixed_dh . 3) @@ -162,20 +162,20 @@ (dss_ephemeral_dh_RESERVED . 6) (fortezza_dms_RESERVED . 20)) -(rw.wire:defenum $CompressionMethod (:nbits 8) +(rw.wire:defenum $CompressionMethod (:type rw:u8) (null . 0)) -(rw.wire:defenum $ContentType (:nbits 8) +(rw.wire:defenum $ContentType (:type rw:u8) (CHANGE_CIPHER_SPEC . 20) (ALERT . 21) (HANDSHAKE . 22) (APPLICATION_DATA . 23)) -(rw.wire:defenum $ContentVersion (:nbits 16) +(rw.wire:defenum $ContentVersion (:type rw:u16be) (SSL3.0 . #x0300) (TLS1.2 . #x0303)) -(rw.wire:defenum $ExtensionType (:nbits 16) +(rw.wire:defenum $ExtensionType (:type rw:u16be) (ec_point_formats . #x000b) (elliptic_curves . #x000a) (renegotiation_info . #xff01) @@ -184,7 +184,7 @@ (signature_algorithms . #x000d) (status_request . #x0005)) -(rw.wire:defenum $HandshakeType (:nbits 8) +(rw.wire:defenum $HandshakeType (:type rw:u8) (HELLO_REQUEST . 0) (CLIENT_HELLO . 1) (SERVER_HELLO . 2) @@ -196,7 +196,7 @@ (CLIENT_KEY_EXCHANGE . 16) (FINISHED . 20)) -(rw.wire:defenum $HashAlgorithm (:nbits 8) +(rw.wire:defenum $HashAlgorithm (:type rw:u8) (none . 0) (md5 . 1) (sha1 . 2) @@ -205,13 +205,13 @@ (sha384 . 5) (sha512 . 6)) -(rw.wire:defenum $ECCurveType (:nbits 8) +(rw.wire:defenum $ECCurveType (:type rw:u8) (explicit_prime . 1) (explicit_char2 . 2) (named_curve . 3) #+nil(reserved 248..255)) -(rw.wire:defenum $NamedCurve (:nbits 16) +(rw.wire:defenum $NamedCurve (:type rw:u16be) (sect163k1 . 1) (sect163r1 . 2) (sect163r2 . 3) @@ -241,10 +241,10 @@ (arbitrary_explicit_prime_curves . #xff01) (arbitrary_explicit_char2_curves . #xff02)) -(rw.wire:defenum %$SignatureHashAlgorithmSignature (:nbits 8) +(rw.wire:defenum %$SignatureHashAlgorithmSignature (:type rw:u8) (rsa . 1)) -(rw.wire:defenum $ECPointFormat (:nbits 8) +(rw.wire:defenum $ECPointFormat (:type rw:u8) (uncompressed . 0) (ansiX962_compressed_prime . 1) (ansiX962_compressed_char2 . 2) @@ -258,7 +258,7 @@ ;;'ecdhe_rsa 'ec_diffie_hellman) -;; (rw.wire:defenum $KeyExchangeAlgorithm (:nbits 8) +;; (rw.wire:defenum $KeyExchangeAlgorithm (:type rw:u8) ;; (dhe_dss . 0) ;; (dhe_rsa . 1) ;; (dh_anon . 2) @@ -288,20 +288,20 @@ #+nil (rw.wire:defstruc $ASN.1Cert () - (rw.wire:u8 data :min 0 :max #.(1- (expt 2 24)))) + (rw:u8 data :min 0 :max #.(1- (expt 2 24)))) (rw.wire:defstruc %$Certificate () - (rw.wire:u8 #+nil $ASN.1Cert data :length rw.wire:u24 :min 0 :max #.(1- (expt 2 24))) + (rw:u8 #+nil $ASN.1Cert data :length rw:u24be :min 0 :max #.(1- (expt 2 24))) (rw.wire::computed der :next (rw.der:decode (rw:reader data)))) (rw.wire:defstruc $Certificate () - (%$Certificate list :length rw.wire:u24 :min 0 :max #.(1- (expt 2 24)) :size t)) + (%$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.wire:u8 :min 1 :size t)) + ($ECPointFormat ec_point_format_list :length rw:u8 :min 1 :size t)) (rw.wire:defstruc $ECPointFormatList () - (%$ECPointFormatList data :length rw.wire:u16)) + (%$ECPointFormatList data :length rw:u16be)) (rw.wire:defstruc $Extension () ($ExtensionType type) @@ -314,24 +314,24 @@ (ec_point_formats $ECPointFormatList) #+nil(signature_algorithms)) data) - #+nil(rw.wire:u8 data :length rw.wire:u16 :min 0 :max #.(1- (expt 2 16)) :size t)) + #+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.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)) + ($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.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: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.wire:u8 client_random :size 32) - (rw.wire:u8 server_random :size 32) + (rw:u8 client_random :size 32) + (rw:u8 server_random :size 32) ($ServerDHParams params2)) (rw.wire:defstruc %$ServerDHParams () @@ -339,17 +339,18 @@ ($signed_params signed_params)) (rw.wire:defstruc $ECCurve () - (rw.wire:u8 a :length rw.wire:u8 :min 1) - (rw.wire:u8 b :length rw.wire:u8 :min 1)) + (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.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: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.wire:u8 x :size (floor length 2)) - (rw.wire:u8 y :size (floor length 2))) + (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> @@ -392,8 +393,8 @@ (rw.wire:defstruc %$ECSASignature () ;; digitally-signed (%$SignatureHashAlgorithm algorithm) - (rw.wire:u16 length #+nil :compute #+nil(ShaSize)) - (rw.wire:u8 sha_hash :size length)) + (rw:u16be length #+nil :compute #+nil(ShaSize)) + (rw:u8 sha_hash :size length)) (rw.wire:defstruc $Signature () (rw.wire::computed algorithm :compute (SignatureAlgorithm)) @@ -406,7 +407,7 @@ ($Signature signed_params)) (rw.wire:defstruc $ServerKeyExchange () - ;;(rw.wire:u8 data :length rw.wire:u16 :min 1 :max #.(1- (expt 2 16))) + ;;(rw:u8 data :length rw:u16be :min 1 :max #.(1- (expt 2 16))) (rw.wire::computed type :compute (KeyExchangeAlgorithm)) ((ecase type ;;(dh_anon $ServerDHParams) @@ -416,11 +417,11 @@ data)) (rw.wire:defstruc $SessionID () - (rw.wire:u8 data :length rw.wire:u8 :min 0 :max 32 :size t)) + (rw:u8 data :length rw:u8 :min 0 :max 32 :size t)) (rw.wire:defstruc $Random () - (rw.wire:u32 gmt_unix_time) - (rw.wire:u8 random_bytes :size 28)) + (rw:u32be gmt_unix_time) + (rw:u8 random_bytes :size 28)) (rw.wire:defstruc $ServerHello () ($ContentVersion #+nil ProtocolVersion version) @@ -428,10 +429,10 @@ ($SessionID session_id) ($CipherSuite cipher_suite) ($CompressionMethod compression_method) - ($Extension extensions :length rw.wire:u16 :min 0 :max #.(1- (expt 2 16)) :size t)) + ($Extension extensions :length rw:u16be :min 0 :max #.(1- (expt 2 16)) :size t)) (rw.wire:defstruc $dh_Yc () - (rw.wire:u8 data :length rw.wire:u16 :min 1 :max #.(1- (expt 2 16)))) + (rw:u8 data :length rw:u16be :min 1 :max #.(1- (expt 2 16)))) (rw.wire:defstruc $EncryptedPreMasterSecret () ($PreMasterSecret pubkey_encrypted)) @@ -467,21 +468,21 @@ (SERVER_HELLO $ServerHello) (SERVER_HELLO_DONE) (SERVER_KEY_EXCHANGE $ServerKeyExchange)) - data :length rw.wire:u24)) + data :length rw:u24be)) (rw.wire:defstruc $PreMasterSecret () ($ContentVersion #+nil ProtocolVersion client_version) - (rw.wire:u8 random :size 46)) + (rw:u8 random :size 46)) (rw.wire:defstruc $Record () ($ContentType type) - (rw.wire:u16 #+nil ContentVersion version) + (rw:u16be #+nil ContentVersion version) ((ecase type (ALERT $Alert) (HANDSHAKE $Handshake)) - data :length rw.wire:u16 :min 1 :max 16383) + data :length rw:u16be :min 1 :max 16383) #+nil - (rw.wire:u8 data :length rw.wire:u16 :min 1 :max 16383 :size t)) + (rw:u8 data :length rw:u16be :min 1 :max 16383 :size t)) ;; struct { ;; HashAlgorithm hash diff --git a/wire.lisp b/wire.lisp @@ -26,11 +26,7 @@ :defstruc :flush :make-octet-buffer - :packet-writer - :u8 - :u16 - :u24 - :u32)) + :packet-writer)) (in-package :rw.wire) @@ -43,33 +39,6 @@ :adjustable t :fill-pointer 0)) -(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 %intern (pre x post) (intern (format nil "~a~a~a" pre x post) (symbol-package x))) @@ -85,7 +54,7 @@ (defun wname (x) (%intern "WRITE-" x "")) -(defmacro defenum (name (&key nbits) &body alist) +(defmacro defenum (name (&key type) &body alist) (let ((fname (fname name)) (sname (%intern "" name "-SYMBOLS")) (cname (%intern "" name "-CODES")) @@ -101,20 +70,15 @@ (defun ,sname () symbols) (defun ,cname () codes) (defun ,rname (reader) - (let ((z (,fname (, (ecase nbits - (8 'rw:next-u8) - (16 'rw:next-u16)) - reader)))) + (let ((z (,fname (,(rname type) 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)))))))) + (,(wname type) + writer + (etypecase x + (symbol (,fname x)) + (integer (when (member x codes) x)))))))) (defun aname (struc &optional slot) (intern (format nil "~a-~a" struc slot) (symbol-package struc))) @@ -143,7 +107,7 @@ ,@(when max `((assert (<= l ,max)))) ,@(when (integerp size) `((assert (= l ,size)))) (dotimes (i l) - (vector-push-extend (next-u8 r) b)) + (vector-push-extend (rw:next-u8 r) b)) ,(if (eq 'u8 ty) 'b (if size @@ -209,7 +173,7 @@ ,@(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)))) + (loop for e across b do (rw:write-u8 w e)))) (size ;;(assert (eq 'u8 ty)) ;; TODO how? `(let ((v (,(aname name na) x)))