(name '<unnamed>)
ttl
type
- (defsubp nil)
data)
(defstruct (zone-subdomain (:conc-name zs-))
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;
(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:
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)))))
(zr-data zr)
(zr-ttl zr)
rec
- zname
- (zr-defsubp zr)))))
+ zname))))
(zone-process-records records
(zone-default-ttl zone)
#'parse-record))
;;;--------------------------------------------------------------------------
;;; 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"
(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])*)"