(when timep
(format s "~2,'0D:~2,'0D:~2,'0D" hr min sec)))))
+(defmacro defenum (name (&key export) &body values)
+ "Set up symbol properties for manifest constants.
+
+ The VALUES are a list of (TAG VALUE) pairs. Each TAG is a symbol; we set
+ the NAME property on TAG to VALUE, and export TAG. There are also handy
+ hash-tables mapping in the forward and reverse directions, in the name
+ symbol's `enum-forward' and `enum-reverse' properties."
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ ,(let*/gensyms (export)
+ (with-gensyms (forward reverse valtmp)
+ `(let ((,forward (make-hash-table))
+ (,reverse (make-hash-table)))
+ (when ,export (export ',name))
+ ,@(mapcar (lambda (item)
+ (destructuring-bind (tag value) item
+ (let ((constant
+ (intern (concatenate 'string
+ (symbol-name name)
+ "/"
+ (symbol-name tag)))))
+ `(let ((,valtmp ,value))
+ (when ,export
+ (export ',constant)
+ (when (eq (symbol-package ',tag) *package*)
+ (export ',tag)))
+ (defconstant ,constant ,valtmp)
+ (setf (get ',tag ',name) ,value
+ (gethash ',tag ,forward) ,valtmp
+ (gethash ,valtmp ,reverse) ',tag)))))
+ values)
+ (setf (get ',name 'enum-forward) ,forward
+ (get ',name 'enum-reverse) ,reverse))))))
+
+(defun lookup-enum (name tag &key min max)
+ "Look up a TAG in an enumeration.
+
+ If TAG is a symbol, check its NAME property; if it's a fixnum then take it
+ as it is. Make sure that it's between MIN and MAX, if they're not nil."
+ (let ((value (etypecase tag
+ (fixnum tag)
+ (symbol (or (get tag name)
+ (error "~S is not a known ~A" tag name))))))
+ (unless (and (or (null min) (<= min value))
+ (or (null max) (<= value max)))
+ (error "Value ~S out of range for ~A" value name))
+ value))
+
+(defun reverse-enum (name value)
+ "Reverse-lookup of a VALUE in enumeration NAME.
+
+ If a tag for the VALUE is found, return it and `t'; otherwise return VALUE
+ unchanged and `nil'."
+ (multiple-value-bind (tag foundp) (gethash value (get name 'enum-reverse))
+ (if foundp
+ (values tag t)
+ (values value nil))))
+
+(defun mapenum (func name)
+ "Call FUNC on TAG/VALUE pairs from the enumeration called NAME."
+ (maphash func (get name 'enum-forward)))
+
;;;--------------------------------------------------------------------------
;;; Zone types.
(flush))
(when (plusp len)
(cond ((< len 64)
- (unless out (setf out (make-string-output-stream)))
+ (unless out
+ (setf out (make-string-output-stream)))
(write-string text out))
(t
(do ((i 0 j)
(j 64 (+ j 64)))
((>= i len))
- (push (subseq text i (min j len)) things))))))))
+ (push (subseq text i (min j len))
+ things))))))))
(do ((p plist (cddr p)))
((endp p))
(emit (format nil "~(~A~)=~A;" (car p) (cadr p))))
(rec :type :txt
:data (nreverse things)))))
-(eval-when (:load-toplevel :execute)
- (dolist (item '((sshfp-algorithm rsa 1)
- (sshfp-algorithm dsa 2)
- (sshfp-algorithm ecdsa 3)
- (sshfp-type sha-1 1)
- (sshfp-type sha-256 2)))
- (destructuring-bind (prop sym val) item
- (setf (get sym prop) val)
- (export sym))))
+(defenum sshfp-algorithm (rsa 1) (dsa 2) (ecdsa 3))
+(defenum sshfp-type (sha-1 1) (sha-256 2))
(export '*sshfp-pathname-defaults*)
(defvar *sshfp-pathname-defaults*
(rec :data (list (parse-integer alg)
(parse-integer type)
fpr)))))))
- (flet ((lookup (what prop)
- (etypecase what
- (fixnum what)
- (symbol (or (get what prop)
- (error "~S is not a known ~A" what prop))))))
- (dolist (item (listify data))
- (destructuring-bind (fpr &key (alg 'rsa) (type 'sha-1))
- (listify item)
- (rec :data (list (lookup alg 'sshfp-algorithm)
- (lookup type 'sshfp-type)
- fpr)))))))
+ (dolist (item (listify data))
+ (destructuring-bind (fpr &key (alg 'rsa) (type 'sha-1))
+ (listify item)
+ (rec :data (list (lookup-enum alg 'sshfp-algorithm :min 0 :max 255)
+ (lookup-enum type 'sshfp-type :min 0 :max 255)
+ fpr))))))
(defmethod zone-record-rrdata ((type (eql :sshfp)) zr)
(destructuring-bind (alg type fpr) (zr-data zr)
:data name)))
(defzoneparse :srv (name data rec :zname zname)
- ":srv (((SERVICE &key :port) (PROVIDER &key :port :prio :weight :ip)*)*)"
+ ":srv (((SERVICE &key :port :protocol)
+ (PROVIDER &key :port :prio :weight :ip)*)*)"
(dolist (srv data)
(destructuring-bind (servopts &rest providers) srv
(destructuring-bind
name))))
(defmethod zone-write :around ((format (eql :bind)) zone stream)
+ (declare (ignorable zone stream))
(let ((*bind-last-record-name* nil))
(call-next-method)))
(dotimes (i (length data))
(let ((byte (aref data i)))
(if (or (<= byte 32)
- (>= byte 128)
+ (>= byte 127)
(member byte '(#\: #\\) :key #'char-code))
(format out "\\~3,'0O" byte)
(write-char (code-char byte) out)))))
~mdw / zone / blobdiff