zone: Use hash-table for reversing zones; eliminate defsubp.

For :reverse, use a hash-table to keep track of which addresses have
been assigned PTR records so far.  Eliminate the defsubp slot of zone
records as being a bad (and confusing) idea.

diff --git a/zone.lisp b/zone.lisp
index 6b11880..f3d85d0 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -200,7 +200,6 @@
   (name '<unnamed>)
   ttl
   type
-  (defsubp nil)
   data)
 
 (defstruct (zone-subdomain (:conc-name zs-))
@@ -246,31 +245,27 @@
                                     sub)))
                         (t
                          (error "Unexpected record form ~A" (car r))))))))
-          (process (rec dom ttl defsubp)
+          (process (rec dom ttl)
             (multiple-value-bind (top sub) (sift rec ttl)
               (if (and dom (null top) sub)
                   (let ((s (pop sub)))
                     (process (zs-records s)
                              dom
-                             (zs-ttl s)
-                             defsubp)
+                             (zs-ttl s))
                     (process (zs-records s)
                              (cons (zs-name s) dom)
-                             (zs-ttl s)
-                             t))
+                             (zs-ttl s)))
                 (let ((name (and dom
                                  (string-downcase
                                   (join-strings #\. (reverse dom))))))
                   (dolist (zr top)
                     (setf (zr-name zr) name)
-                    (setf (zr-defsubp zr) defsubp)
                     (funcall func zr))))
               (dolist (s sub)
                 (process (zs-records s)
                          (cons (zs-name s) dom)
-                         (zs-ttl s)
-                         defsubp)))))
-    (process rec nil ttl nil)))
+                         (zs-ttl s))))))
+    (process rec nil ttl)))
 
 (defun zone-parse-host (f zname)
   "Parse a host name F: if F ends in a dot then it's considered absolute;
@@ -453,8 +448,7 @@
 
 (defmacro defzoneparse (types (name data list
                               &key (zname (gensym "ZNAME"))
-                                   (ttl (gensym "TTL"))
-                                   (defsubp (gensym "DEFSUBP")))
+                                   (ttl (gensym "TTL")))
                        &body body)
   "Define a new zone record type (or TYPES -- a list of synonyms is
    permitted).  The arguments are as follows:
@@ -470,40 +464,36 @@
 
    TTL         The TTL for this record.
 
-   DEFSUBP     Whether this is the default subdomain for this entry.
-
-   You get to choose your own names for these.  ZNAME, TTL and DEFSUBP are
-   optional: you don't have to accept them if you're not interested.
+   You get to choose your own names for these.  ZNAME and TTL are optional:
+   you don't have to accept them if you're not interested.
 
    The LIST argument names a function to be bound in the body to add a new
    low-level record to the zone.  It has the prototype
 
-     (LIST &key :name :type :data :ttl :defsubp)
+     (LIST &key :name :type :data :ttl)
 
-   Except for defsubp, these default to the above arguments (even if you
-   didn't accept the arguments)."
+   These default to the above arguments (even if you didn't accept the
+   arguments)."
   (setf types (listify types))
   (let* ((type (car types))
         (func (intern (format nil "ZONE-PARSE/~:@(~A~)" type))))
     (with-parsed-body (body decls doc) body
-      (with-gensyms (col tname ttype tttl tdata tdefsubp i)
+      (with-gensyms (col tname ttype tttl tdata i)
        `(progn
           (dolist (,i ',types)
             (setf (get ,i 'zone-parse) ',func))
-          (defun ,func (,name ,data ,ttl ,col ,zname ,defsubp)
+          (defun ,func (,name ,data ,ttl ,col ,zname)
             ,@doc
             ,@decls
-            (declare (ignorable ,zname ,defsubp))
+            (declare (ignorable ,zname))
             (flet ((,list (&key ((:name ,tname) ,name)
                                 ((:type ,ttype) ,type)
                                 ((:data ,tdata) ,data)
-                                ((:ttl ,tttl) ,ttl)
-                                ((:defsubp ,tdefsubp) nil))
+                                ((:ttl ,tttl) ,ttl))
                      (collect (make-zone-record :name ,tname
                                                 :type ,ttype
                                                 :data ,tdata
-                                                :ttl ,tttl
-                                                :defsubp ,tdefsubp)
+                                                :ttl ,tttl)
                               ,col)))
               ,@body))
           ',type)))))
@@ -530,8 +520,7 @@
                            (zr-data zr)
                            (zr-ttl zr)
                            rec
-                           zname
-                           (zr-defsubp zr)))))
+                           zname))))
          (zone-process-records records
                                (zone-default-ttl zone)
                                #'parse-record))
@@ -579,9 +568,9 @@
 ;;;--------------------------------------------------------------------------
 ;;; Zone record parsers.
 
-(defzoneparse :a (name data rec :defsubp defsubp)
+(defzoneparse :a (name data rec)
   ":a IPADDR"
-  (rec :data (parse-ipaddr data) :defsubp defsubp))
+  (rec :data (parse-ipaddr data)))
 
 (defzoneparse :ptr (name data rec :zname zname)
   ":ptr HOST"
@@ -641,23 +630,24 @@
     (setf net (zone-parse-net net name))
     (unless bytes
       (setf bytes (ipnet-changeable-bytes (ipnet-mask net))))
-    (dolist (z (or (cdr data)
-                  (hash-table-keys *zones*)))
-      (dolist (zr (zone-records (zone-find z)))
-       (when (and (eq (zr-type zr) :a)
-                  (not (zr-defsubp zr))
-                  (ipaddr-networkp (zr-data zr) net))
-         (rec :name (string-downcase
-                     (join-strings
-                      #\.
-                      (collecting ()
-                        (dotimes (i bytes)
-                          (collect (logand #xff (ash (zr-data zr)
-                                                     (* -8 i)))))
-                        (collect name))))
-              :type :ptr
-              :ttl (zr-ttl zr)
-              :data (zr-name zr)))))))
+    (let ((seen (make-hash-table :test #'equal)))
+      (dolist (z (or (cdr data)
+                    (hash-table-keys *zones*)))
+       (dolist (zr (zone-records (zone-find z)))
+         (when (and (eq (zr-type zr) :a)
+                    (ipaddr-networkp (zr-data zr) net))
+           (let ((name (string-downcase
+                        (join-strings
+                         #\.
+                         (collecting ()
+                           (dotimes (i bytes)
+                             (collect (logand #xff (ash (zr-data zr)
+                                                        (* -8 i)))))
+                           (collect name))))))
+             (unless (gethash name seen)
+               (rec :name name :type :ptr
+                    :ttl (zr-ttl zr) :data (zr-name zr))
+               (setf (gethash name seen) t)))))))))
 
 (defzoneparse (:cidr-delegation :cidr) (name data rec)
   ":cidr-delegation ((NET :bytes BYTES) (TARGET-NET [TARGET-ZONE])*)"