#:*default-mx-priority* #:*default-zone-admin*
#:*zone-output-path*
#:zone-find #:zone-parse #:zone-write #:zone-create #:defzone
- #:defrevzone #:zone-save
+ #:defrevzone #:zone-save #:zone-make-name
#:defzoneparse #:zone-parse-host
#:timespec-seconds #:make-zone-serial))
:min-ttl (timespec-seconds min-ttl)
:serial serial))))
+(defun zone-make-name (prefix zone-name)
+ (if (or (not prefix) (string= prefix "@"))
+ zone-name
+ (let ((len (length prefix)))
+ (if (or (zerop len) (char/= (char prefix (1- len)) #\.))
+ (join-strings #\. (list prefix zone-name))
+ prefix))))
+
(defmacro defzoneparse (types (name data list
- &key (zname (gensym "ZNAME"))
+ &key (prefix (gensym "PREFIX"))
+ (zname (gensym "ZNAME"))
(ttl (gensym "TTL")))
&body body)
"Define a new zone record type (or TYPES -- a list of synonyms is
LIST A function to add a record to the zone. See below.
+ PREFIX The prefix tag used in the original form.
+
ZNAME The name of the zone being constructed.
TTL The TTL for this record.
- 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.
+ You get to choose your own names for these. ZNAME, PREFIX 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
`(progn
(dolist (,i ',types)
(setf (get ,i 'zone-parse) ',func))
- (defun ,func (,name ,data ,ttl ,col ,zname)
+ (defun ,func (,prefix ,zname ,data ,ttl ,col)
,@doc
,@decls
- (declare (ignorable ,zname))
- (flet ((,list (&key ((:name ,tname) ,name)
- ((:type ,ttype) ,type)
- ((:data ,tdata) ,data)
- ((:ttl ,tttl) ,ttl))
- (collect (make-zone-record :name ,tname
- :type ,ttype
- :data ,tdata
- :ttl ,tttl)
- ,col)))
- ,@body))
- ',type)))))
+ (let ((,name (zone-make-name ,prefix ,zname)))
+ (flet ((,list (&key ((:name ,tname) ,name)
+ ((:type ,ttype) ,type)
+ ((:data ,tdata) ,data)
+ ((:ttl ,tttl) ,ttl))
+ (collect (make-zone-record :name ,tname
+ :type ,ttype
+ :data ,tdata
+ :ttl ,tttl)
+ ,col)))
+ ,@body)))
+ ',type)))))
(defun zone-parse-records (zone records)
(let ((zname (zone-name zone)))
(let ((func (or (get (zr-type zr) 'zone-parse)
(error "No parser for record ~A."
(zr-type zr))))
- (name (and (zr-name zr)
- (stringify (zr-name zr)))))
- (if (or (not name)
- (string= name "@"))
- (setf name zname)
- (let ((len (length name)))
- (if (or (zerop len)
- (char/= (char name (1- len)) #\.))
- (setf name (join-strings #\.
- (list name zname))))))
+ (name (and (zr-name zr) (stringify (zr-name zr)))))
(funcall func
name
+ zname
(zr-data zr)
(zr-ttl zr)
- rec
- zname))))
+ rec))))
(zone-process-records records
(zone-default-ttl zone)
#'parse-record))