cl-rw

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

dns.lisp (24863B)


      1 ;;; Copyright (C) 2014 Tomas Hlavaty <tom@logand.com>
      2 ;;;
      3 ;;; Permission is hereby granted, free of charge, to any person
      4 ;;; obtaining a copy of this software and associated documentation
      5 ;;; files (the "Software"), to deal in the Software without
      6 ;;; restriction, including without limitation the rights to use, copy,
      7 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
      8 ;;; of the Software, and to permit persons to whom the Software is
      9 ;;; furnished to do so, subject to the following conditions:
     10 ;;;
     11 ;;; The above copyright notice and this permission notice shall be
     12 ;;; included in all copies or substantial portions of the Software.
     13 ;;;
     14 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
     15 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
     16 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
     17 ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
     18 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
     19 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
     20 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
     21 ;;; DEALINGS IN THE SOFTWARE.
     22 
     23 (defpackage :rw.dns
     24   (:use :cl)
     25   (:export :query))
     26 
     27 (in-package :rw.dns)
     28 
     29 ;;https://www.ietf.org/rfc/rfc1035.txt
     30 ;;https://en.wikipedia.org/wiki/Punycode
     31 ;;https://www.iana.org/domains/root/files
     32 ;;http://www.internic.net/domain/named.root
     33 ;;http://www.internic.net/domain/root.zone
     34 ;;http://www.lifewithdjbdns.org/
     35 
     36 (defvar *name-from-position*)
     37 
     38 (defun next-$name (reader) ;; TODO encoding?
     39   (with-output-to-string (s)
     40     (flet ((next ()
     41              (rw:next-u8 reader)))
     42       (loop
     43          for n = (next)
     44          for i from 0
     45          while (plusp n)
     46          do (progn
     47               (when (plusp i)
     48                 (write-char #\. s))
     49               (cond
     50                 ((< n 64)
     51                  (dotimes (i n)
     52                    (let ((n (next)))
     53                      (assert (<= 1 n 127))
     54                      (write-char (code-char n) s))))
     55                 (t
     56                  (assert (= #xc0 (logand #xc0 n)))
     57                  (write-string
     58                   (funcall
     59                    *name-from-position*
     60                    (logior (ash (logand #x3f n) 8) (next)))
     61                   s)
     62                  (return))))))))
     63 
     64 ;;(next-$name (rw:reader #(3 109 120 49 6 108 111 103 97 110 100 3 99 111 109 0)))
     65 
     66 (defun write-$name (writer x) ;; TODO encoding?
     67   (let ((r (rw:peek-reader (rw:reader x))))
     68     (loop
     69        for y = (rw:till r '(#\.))
     70        for i from 0
     71        while (progn
     72                (rw:next r)
     73                (rw:write-u8 writer (length y))
     74                y)
     75        do (dolist (e y)
     76             (let ((n (char-code e)))
     77               (assert (<= 1 n 127))
     78               (rw:write-u8 writer n))))))
     79 
     80 #+nil
     81 (let ((b (rw.wire::make-octet-buffer 42)))
     82   (write-$name (rw:writer b) "mx1.logand.com")
     83   (values b (next-$name (rw:reader b))))
     84 
     85 (defun next-$ipv4-address (reader)
     86   (rw.socket:make-ipv4-address
     87    (vector (rw:next-u8 reader)
     88            (rw:next-u8 reader)
     89            (rw:next-u8 reader)
     90            (rw:next-u8 reader))))
     91 
     92 (defun write-$ipv4-address (writer x)
     93   (etypecase x
     94     (rw.socket:ipv4-address
     95      (let ((x (#+ccl
     96                rw.socket::ipv4-integer-to-vector
     97                #-ccl
     98                progn
     99                (rw.socket::native-ip-address x))))
    100        (assert (= 4 (length x)))
    101        (map nil (lambda (x) (rw:write-u8 writer x)) x)))))
    102 
    103 (defun next-$ipv6-address (reader)
    104   (rw.socket:make-ipv6-address
    105    (vector (rw:next-u16be reader)
    106            (rw:next-u16be reader)
    107            (rw:next-u16be reader)
    108            (rw:next-u16be reader)
    109            (rw:next-u16be reader)
    110            (rw:next-u16be reader)
    111            (rw:next-u16be reader)
    112            (rw:next-u16be reader))))
    113 
    114 (defun write-$ipv6-address (writer x)
    115   (etypecase x
    116     (rw.socket:ipv6-address
    117      (let ((x (#+ccl
    118                rw.socket::ipv6-integer-to-vector
    119                #-ccl
    120                progn
    121                (rw.socket::native-ip-address x))))
    122        (assert (= 8 (length x)))
    123        (map nil (lambda (x) (rw:write-u16be writer x)) x)))))
    124 
    125 (defun next-$dns-string (reader)
    126   (rw.string:octets-to-string
    127    (rw:next-octets reader (rw:next-u8 reader))
    128    :ascii))
    129 
    130 (defun write-$dns-string (writer x)
    131   (let ((b (rw.string:string-to-octets x :ascii)))
    132     (rw:write-u8 writer (length b))
    133     (rw:write-octets writer b)))
    134 
    135 ;;https://en.wikipedia.org/wiki/List_of_DNS_record_types
    136 (rw.wire:defenum $type (:type rw:u16be)
    137   (A           . 1)
    138   (NS          . 2)
    139   (MD          . 3)
    140   (MF          . 4)
    141   (CNAME       . 5)
    142   (SOA         . 6)
    143   (MB          . 7)
    144   (MG          . 8)
    145   (MR          . 9)
    146   (NULL       . 10)
    147   (WKS        . 11)
    148   (PTR        . 12)
    149   (HINFO      . 13)
    150   (MINFO      . 14)
    151   (MX         . 15)
    152   (TXT        . 16)
    153   (RP         . 17)
    154   (AFSDB      . 18)
    155   (X25        . 19)
    156   (ISDN       . 20)
    157   (RT         . 21)
    158   (NSAP       . 22)
    159   (NSAP-PTR   . 23)
    160   (SIG        . 24)
    161   (KEY        . 25)
    162   (PX         . 26)
    163   (GPOS       . 27)
    164   (AAAA       . 28)
    165   (LOC        . 29)
    166   (NXT        . 30)
    167   (EID        . 31)
    168   (NIMLOC     . 32) ;; was NB
    169   (SRV        . 33) ;; was NBSTAT
    170   (ATMA       . 34)
    171   (NAPTR      . 35)
    172   (KX         . 36)
    173   (CERT       . 37)
    174   (A6         . 38)
    175   (DNAME      . 39)
    176   (SINK       . 40)
    177   (OPT        . 41)
    178   (APL        . 42)
    179   (DS         . 43)
    180   (SSHFP      . 44)
    181   (IPSECKEY   . 45)
    182   (RRSIG      . 46)
    183   (NSEC       . 47)
    184   (DNSKEY     . 48)
    185   (DHCID      . 49)
    186   (NSEC       . 50)
    187   (NSEC3PARAM . 51)
    188   (TLSA       . 52)
    189   (HIP        . 55)
    190   (CDS        . 59)
    191   (CDNSKEY    . 60)
    192   (SPF        . 99)
    193   (UINFO     . 100)
    194   (UID       . 101)
    195   (GID       . 102)
    196   (UNSPEC    . 103)
    197   (TKEY      . 249)
    198   (TSIG      . 250)
    199   (IXFR      . 251)
    200   (AXFR      . 252)
    201   (MAILB     . 253)
    202   (MAILA     . 254)
    203   (*         . 255)
    204   (CAA       . 257)
    205   (TA      . 32768)
    206   (DLV     . 32769))
    207 
    208 (rw.wire:defenum $class (:type rw:u16be)
    209   (IN    . 1)
    210   (CS    . 2)
    211   (CH    . 3)
    212   (HS    . 4)
    213   (ANY . 255))
    214 
    215 (rw.wire:defstruc $question ()
    216   ($name name)
    217   ($type type)
    218   ($class class))
    219 
    220 (rw.wire:defstruc $hinfo ()
    221   ($dns-string cpu)
    222   ($dns-string os))
    223 
    224 (rw.wire:defstruc $minfo ()
    225   ($name rmailbx)
    226   ($name emailbx))
    227 
    228 (rw.wire:defstruc $mx ()
    229   (rw:u16be preference)
    230   ($name name))
    231 
    232 (rw.wire:defstruc $soa ()
    233   ($name mname)
    234   ($name rname)
    235   (rw:u32be serial)
    236   (rw:u32be refresh)
    237   (rw:u32be retry)
    238   (rw:u32be expire)
    239   (rw:u32be minimum))
    240 
    241 (rw.wire:defstruc $srv ()
    242   (rw:u16be priority)
    243   (rw:u16be weight)
    244   (rw:u16be port)
    245   ($name target))
    246 
    247 (rw.wire:defstruc $resource ()
    248   ($name name)
    249   ($type type)
    250   ($class class)
    251   (rw:u32be ttl)
    252   ((ecase type
    253      (A $ipv4-address)
    254      (AAAA $ipv6-address)
    255      (CNAME $name)
    256      (HINFO $hinfo)
    257      (MB $name)
    258      (MD $name)
    259      (MF $name)
    260      (MG $name)
    261      (MINFO $minfo)
    262      (MR $name)
    263      (MX $mx)
    264      (NS $name)
    265      (PTR $name)
    266      (SOA $soa)
    267      (SRV $srv)
    268      ;;(TXT $txt) ;; 1+ char-strings
    269      )
    270    data :length rw:u16be))
    271 
    272 (rw.wire:defstruc $message ()
    273   (rw:u16be tid)
    274   (rw:u16be flags) ;; TODO decode flags
    275   (rw:u16be nquestion)
    276   (rw:u16be nanswer)
    277   (rw:u16be nauthority)
    278   (rw:u16be nadditional)
    279   ($question question :size nquestion)
    280   ($resource answer :size nanswer)
    281   ($resource authority :size nauthority)
    282   ($resource additional :size nadditional))
    283 
    284 (defun udp (buf server port)
    285   (let ((s (rw.socket:make-udp-socket)))
    286     (rw.socket:using-socket
    287      s
    288      (lambda ()
    289        (rw.socket:udp-send s buf (length buf)
    290                            :remote-host server
    291                            :remote-port port)
    292        (let ((n (array-total-size buf)))
    293          (setf (fill-pointer buf) n)
    294          (multiple-value-bind (b len addr) (rw.socket:udp-receive s buf n)
    295            (declare (ignore addr))
    296            ;;(print (list :@@@ (subseq b 0 len)))
    297            (flet ((cb (pos)
    298                     (next-$name (rw:skip (rw:reader b) pos))))
    299              (let ((*name-from-position* #'cb))
    300                (next-$message (rw:shorter-reader (rw:reader b) len))))))))))
    301 
    302 (defun query1 (name server &key (type 'A) (class 'IN) (port 53))
    303   (let* ((n 512) ;; TODO minus IP/UDP headers
    304          (b (rw.wire::make-octet-buffer n)))
    305     (write-$message
    306      (rw:writer b)
    307      (make-$message
    308       :tid #x3141 #+nil(random 65536)
    309       :flags #x100 ;; std query TODO flags
    310       :nquestion 1
    311       :nanswer 0
    312       :nauthority 0
    313       :nadditional 0
    314       :question (list (make-$question :name name :type type :class class))
    315       :answer nil
    316       :authority nil
    317       :additional nil))
    318     (assert (<= (length b) n)) ;; TODO dns over tcp
    319     (udp b server port)))
    320 
    321 ;;(query1 "mx1.logand.com" (rw.socket:make-ipv4-address "8.8.8.8"))
    322 ;;(query1 "seznam.cz" (rw.socket:make-ipv4-address "8.8.8.8"))
    323 ;;(query1 "seznam.cz" (rw.socket:make-ipv4-address "192.168.1.1"))
    324 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "8.8.8.8"))
    325 ;;(query1 "mx1.logand.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'NS)
    326 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'AAAA)
    327 ;;(query1 "mx1.logand.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
    328 ;;(query1 "seznam.cz" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
    329 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
    330 ;;(query1 "com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'A)
    331 ;;(query1 "a.gtld-servers.net" (rw.socket:make-ipv4-address "8.8.8.8") :type 'A)
    332 ;;(query1 "logand.com" (rw.socket:make-ipv4-address "192.5.6.30") :type 'A)
    333 ;;(query1 "uk" (rw.socket:make-ipv4-address "192.5.6.30") :type 'A)
    334 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
    335 ;;(query1 "ns1.google.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'A)
    336 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "216.239.32.10") :type 'MX)
    337 ;;(query1 "google.com" (rw.socket:make-ipv4-address "216.239.32.10") :type 'MX)
    338 ;;(query1 "logand.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
    339 ;;(query1 "mx1.logand.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'A)
    340 ;;(query1 "com" (rw.socket:make-ipv4-address "8.8.8.8"))
    341 
    342 (defvar *cache* (make-hash-table :test #'equal)) ;; TODO locking?
    343 
    344 (defstruct cached time ttl data)
    345 
    346 (defun validp (cached)
    347   (<= (get-universal-time) (+ (cached-time cached) (cached-ttl cached))))
    348 
    349 (defun lookup (name type class)
    350   (let ((k (list name type class))
    351         (n 0)
    352         (i 0))
    353     (dolist (v (gethash k *cache*))
    354       (incf n)
    355       (when (validp v)
    356         (incf i)))
    357     (cond        ;; validp?
    358       ((<= n i)) ;; everything
    359       ((< 0 i)   ;; some
    360        (setf (gethash k *cache*) (delete-if-not 'validp (gethash k *cache*))))
    361       (t ;; none
    362        (remhash k *cache*)))
    363     (mapcar 'cached-data (gethash k *cache*))))
    364 
    365 (defun remember (resource) ;; TODO preserve original ordering?
    366   ;; TODO cca pushnew?
    367   (push (make-cached :time (get-universal-time)
    368                      :ttl ($resource-ttl resource)
    369                      :data ($resource-data resource))
    370         (gethash (list ($resource-name resource)
    371                        ($resource-type resource)
    372                        ($resource-class resource))
    373                  *cache*)))
    374 
    375 (defun reverse-query-name (ip-address)
    376   (etypecase ip-address
    377     (rw.socket:ipv4-address
    378      (with-output-to-string (s)
    379        (loop
    380           with x = (#-ccl
    381                     progn
    382                     #+ccl
    383                     rw.socket::ipv4-integer-to-vector
    384                     (rw.socket::ipv4-address-native ip-address))
    385           for i from 3 downto 0
    386           do (format s "~d." (aref x i)))
    387        (write-string "in-addr.arpa" s)))
    388     (rw.socket:ipv6-address
    389      (with-output-to-string (s)
    390        (loop
    391           with x = (#-ccl
    392                     progn
    393                     #+ccl
    394                     rw.socket::ipv6-integer-to-vector
    395                     (rw.socket::ipv6-address-native ip-address))
    396           for i from 7 downto 0
    397           for e = (aref x i)
    398           do (format s "~(~x.~x.~x.~x.~)"
    399                      (ldb (byte 4 0) e)
    400                      (ldb (byte 4 4) e)
    401                      (ldb (byte 4 8) e)
    402                      (ldb (byte 4 12) e)))
    403        (write-string "ip6.arpa" s)))))
    404 
    405 (defparameter *default-server* :google)
    406 
    407 (defparameter *servers*
    408   `((:opennic ;; http://www.opennicproject.org/ (.bit domains)
    409      ,(rw.socket:make-ipv4-address "192.121.170.170")
    410      ,(rw.socket:make-ipv4-address "179.43.143.69"))
    411     (:opennic-us
    412      ,(rw.socket:make-ipv4-address "107.170.95.180")
    413      ,(rw.socket:make-ipv4-address "75.127.14.107"))
    414     (:opendns
    415      ,(rw.socket:make-ipv4-address "208.67.222.222") ;; resolver1.opendns.com
    416      ,(rw.socket:make-ipv4-address "208.67.220.220") ;; resolver2.opendns.com
    417      ,(rw.socket:make-ipv4-address "208.67.222.220")
    418      ,(rw.socket:make-ipv4-address "208.67.220.222")
    419      ,(rw.socket:make-ipv6-address "2620:0:ccc::2")
    420      ,(rw.socket:make-ipv6-address "2620:0:ccd::2"))
    421     (:google
    422      ,(rw.socket:make-ipv4-address "8.8.8.8")
    423      ,(rw.socket:make-ipv4-address "8.8.4.4")
    424      ,(rw.socket:make-ipv6-address "2001:4860:4860::8888")
    425      ,(rw.socket:make-ipv6-address "2001:4860:4860::8844"))
    426     (:comodo
    427      ,(rw.socket:make-ipv4-address "8.26.56.26")
    428      ,(rw.socket:make-ipv4-address "8.20.247.20"))
    429     (:yandex-basic
    430      ,(rw.socket:make-ipv4-address "77.88.8.8")
    431      ,(rw.socket:make-ipv4-address "77.88.8.1"))
    432     (:yandex-safe
    433      ,(rw.socket:make-ipv4-address "77.88.8.88")
    434      ,(rw.socket:make-ipv4-address "77.88.8.2"))
    435     (:yandex-family
    436      ,(rw.socket:make-ipv4-address "77.88.8.7")
    437      ,(rw.socket:make-ipv4-address "77.88.8.3"))))
    438 
    439 (defun query (name &key (server *default-server*) type (class 'IN) (port 53))
    440   ;;(clrhash *cache*)
    441   ;;(mapc 'remember (parse-named.root "/home/tomas/git/cl-rw/named.root"))
    442   ;;(mapc 'remember (parse-root.zone "/home/tomas/git/cl-rw/root.zone"))
    443   (let ((i 0))
    444     (labels
    445         ((rec (name type server)
    446            (or (lookup name type class)
    447                (let* ((q (query1 name server :type type :class class :port port))
    448                       (answer ($message-answer q))
    449                       (authority ($message-authority q)))
    450                  (incf i)
    451                  (map nil #'remember answer)
    452                  (map nil #'remember authority)
    453                  (map nil #'remember ($message-additional q))
    454                  (cond
    455                    (answer
    456                     (or (lookup name type class)
    457                         (unless (eq 'CNAME type)
    458                           (loop
    459                              for x in (rec name 'CNAME server)
    460                              appending (rec x type server)))))
    461                    (authority
    462                     (dolist (a authority)
    463                       (ecase ($resource-type a)
    464                         (NS
    465                          (dolist (server (rec ($resource-data a) type server))
    466                            (let ((z (rec name type server)))
    467                              (when z
    468                                (return-from rec z)))))
    469                         (SOA (return-from rec nil))))))))))
    470       (values
    471        (rec (etypecase name
    472               (string name)
    473               (rw.socket:ipv4-address
    474                (assert (eq 'PTR type))
    475                (assert (eq 'IN class))
    476                (reverse-query-name name))
    477               (rw.socket:ipv6-address
    478                (assert (eq 'PTR type))
    479                (assert (eq 'IN class))
    480                (reverse-query-name name)))
    481             (or type
    482                 (etypecase name
    483                   (string 'A)
    484                   (rw.socket:ipv4-address 'PTR)
    485                   (rw.socket:ipv6-address 'PTR)))
    486             (etypecase server
    487               (symbol (cadr (assoc server *servers*)))
    488               (rw.socket:ipv4-address server)
    489               (rw.socket:ipv6-address server)))
    490        i))))
    491 
    492 ;;(query "logand.com" :type 'MX)
    493 ;;(query "mx1.logand.com")
    494 ;;(query "mx1.logand.com" :type 'CNAME)
    495 ;;(query "logand.com" :type 'SOA)
    496 ;;(query "google.com" :type 'AAAA)
    497 ;;(query "google.com")
    498 ;;(query "google.com" :type 'MX)
    499 ;;(query "google.com" :type 'NS)
    500 ;;(query "google.com" :type 'SOA)
    501 ;;(query "google.com" :type 'TXT)
    502 ;;(query "google.com" :type 'CNAME)
    503 ;;(query "mx1.logand.com" :type 'AAAA)
    504 ;;(query "google.com" :type 'TXT)
    505 ;;(query "google.com" :server (rw.socket:make-ipv4-address "198.41.0.4"))
    506 ;;(query "mx1.logand.com" :server (rw.socket:make-ipv4-address "198.41.0.4")) ;;;;;;;;;;;;; 7x
    507 ;;(query "google.com" :type 'RRSIG)
    508 ;;(query "google.com" :type 'DS)
    509 ;;(query "8.8.8.8.in-addr.arpa." :type 'PTR)
    510 ;;(query "8.8.8.8.in-addr.arpa" :type 'PTR)
    511 ;;(query ".ip6.arpa" :type 'PTR)
    512 ;;(query "8.70.192.82.in-addr.arpa" :type 'PTR)
    513 ;;(query (rw.socket:make-ipv4-address "82.192.70.8"))
    514 ;;(query (rw.socket:make-ipv6-address #(10752 5200 16392 2049 0 0 0 4110)))
    515 ;;(query "ber01s09-in-x0e.1e100.net" :type 'AAAA)
    516 ;;(query "google.com" :type 'AAAA)
    517 ;;(query (rw.socket:make-ipv4-address "94.242.206.239"))
    518 ;;(query (rw.socket:make-ipv4-address "107.191.45.22"))
    519 ;;(query "cr.yp.to")
    520 ;;(query "cr.yp.to" :type 'MX)
    521 ;;(query "yp.to" :type 'NS)
    522 ;;(query "cr.yp.to" :server (rw.socket:make-ipv4-address "208.67.222.222"))
    523 ;;(query "c64games.bit" :server :opennic)
    524 
    525 ;;(query "google.com" :type 'ANY)
    526 ;;(query "logand.com" :type 'ANY)
    527 
    528 ;;http://technet.microsoft.com/en-us/library/cc758353(v=ws.10).aspx
    529 (defun parse-named.root-line (line)
    530   (let ((r (rw:peek-reader (rw:reader line))))
    531     (flet ((str ()
    532              (coerce (rw:till r '(#\space #\tab #\newline #\return))
    533                      'string)))
    534       (let ((name (str))
    535             (ttl (progn
    536                    (rw:skip r)
    537                    (rw:next-z0 r)))
    538             (type (progn
    539                     (rw:skip r)
    540                     (let ((x (str)))
    541                       (cond
    542                         ((equal x "A") 'A)
    543                         ((equal x "AAAA") 'AAAA)
    544                         ((equal x "NS") 'NS)
    545                         (t (error "unexpected record ~x ~s" x line))))))
    546             (detail (progn
    547                       (rw:skip r)
    548                       (coerce (rw:till r '(#\newline #\return)) 'string))))
    549         (make-$resource :name name
    550                         :type type
    551                         :class 'IN
    552                         :ttl ttl
    553                         :data (ecase type
    554                                 (A (rw.socket:make-ipv4-address detail))
    555                                 (AAAA (rw.socket:make-ipv6-address detail))
    556                                 (NS detail)))))))
    557 
    558 (defun parse-named.root (pathname)
    559   (with-open-file (s pathname)
    560     (loop
    561        for line = nil
    562        while (setq line (read-line s nil))
    563        unless (eql #\; (char line 0))
    564        collect (parse-named.root-line line))))
    565 
    566 (defun parse-root.zone-line (line)
    567   (let ((r (rw:peek-reader (rw:reader line))))
    568     (flet ((str (r)
    569              (coerce (rw:till r '(#\space #\tab #\newline #\return))
    570                      'string)))
    571       (let ((name (str r))
    572             (ttl (progn
    573                    (rw:skip r)
    574                    (rw:next-z0 r)))
    575             (class (progn
    576                      (rw:skip r)
    577                      (let ((x (str r)))
    578                        (cond
    579                          ((equal x "IN") 'IN)
    580                          (t (error "unexpected record ~x ~s" x line))))))
    581             (type (progn
    582                     (rw:skip r)
    583                     (let ((x (str r)))
    584                       (cond
    585                         ((equal x "A") 'A)
    586                         ((equal x "AAAA") 'AAAA)
    587                         ((equal x "NS") 'NS)
    588                         ((equal x "SOA") 'SOA)
    589                         ((equal x "RRSIG") 'RRSIG)
    590                         ((equal x "DNSKEY") 'DNSKEY)
    591                         ((equal x "NSEC") 'NSEC)
    592                         ((equal x "DS") 'DS)
    593                         (t (error "unexpected record ~s ~s" x line))))))
    594             (detail (progn
    595                       (rw:skip r)
    596                       (coerce (rw:till r '(#\newline #\return)) 'string))))
    597         (make-$resource :name name
    598                         :type type
    599                         :class class
    600                         :ttl ttl
    601                         :data (ecase type
    602                                 (A (rw.socket:make-ipv4-address detail))
    603                                 (AAAA (rw.socket:make-ipv6-address detail))
    604                                 (NS detail)
    605                                 (SOA
    606                                  (let ((r (rw:peek-reader (rw:reader detail))))
    607                                    (make-$soa :mname (str r)
    608                                               :rname (progn
    609                                                        (rw:skip r)
    610                                                        (str r))
    611                                               :serial (progn
    612                                                         (rw:skip r)
    613                                                         (rw:next-z0 r))
    614                                               :refresh (progn
    615                                                          (rw:skip r)
    616                                                          (rw:next-z0 r))
    617                                               :retry (progn
    618                                                        (rw:skip r)
    619                                                        (rw:next-z0 r))
    620                                               :expire (progn
    621                                                         (rw:skip r)
    622                                                         (rw:next-z0 r))
    623                                               :minimum (progn
    624                                                          (rw:skip r)
    625                                                          (rw:next-z0 r)))))
    626                                 (RRSIG ;; TODO
    627                                  ;;(error "TODO rrsig ~s" detail)
    628                                  ;;"SOA 8 0 86400 20141220170000 20141213160000 22603 . EijJa8A2FUTsamqOXCg+k+CTRlAP+ban3iNJifmnEGZCy6PokdOkAj6q8vmoOdvpbLIDNn075KbXT6AFEYyRPh3espFzOBbhF2lonpb0d5rOc8hqH9wKYYbza1YkOh19Q+SNQGYllQCVnHNRvDtKL8bUhs2+gf+QpXiBB7Q4llk="
    629                                  #+nil(make-$rrsig ))
    630                                 (DNSKEY ;; TODO
    631                                  ;;(error "TODO dnskey ~s" detail)
    632                                  ;;"256 3 8 AwEAAaPD7Y7XIi1MOEREJNTrRhyqsY3gff6JWzg+XCbqut1sbcbvqyssHw8DT1AkRaAC92pO8xuyq5QEgEPL1IHfABLwpwXI5gTj4gdwi86bpkmlWs9fRpnn4DPDCTdrnxIejJXgClHikLJF3u3CdpNCMijq4CKdQbMlRZ3avv+G7rh7"
    633                                  #+nil(make-$dnskey ))
    634                                 (NSEC ;; TODO
    635                                  ;;(error "TODO nsec ~s" detail)
    636                                  ;;"abogado. NS SOA RRSIG NSEC DNSKEY"
    637                                  #+nil(make-$nsec ))
    638                                 (DS ;; TODO
    639                                  ;;(error "TODO ds ~s" detail)
    640                                  ;;"57005 8 2 2009CA303DBEED162EE4BA3F255B2DB5C11FAF26A90804C06F9D8C54BFD6F02E"
    641                                  #+nil(make-$ds ))))))))
    642 
    643 (defun parse-root.zone (pathname)
    644   (with-open-file (s pathname)
    645     (loop
    646        for line = nil
    647        while (setq line (read-line s nil))
    648        unless (eql #\; (char line 0))
    649        collect (parse-root.zone-line line))))
    650 
    651 (defun parse-/etc/hosts-line (x)
    652   (let ((r (rw:peek-reader (rw:reader x))))
    653     (flet ((str ()
    654              (rw:skip r)
    655              (coerce (rw:till r '(#\space #\tab #\newline #\return))
    656                      'string)))
    657       (let ((ip (let ((x (str)))
    658                   (if (find #\: x)
    659                       (rw.socket:make-ipv6-address x)
    660                       (rw.socket:make-ipv4-address x)))))
    661         (loop
    662            while (rw:peek r)
    663            collect (make-$resource
    664                     :name (str)
    665                     :type (etypecase ip
    666                             (rw.socket:ipv4-address 'A)
    667                             (rw.socket:ipv6-address 'AAAA))
    668                     :class 'IN
    669                     :ttl 3600 ;; TODO something else?
    670                     :data ip))))))
    671 
    672 (defun parse-/etc/hosts (&optional (pathname "/etc/hosts"))
    673   (with-open-file (s pathname)
    674     (loop
    675        for line = nil
    676        while (setq line (read-line s nil))
    677        when (and (plusp (length line))
    678                  (not (eql #\# (char line 0))))
    679        appending (parse-/etc/hosts-line line))))
    680 
    681 ;;(car (parse-/etc/hosts))
    682 
    683 #+nil ;; TODO dns over tcp doesnt seem to work, depends on server?
    684 (defun tcp-query (name server &key (port 53))
    685   (with-open-stream (s (rw.socket:make-tcp-client-socket server port))
    686     (let ((w (rw.wire:packet-writer s)))
    687       (write-dns-question-packet w name)
    688       (rw.wire:flush w)
    689       (rw:next-u8 (rw:byte-reader s)))))
    690