cl-rw

dns.lisp (24863B)

---

 ;;; 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.dns
   (:use :cl)
   (:export :query))
 
 (in-package :rw.dns)
 
 ;;https://www.ietf.org/rfc/rfc1035.txt
 ;;https://en.wikipedia.org/wiki/Punycode
 ;;https://www.iana.org/domains/root/files
 ;;http://www.internic.net/domain/named.root
 ;;http://www.internic.net/domain/root.zone
 ;;http://www.lifewithdjbdns.org/
 
 (defvar *name-from-position*)
 
 (defun next-$name (reader) ;; TODO encoding?
   (with-output-to-string (s)
     (flet ((next ()
              (rw:next-u8 reader)))
       (loop
          for n = (next)
          for i from 0
          while (plusp n)
          do (progn
               (when (plusp i)
                 (write-char #\. s))
               (cond
                 ((< n 64)
                  (dotimes (i n)
                    (let ((n (next)))
                      (assert (<= 1 n 127))
                      (write-char (code-char n) s))))
                 (t
                  (assert (= #xc0 (logand #xc0 n)))
                  (write-string
                   (funcall
                    *name-from-position*
                    (logior (ash (logand #x3f n) 8) (next)))
                   s)
                  (return))))))))
 
 ;;(next-$name (rw:reader #(3 109 120 49 6 108 111 103 97 110 100 3 99 111 109 0)))
 
 (defun write-$name (writer x) ;; TODO encoding?
   (let ((r (rw:peek-reader (rw:reader x))))
     (loop
        for y = (rw:till r '(#\.))
        for i from 0
        while (progn
                (rw:next r)
                (rw:write-u8 writer (length y))
                y)
        do (dolist (e y)
             (let ((n (char-code e)))
               (assert (<= 1 n 127))
               (rw:write-u8 writer n))))))
 
 #+nil
 (let ((b (rw.wire::make-octet-buffer 42)))
   (write-$name (rw:writer b) "mx1.logand.com")
   (values b (next-$name (rw:reader b))))
 
 (defun next-$ipv4-address (reader)
   (rw.socket:make-ipv4-address
    (vector (rw:next-u8 reader)
            (rw:next-u8 reader)
            (rw:next-u8 reader)
            (rw:next-u8 reader))))
 
 (defun write-$ipv4-address (writer x)
   (etypecase x
     (rw.socket:ipv4-address
      (let ((x (#+ccl
                rw.socket::ipv4-integer-to-vector
                #-ccl
                progn
                (rw.socket::native-ip-address x))))
        (assert (= 4 (length x)))
        (map nil (lambda (x) (rw:write-u8 writer x)) x)))))
 
 (defun next-$ipv6-address (reader)
   (rw.socket:make-ipv6-address
    (vector (rw:next-u16be reader)
            (rw:next-u16be reader)
            (rw:next-u16be reader)
            (rw:next-u16be reader)
            (rw:next-u16be reader)
            (rw:next-u16be reader)
            (rw:next-u16be reader)
            (rw:next-u16be reader))))
 
 (defun write-$ipv6-address (writer x)
   (etypecase x
     (rw.socket:ipv6-address
      (let ((x (#+ccl
                rw.socket::ipv6-integer-to-vector
                #-ccl
                progn
                (rw.socket::native-ip-address x))))
        (assert (= 8 (length x)))
        (map nil (lambda (x) (rw:write-u16be writer x)) x)))))
 
 (defun next-$dns-string (reader)
   (rw.string:octets-to-string
    (rw:next-octets reader (rw:next-u8 reader))
    :ascii))
 
 (defun write-$dns-string (writer x)
   (let ((b (rw.string:string-to-octets x :ascii)))
     (rw:write-u8 writer (length b))
     (rw:write-octets writer b)))
 
 ;;https://en.wikipedia.org/wiki/List_of_DNS_record_types
 (rw.wire:defenum $type (:type rw:u16be)
   (A           . 1)
   (NS          . 2)
   (MD          . 3)
   (MF          . 4)
   (CNAME       . 5)
   (SOA         . 6)
   (MB          . 7)
   (MG          . 8)
   (MR          . 9)
   (NULL       . 10)
   (WKS        . 11)
   (PTR        . 12)
   (HINFO      . 13)
   (MINFO      . 14)
   (MX         . 15)
   (TXT        . 16)
   (RP         . 17)
   (AFSDB      . 18)
   (X25        . 19)
   (ISDN       . 20)
   (RT         . 21)
   (NSAP       . 22)
   (NSAP-PTR   . 23)
   (SIG        . 24)
   (KEY        . 25)
   (PX         . 26)
   (GPOS       . 27)
   (AAAA       . 28)
   (LOC        . 29)
   (NXT        . 30)
   (EID        . 31)
   (NIMLOC     . 32) ;; was NB
   (SRV        . 33) ;; was NBSTAT
   (ATMA       . 34)
   (NAPTR      . 35)
   (KX         . 36)
   (CERT       . 37)
   (A6         . 38)
   (DNAME      . 39)
   (SINK       . 40)
   (OPT        . 41)
   (APL        . 42)
   (DS         . 43)
   (SSHFP      . 44)
   (IPSECKEY   . 45)
   (RRSIG      . 46)
   (NSEC       . 47)
   (DNSKEY     . 48)
   (DHCID      . 49)
   (NSEC       . 50)
   (NSEC3PARAM . 51)
   (TLSA       . 52)
   (HIP        . 55)
   (CDS        . 59)
   (CDNSKEY    . 60)
   (SPF        . 99)
   (UINFO     . 100)
   (UID       . 101)
   (GID       . 102)
   (UNSPEC    . 103)
   (TKEY      . 249)
   (TSIG      . 250)
   (IXFR      . 251)
   (AXFR      . 252)
   (MAILB     . 253)
   (MAILA     . 254)
   (*         . 255)
   (CAA       . 257)
   (TA      . 32768)
   (DLV     . 32769))
 
 (rw.wire:defenum $class (:type rw:u16be)
   (IN    . 1)
   (CS    . 2)
   (CH    . 3)
   (HS    . 4)
   (ANY . 255))
 
 (rw.wire:defstruc $question ()
   ($name name)
   ($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 ()
   (rw:u16be preference)
   ($name name))
 
 (rw.wire:defstruc $soa ()
   ($name mname)
   ($name rname)
   (rw:u32be serial)
   (rw:u32be refresh)
   (rw:u32be retry)
   (rw:u32be expire)
   (rw:u32be minimum))
 
 (rw.wire:defstruc $srv ()
   (rw:u16be priority)
   (rw:u16be weight)
   (rw:u16be port)
   ($name target))
 
 (rw.wire:defstruc $resource ()
   ($name name)
   ($type type)
   ($class class)
   (rw:u32be ttl)
   ((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)
      (PTR $name)
      (SOA $soa)
      (SRV $srv)
      ;;(TXT $txt) ;; 1+ char-strings
      )
    data :length rw:u16be))
 
 (rw.wire:defstruc $message ()
   (rw:u16be tid)
   (rw:u16be flags) ;; TODO decode 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)
   ($resource additional :size nadditional))
 
 (defun udp (buf server port)
   (let ((s (rw.socket:make-udp-socket)))
     (rw.socket:using-socket
      s
      (lambda ()
        (rw.socket:udp-send s buf (length buf)
                            :remote-host server
                            :remote-port port)
        (let ((n (array-total-size buf)))
          (setf (fill-pointer buf) n)
          (multiple-value-bind (b len addr) (rw.socket:udp-receive s buf n)
            (declare (ignore addr))
            ;;(print (list :@@@ (subseq b 0 len)))
            (flet ((cb (pos)
                     (next-$name (rw:skip (rw:reader b) pos))))
              (let ((*name-from-position* #'cb))
                (next-$message (rw:shorter-reader (rw:reader b) len))))))))))
 
 (defun query1 (name server &key (type 'A) (class 'IN) (port 53))
   (let* ((n 512) ;; TODO minus IP/UDP headers
          (b (rw.wire::make-octet-buffer n)))
     (write-$message
      (rw:writer b)
      (make-$message
       :tid #x3141 #+nil(random 65536)
       :flags #x100 ;; std query TODO flags
       :nquestion 1
       :nanswer 0
       :nauthority 0
       :nadditional 0
       :question (list (make-$question :name name :type type :class class))
       :answer nil
       :authority nil
       :additional nil))
     (assert (<= (length b) n)) ;; TODO dns over tcp
     (udp b server port)))
 
 ;;(query1 "mx1.logand.com" (rw.socket:make-ipv4-address "8.8.8.8"))
 ;;(query1 "seznam.cz" (rw.socket:make-ipv4-address "8.8.8.8"))
 ;;(query1 "seznam.cz" (rw.socket:make-ipv4-address "192.168.1.1"))
 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "8.8.8.8"))
 ;;(query1 "mx1.logand.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'NS)
 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'AAAA)
 ;;(query1 "mx1.logand.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
 ;;(query1 "seznam.cz" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
 ;;(query1 "com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'A)
 ;;(query1 "a.gtld-servers.net" (rw.socket:make-ipv4-address "8.8.8.8") :type 'A)
 ;;(query1 "logand.com" (rw.socket:make-ipv4-address "192.5.6.30") :type 'A)
 ;;(query1 "uk" (rw.socket:make-ipv4-address "192.5.6.30") :type 'A)
 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
 ;;(query1 "ns1.google.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'A)
 ;;(query1 "www.google.com" (rw.socket:make-ipv4-address "216.239.32.10") :type 'MX)
 ;;(query1 "google.com" (rw.socket:make-ipv4-address "216.239.32.10") :type 'MX)
 ;;(query1 "logand.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'MX)
 ;;(query1 "mx1.logand.com" (rw.socket:make-ipv4-address "8.8.8.8") :type 'A)
 ;;(query1 "com" (rw.socket:make-ipv4-address "8.8.8.8"))
 
 (defvar *cache* (make-hash-table :test #'equal)) ;; TODO locking?
 
 (defstruct cached time ttl data)
 
 (defun validp (cached)
   (<= (get-universal-time) (+ (cached-time cached) (cached-ttl cached))))
 
 (defun lookup (name type class)
   (let ((k (list name type class))
         (n 0)
         (i 0))
     (dolist (v (gethash k *cache*))
       (incf n)
       (when (validp v)
         (incf i)))
     (cond        ;; validp?
       ((<= n i)) ;; everything
       ((< 0 i)   ;; some
        (setf (gethash k *cache*) (delete-if-not 'validp (gethash k *cache*))))
       (t ;; none
        (remhash k *cache*)))
     (mapcar 'cached-data (gethash k *cache*))))
 
 (defun remember (resource) ;; TODO preserve original ordering?
   ;; TODO cca pushnew?
   (push (make-cached :time (get-universal-time)
                      :ttl ($resource-ttl resource)
                      :data ($resource-data resource))
         (gethash (list ($resource-name resource)
                        ($resource-type resource)
                        ($resource-class resource))
                  *cache*)))
 
 (defun reverse-query-name (ip-address)
   (etypecase ip-address
     (rw.socket:ipv4-address
      (with-output-to-string (s)
        (loop
           with x = (#-ccl
                     progn
                     #+ccl
                     rw.socket::ipv4-integer-to-vector
                     (rw.socket::ipv4-address-native ip-address))
           for i from 3 downto 0
           do (format s "~d." (aref x i)))
        (write-string "in-addr.arpa" s)))
     (rw.socket:ipv6-address
      (with-output-to-string (s)
        (loop
           with x = (#-ccl
                     progn
                     #+ccl
                     rw.socket::ipv6-integer-to-vector
                     (rw.socket::ipv6-address-native ip-address))
           for i from 7 downto 0
           for e = (aref x i)
           do (format s "~(~x.~x.~x.~x.~)"
                      (ldb (byte 4 0) e)
                      (ldb (byte 4 4) e)
                      (ldb (byte 4 8) e)
                      (ldb (byte 4 12) e)))
        (write-string "ip6.arpa" s)))))
 
 (defparameter *default-server* :google)
 
 (defparameter *servers*
   `((:opennic ;; http://www.opennicproject.org/ (.bit domains)
      ,(rw.socket:make-ipv4-address "192.121.170.170")
      ,(rw.socket:make-ipv4-address "179.43.143.69"))
     (:opennic-us
      ,(rw.socket:make-ipv4-address "107.170.95.180")
      ,(rw.socket:make-ipv4-address "75.127.14.107"))
     (:opendns
      ,(rw.socket:make-ipv4-address "208.67.222.222") ;; resolver1.opendns.com
      ,(rw.socket:make-ipv4-address "208.67.220.220") ;; resolver2.opendns.com
      ,(rw.socket:make-ipv4-address "208.67.222.220")
      ,(rw.socket:make-ipv4-address "208.67.220.222")
      ,(rw.socket:make-ipv6-address "2620:0:ccc::2")
      ,(rw.socket:make-ipv6-address "2620:0:ccd::2"))
     (:google
      ,(rw.socket:make-ipv4-address "8.8.8.8")
      ,(rw.socket:make-ipv4-address "8.8.4.4")
      ,(rw.socket:make-ipv6-address "2001:4860:4860::8888")
      ,(rw.socket:make-ipv6-address "2001:4860:4860::8844"))
     (:comodo
      ,(rw.socket:make-ipv4-address "8.26.56.26")
      ,(rw.socket:make-ipv4-address "8.20.247.20"))
     (:yandex-basic
      ,(rw.socket:make-ipv4-address "77.88.8.8")
      ,(rw.socket:make-ipv4-address "77.88.8.1"))
     (:yandex-safe
      ,(rw.socket:make-ipv4-address "77.88.8.88")
      ,(rw.socket:make-ipv4-address "77.88.8.2"))
     (:yandex-family
      ,(rw.socket:make-ipv4-address "77.88.8.7")
      ,(rw.socket:make-ipv4-address "77.88.8.3"))))
 
 (defun query (name &key (server *default-server*) type (class 'IN) (port 53))
   ;;(clrhash *cache*)
   ;;(mapc 'remember (parse-named.root "/home/tomas/git/cl-rw/named.root"))
   ;;(mapc 'remember (parse-root.zone "/home/tomas/git/cl-rw/root.zone"))
   (let ((i 0))
     (labels
         ((rec (name type server)
            (or (lookup name type class)
                (let* ((q (query1 name server :type type :class class :port port))
                       (answer ($message-answer q))
                       (authority ($message-authority q)))
                  (incf i)
                  (map nil #'remember answer)
                  (map nil #'remember authority)
                  (map nil #'remember ($message-additional q))
                  (cond
                    (answer
                     (or (lookup name type class)
                         (unless (eq 'CNAME type)
                           (loop
                              for x in (rec name 'CNAME server)
                              appending (rec x type server)))))
                    (authority
                     (dolist (a authority)
                       (ecase ($resource-type a)
                         (NS
                          (dolist (server (rec ($resource-data a) type server))
                            (let ((z (rec name type server)))
                              (when z
                                (return-from rec z)))))
                         (SOA (return-from rec nil))))))))))
       (values
        (rec (etypecase name
               (string name)
               (rw.socket:ipv4-address
                (assert (eq 'PTR type))
                (assert (eq 'IN class))
                (reverse-query-name name))
               (rw.socket:ipv6-address
                (assert (eq 'PTR type))
                (assert (eq 'IN class))
                (reverse-query-name name)))
             (or type
                 (etypecase name
                   (string 'A)
                   (rw.socket:ipv4-address 'PTR)
                   (rw.socket:ipv6-address 'PTR)))
             (etypecase server
               (symbol (cadr (assoc server *servers*)))
               (rw.socket:ipv4-address server)
               (rw.socket:ipv6-address server)))
        i))))
 
 ;;(query "logand.com" :type 'MX)
 ;;(query "mx1.logand.com")
 ;;(query "mx1.logand.com" :type 'CNAME)
 ;;(query "logand.com" :type 'SOA)
 ;;(query "google.com" :type 'AAAA)
 ;;(query "google.com")
 ;;(query "google.com" :type 'MX)
 ;;(query "google.com" :type 'NS)
 ;;(query "google.com" :type 'SOA)
 ;;(query "google.com" :type 'TXT)
 ;;(query "google.com" :type 'CNAME)
 ;;(query "mx1.logand.com" :type 'AAAA)
 ;;(query "google.com" :type 'TXT)
 ;;(query "google.com" :server (rw.socket:make-ipv4-address "198.41.0.4"))
 ;;(query "mx1.logand.com" :server (rw.socket:make-ipv4-address "198.41.0.4")) ;;;;;;;;;;;;; 7x
 ;;(query "google.com" :type 'RRSIG)
 ;;(query "google.com" :type 'DS)
 ;;(query "8.8.8.8.in-addr.arpa." :type 'PTR)
 ;;(query "8.8.8.8.in-addr.arpa" :type 'PTR)
 ;;(query ".ip6.arpa" :type 'PTR)
 ;;(query "8.70.192.82.in-addr.arpa" :type 'PTR)
 ;;(query (rw.socket:make-ipv4-address "82.192.70.8"))
 ;;(query (rw.socket:make-ipv6-address #(10752 5200 16392 2049 0 0 0 4110)))
 ;;(query "ber01s09-in-x0e.1e100.net" :type 'AAAA)
 ;;(query "google.com" :type 'AAAA)
 ;;(query (rw.socket:make-ipv4-address "94.242.206.239"))
 ;;(query (rw.socket:make-ipv4-address "107.191.45.22"))
 ;;(query "cr.yp.to")
 ;;(query "cr.yp.to" :type 'MX)
 ;;(query "yp.to" :type 'NS)
 ;;(query "cr.yp.to" :server (rw.socket:make-ipv4-address "208.67.222.222"))
 ;;(query "c64games.bit" :server :opennic)
 
 ;;(query "google.com" :type 'ANY)
 ;;(query "logand.com" :type 'ANY)
 
 ;;http://technet.microsoft.com/en-us/library/cc758353(v=ws.10).aspx
 (defun parse-named.root-line (line)
   (let ((r (rw:peek-reader (rw:reader line))))
     (flet ((str ()
              (coerce (rw:till r '(#\space #\tab #\newline #\return))
                      'string)))
       (let ((name (str))
             (ttl (progn
                    (rw:skip r)
                    (rw:next-z0 r)))
             (type (progn
                     (rw:skip r)
                     (let ((x (str)))
                       (cond
                         ((equal x "A") 'A)
                         ((equal x "AAAA") 'AAAA)
                         ((equal x "NS") 'NS)
                         (t (error "unexpected record ~x ~s" x line))))))
             (detail (progn
                       (rw:skip r)
                       (coerce (rw:till r '(#\newline #\return)) 'string))))
         (make-$resource :name name
                         :type type
                         :class 'IN
                         :ttl ttl
                         :data (ecase type
                                 (A (rw.socket:make-ipv4-address detail))
                                 (AAAA (rw.socket:make-ipv6-address detail))
                                 (NS detail)))))))
 
 (defun parse-named.root (pathname)
   (with-open-file (s pathname)
     (loop
        for line = nil
        while (setq line (read-line s nil))
        unless (eql #\; (char line 0))
        collect (parse-named.root-line line))))
 
 (defun parse-root.zone-line (line)
   (let ((r (rw:peek-reader (rw:reader line))))
     (flet ((str (r)
              (coerce (rw:till r '(#\space #\tab #\newline #\return))
                      'string)))
       (let ((name (str r))
             (ttl (progn
                    (rw:skip r)
                    (rw:next-z0 r)))
             (class (progn
                      (rw:skip r)
                      (let ((x (str r)))
                        (cond
                          ((equal x "IN") 'IN)
                          (t (error "unexpected record ~x ~s" x line))))))
             (type (progn
                     (rw:skip r)
                     (let ((x (str r)))
                       (cond
                         ((equal x "A") 'A)
                         ((equal x "AAAA") 'AAAA)
                         ((equal x "NS") 'NS)
                         ((equal x "SOA") 'SOA)
                         ((equal x "RRSIG") 'RRSIG)
                         ((equal x "DNSKEY") 'DNSKEY)
                         ((equal x "NSEC") 'NSEC)
                         ((equal x "DS") 'DS)
                         (t (error "unexpected record ~s ~s" x line))))))
             (detail (progn
                       (rw:skip r)
                       (coerce (rw:till r '(#\newline #\return)) 'string))))
         (make-$resource :name name
                         :type type
                         :class class
                         :ttl ttl
                         :data (ecase type
                                 (A (rw.socket:make-ipv4-address detail))
                                 (AAAA (rw.socket:make-ipv6-address detail))
                                 (NS detail)
                                 (SOA
                                  (let ((r (rw:peek-reader (rw:reader detail))))
                                    (make-$soa :mname (str r)
                                               :rname (progn
                                                        (rw:skip r)
                                                        (str r))
                                               :serial (progn
                                                         (rw:skip r)
                                                         (rw:next-z0 r))
                                               :refresh (progn
                                                          (rw:skip r)
                                                          (rw:next-z0 r))
                                               :retry (progn
                                                        (rw:skip r)
                                                        (rw:next-z0 r))
                                               :expire (progn
                                                         (rw:skip r)
                                                         (rw:next-z0 r))
                                               :minimum (progn
                                                          (rw:skip r)
                                                          (rw:next-z0 r)))))
                                 (RRSIG ;; TODO
                                  ;;(error "TODO rrsig ~s" detail)
                                  ;;"SOA 8 0 86400 20141220170000 20141213160000 22603 . EijJa8A2FUTsamqOXCg+k+CTRlAP+ban3iNJifmnEGZCy6PokdOkAj6q8vmoOdvpbLIDNn075KbXT6AFEYyRPh3espFzOBbhF2lonpb0d5rOc8hqH9wKYYbza1YkOh19Q+SNQGYllQCVnHNRvDtKL8bUhs2+gf+QpXiBB7Q4llk="
                                  #+nil(make-$rrsig ))
                                 (DNSKEY ;; TODO
                                  ;;(error "TODO dnskey ~s" detail)
                                  ;;"256 3 8 AwEAAaPD7Y7XIi1MOEREJNTrRhyqsY3gff6JWzg+XCbqut1sbcbvqyssHw8DT1AkRaAC92pO8xuyq5QEgEPL1IHfABLwpwXI5gTj4gdwi86bpkmlWs9fRpnn4DPDCTdrnxIejJXgClHikLJF3u3CdpNCMijq4CKdQbMlRZ3avv+G7rh7"
                                  #+nil(make-$dnskey ))
                                 (NSEC ;; TODO
                                  ;;(error "TODO nsec ~s" detail)
                                  ;;"abogado. NS SOA RRSIG NSEC DNSKEY"
                                  #+nil(make-$nsec ))
                                 (DS ;; TODO
                                  ;;(error "TODO ds ~s" detail)
                                  ;;"57005 8 2 2009CA303DBEED162EE4BA3F255B2DB5C11FAF26A90804C06F9D8C54BFD6F02E"
                                  #+nil(make-$ds ))))))))
 
 (defun parse-root.zone (pathname)
   (with-open-file (s pathname)
     (loop
        for line = nil
        while (setq line (read-line s nil))
        unless (eql #\; (char line 0))
        collect (parse-root.zone-line line))))
 
 (defun parse-/etc/hosts-line (x)
   (let ((r (rw:peek-reader (rw:reader x))))
     (flet ((str ()
              (rw:skip r)
              (coerce (rw:till r '(#\space #\tab #\newline #\return))
                      'string)))
       (let ((ip (let ((x (str)))
                   (if (find #\: x)
                       (rw.socket:make-ipv6-address x)
                       (rw.socket:make-ipv4-address x)))))
         (loop
            while (rw:peek r)
            collect (make-$resource
                     :name (str)
                     :type (etypecase ip
                             (rw.socket:ipv4-address 'A)
                             (rw.socket:ipv6-address 'AAAA))
                     :class 'IN
                     :ttl 3600 ;; TODO something else?
                     :data ip))))))
 
 (defun parse-/etc/hosts (&optional (pathname "/etc/hosts"))
   (with-open-file (s pathname)
     (loop
        for line = nil
        while (setq line (read-line s nil))
        when (and (plusp (length line))
                  (not (eql #\# (char line 0))))
        appending (parse-/etc/hosts-line line))))
 
 ;;(car (parse-/etc/hosts))
 
 #+nil ;; TODO dns over tcp doesnt seem to work, depends on server?
 (defun tcp-query (name server &key (port 53))
   (with-open-stream (s (rw.socket:make-tcp-client-socket server port))
     (let ((w (rw.wire:packet-writer s)))
       (write-dns-question-packet w name)
       (rw.wire:flush w)
       (rw:next-u8 (rw:byte-reader s)))))