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:
| M | dns.lisp | | | 40 | ++++++++++++++++++++-------------------- |
| M | rw.lisp | | | 115 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------- |
| M | tls.lisp | | | 99 | ++++++++++++++++++++++++++++++++++++++++--------------------------------------- |
| M | wire.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)))
