#:*default-zone-min-ttl* #:*default-zone-ttl*
#:*default-mx-priority* #:*default-zone-admin*
#:*zone-output-path*
+ #:*preferred-subnets* #:zone-preferred-subnet-p
#:zone-find #:zone-parse #:zone-write #:zone-create #:defzone
#:defrevzone #:zone-save #:zone-make-name
#:defzoneparse #:zone-parse-host
(name '<unnamed>)
ttl
type
+ (make-ptr-p nil)
data)
(defstruct (zone-subdomain (:conc-name zs-))
(defvar *zone-output-path* *default-pathname-defaults*
"Pathname defaults to merge into output files.")
+(defvar *preferred-subnets* nil
+ "Subnets to prefer when selecting defaults.")
+
;;;--------------------------------------------------------------------------
;;; Zone infrastructure.
:type (string-downcase type))
*zone-output-path*))
+(defun zone-preferred-subnet-p (name)
+ "Answer whether NAME (a string or symbol) names a preferred subnet."
+ (member name *preferred-subnets* :test #'string-equal))
+
(defun zone-process-records (rec ttl func)
"Sort out the list of records in REC, calling FUNC for each one. TTL is
the default time-to-live for records which don't specify one."
(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))
- (process (zs-records s)
- (cons (zs-name s) dom)
- (zs-ttl s)))
- (let ((name (and dom
- (string-downcase
- (join-strings #\. (reverse dom))))))
- (dolist (zr top)
- (setf (zr-name zr) name)
- (funcall func zr))))
+ (let ((preferred nil))
+ (dolist (s sub)
+ (when (some #'zone-preferred-subnet-p
+ (listify (zs-name s)))
+ (setf preferred s)))
+ (unless preferred
+ (setf preferred (car sub)))
+ (when preferred
+ (process (zs-records preferred)
+ dom
+ (zs-ttl preferred))))
+ (let ((name (and dom
+ (string-downcase
+ (join-strings #\. (reverse dom))))))
+ (dolist (zr top)
+ (setf (zr-name zr) name)
+ (funcall func zr))))
(dolist (s sub)
(process (zs-records s)
(cons (zs-name s) dom)
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)
+ (LIST &key :name :type :data :ttl :make-ptr-p)
- These default to the above arguments (even if you didn't accept the
- arguments)."
+ These (except MAKE-PTR-P, which defaults to nil) 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 i)
+ (with-gensyms (col tname ttype tttl tdata tmakeptrp i)
`(progn
(dolist (,i ',types)
(setf (get ,i 'zone-parse) ',func))
(flet ((,list (&key ((:name ,tname) ,name)
((:type ,ttype) ,type)
((:data ,tdata) ,data)
- ((:ttl ,tttl) ,ttl))
+ ((:ttl ,tttl) ,ttl)
+ ((:make-ptr-p ,tmakeptrp) nil))
(collect (make-zone-record :name ,tname
:type ,ttype
:data ,tdata
- :ttl ,tttl)
+ :ttl ,tttl
+ :make-ptr-p ,tmakeptrp)
,col)))
,@body)))
',type)))))
(defzoneparse :a (name data rec)
":a IPADDR"
- (rec :data (parse-ipaddr data)))
+ (rec :data (parse-ipaddr data) :make-ptr-p t))
+
+(defzoneparse :svc (name data rec)
+ ":svc IPADDR"
+ (rec :type :a :data (parse-ipaddr data)))
(defzoneparse :ptr (name data rec :zname zname)
":ptr HOST"
(hash-table-keys *zones*)))
(dolist (zr (zone-records (zone-find z)))
(when (and (eq (zr-type zr) :a)
+ (zr-make-ptr-p zr)
(ipaddr-networkp (zr-data zr) net))
(let ((name (string-downcase
(join-strings