cl-rw

commit f3aeb18e5e8f222f14a5e667eeff192026045e07
parent caca323bbd0063f75f0d53a1c5c095b4400bb07d
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun,  2 Nov 2014 00:45:41 +0100

understand more dns rdata

Diffstat:
M
dns.lisp
 | 
95
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----------

1 file changed, 82 insertions(+), 13 deletions(-)
diff --git a/dns.lisp b/dns.lisp
@@ -87,7 +87,36 @@
   (assert (= 4 (length x)))
   (map nil (lambda (x) (rw:write-u8 writer x)) x))
 
-(rw.wire:defenum $$resource-type (:nbits 16)
+(defun next-$ipv6-address (reader)
+  (vector (rw:next-u16 reader)
+          (rw:next-u16 reader)
+          (rw:next-u16 reader)
+          (rw:next-u16 reader)
+          (rw:next-u16 reader)
+          (rw:next-u16 reader)
+          (rw:next-u16 reader)
+          (rw:next-u16 reader)))
+
+(defun write-$ipv6-address (writer x)
+  (assert (= 8 (length x)))
+  (map nil (lambda (x) (rw:write-u16 writer x)) x))
+
+(defun octets-to-string (x) ;; TODO refactor
+  (sb-ext:octets-to-string x :external-format :ascii))
+
+(defun string-to-octets (x) ;; TODO refactor
+  (sb-ext:string-to-octets x :external-format :ascii))
+
+(defun next-$dns-string (reader)
+  (octets-to-string
+   (rw:next-octets reader (rw:next-u8 reader))))
+
+(defun write-$dns-string (writer x)
+  (let ((b (string-to-octets x)))
+    (rw:write-u8 writer (length b))
+    (rw:write-octets writer b)))
+
+(rw.wire:defenum $type (:nbits 16)
   (A       . 1)
   (NS      . 2)
   (MD      . 3)
@@ -104,40 +133,79 @@
   (MINFO  . 14)
   (MX     . 15)
   (TXT    . 16)
+  (AAAA   . 28)
   (SRV    . 33)
   (OPT    . 41)
   (IXFR  . 251)
   (AXFR  . 252)
   (MAILB . 253)
   (MAILA . 254)
-  (ALL   . 255))
+  (ANY   . 255))
 
-(rw.wire:defenum $$resource-class (:nbits 16)
-  (IN . 1)
-  (CS . 2)
-  (CH . 3)
-  (HS . 4))
+(rw.wire:defenum $class (:nbits 16)
+  (IN    . 1)
+  (CS    . 2)
+  (CH    . 3)
+  (HS    . 4)
+  (ANY . 255))
 
 (rw.wire:defstruc $question ()
   ($name name)
-  ($$resource-type type)
-  ($$resource-class class))
+  ($type type)
+  ($class class))
+
+(rw.wire:defstruc $hinfo ()
+  ($dns-string cpu)
+  ($dns-string os))
+
+(rw.wire:defstruc $minfo ()
+  ($name rmailbx)
+  ($name emailbx))
 
-(rw.wire:defstruc $mx-rdata ()
+(rw.wire:defstruc $mx ()
   (rw.wire:u16 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.wire:defstruc $srv ()
+  (rw.wire:u16 priority)
+  (rw.wire:u16 weight)
+  (rw.wire:u16 port)
+  ($name target))
+
 (rw.wire:defstruc $resource ()
   ($name name)
-  ($$resource-type type)
-  ($$resource-class class)
+  ($type type)
+  ($class class)
   (rw.wire:u32 ttl)
   #+nil(rw.wire:u8 data :length rw.wire:u16)
   ((ecase type
      (A $ipv4-address)
+     (AAAA $ipv6-address)
      (CNAME $name)
+     (HINFO $hinfo)
+     (MB $name)
+     (MD $name)
+     (MF $name)
+     (MG $name)
+     (MINFO $minfo)
+     (MR $name)
+     (MX $mx)
      (NS $name)
-     (MX $mx-rdata))
+     ;;(NULL) max 65535 octets
+     (PTR $name)
+     (SOA $soa)
+     (SRV $srv)
+     #+nil(TXT $txt) ;; 1+ char-strings
+     #+nil(WKS $wks))
    data :length rw.wire:u16))
 
 (rw.wire:defstruc $message ()
@@ -195,6 +263,7 @@
 ;;(print (udp-query "www.google.com" #(8 8 8 8)))
 
 ;;(print (udp-query "mx1.logand.com" #(8 8 8 8) :type 'NS))
+;;(print (udp-query "www.google.com" #(8 8 8 8) :type 'AAAA))
 
 ;;(print (udp-query "mx1.logand.com" #(8 8 8 8) :type 'MX))
 ;;(print (udp-query "seznam.cz" #(8 8 8 8) :type 'MX))