-(defmethod bind-record (type zr)
- (destructuring-bind (format &rest args)
- (bind-record-format-args type (zr-data zr))
- (bind-format-record (zr-name zr)
- (zr-ttl zr)
- (bind-record-type type)
- format args)))
-
-(defgeneric bind-record-type (type)
- (:method (type) type))
-
-(defgeneric bind-record-format-args (type data)
- (:method ((type (eql :a)) data) (list "~A" (ipaddr-string data)))
- (:method ((type (eql :ptr)) data) (list "~A" (bind-hostname data)))
- (:method ((type (eql :cname)) data) (list "~A" (bind-hostname data)))
- (:method ((type (eql :ns)) data) (list "~A" (bind-hostname data)))
- (:method ((type (eql :mx)) data)
- (list "~2D ~A" (cdr data) (bind-hostname (car data))))
- (:method ((type (eql :txt)) data) (list "~S" (stringify data))))
+(defmethod zone-write-raw-rrdata ((format (eql :bind)) zr type data)
+ (format *zone-output-stream*
+ "~A~20T~@[~8D~]~30TIN TYPE~A~40T\\# ~A"
+ (bind-output-hostname (zr-name zr))
+ (let ((ttl (zr-ttl zr)))
+ (and (/= ttl (zone-default-ttl *writing-zone*))
+ ttl))
+ type
+ (length data))
+ (let* ((hex (with-output-to-string (out)
+ (dotimes (i (length data))
+ (format out "~(~2,'0X~)" (aref data i)))))
+ (len (length hex)))
+ (cond ((< len 24)
+ (format *zone-output-stream* " ~A~%" hex))
+ (t
+ (format *zone-output-stream* " (")
+ (let ((i 0))
+ (loop
+ (when (>= i len) (return))
+ (let ((j (min (+ i 64) len)))
+ (format *zone-output-stream* "~%~8T~A" (subseq hex i j))
+ (setf i j))))
+ (format *zone-output-stream* " )~%")))))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :a)) zr)
+ (bind-format-record zr "~A" (ipaddr-string (zr-data zr))))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :aaaa)) zr)
+ (bind-format-record zr "~A" (ipaddr-string (zr-data zr))))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :ptr)) zr)
+ (bind-format-record zr "~A" (bind-hostname (zr-data zr))))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :cname)) zr)
+ (bind-format-record zr "~A" (bind-hostname (zr-data zr))))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :ns)) zr)
+ (bind-format-record zr "~A" (bind-hostname (zr-data zr))))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :mx)) zr)
+ (bind-format-record zr "~2D ~A"
+ (cdr (zr-data zr))
+ (bind-hostname (car (zr-data zr)))))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :srv)) zr)
+ (destructuring-bind (prio weight port host) (zr-data zr)
+ (bind-format-record zr "~2D ~5D ~5D ~A"
+ prio weight port (bind-hostname host))))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :sshfp)) zr)
+ (bind-format-record zr "~{~2D ~2D ~A~}" (zr-data zr)))
+
+(defmethod zone-write-record ((format (eql :bind)) (type (eql :txt)) zr)
+ (bind-format-record zr "~{~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]~}" (zr-data zr)))
+
+;;;--------------------------------------------------------------------------
+;;; tinydns-data output format.
+
+(export 'tinydns-output)
+(defun tinydns-output (code &rest fields)
+ (format *zone-output-stream* "~C~{~@[~A~]~^:~}~%" code fields))
+
+(defmethod zone-write-raw-rrdata ((format (eql :tinydns)) zr type data)
+ (tinydns-output #\: (zr-name zr) type
+ (with-output-to-string (out)
+ (dotimes (i (length data))
+ (let ((byte (aref data i)))
+ (if (or (<= byte 32)
+ (>= byte 128)
+ (member byte '(#\: #\\) :key #'char-code))
+ (format out "\\~3,'0O" byte)
+ (write-char (code-char byte) out)))))
+ (zr-ttl zr)))
+
+(defmethod zone-write-record ((format (eql :tinydns)) (type (eql :a)) zr)
+ (tinydns-output #\+ (zr-name zr)
+ (ipaddr-string (zr-data zr)) (zr-ttl zr)))
+
+(defmethod zone-write-record ((format (eql :tinydns)) (type (eql :aaaa)) zr)
+ (tinydns-output #\3 (zr-name zr)
+ (format nil "~(~32,'0X~)" (ipaddr-addr (zr-data zr)))
+ (zr-ttl zr)))
+
+(defmethod zone-write-record ((format (eql :tinydns)) (type (eql :ptr)) zr)
+ (tinydns-output #\^ (zr-name zr) (zr-data zr) (zr-ttl zr)))
+
+(defmethod zone-write-record ((format (eql :tinydns)) (type (eql :cname)) zr)
+ (tinydns-output #\C (zr-name zr) (zr-data zr) (zr-ttl zr)))
+
+(defmethod zone-write-record ((format (eql :tinydns)) (type (eql :ns)) zr)
+ (tinydns-output #\& (zr-name zr) nil (zr-data zr) (zr-ttl zr)))
+
+(defmethod zone-write-record ((format (eql :tinydns)) (type (eql :mx)) zr)
+ (let ((name (car (zr-data zr)))
+ (prio (cdr (zr-data zr))))
+ (tinydns-output #\@ (zr-name zr) nil name prio (zr-ttl zr))))
+
+(defmethod zone-write-header ((format (eql :tinydns)) zone)
+ (format *zone-output-stream* "~
+### Zone file `~(~A~)'
+### (generated ~A)
+~%"
+ (zone-name zone)
+ (iso-date :now :datep t :timep t))
+ (let ((soa (zone-soa zone)))
+ (tinydns-output #\Z
+ (zone-name zone)
+ (soa-source soa)
+ (let* ((name (copy-seq (soa-admin soa)))
+ (at (position #\@ name)))
+ (when at (setf (char name at) #\.))
+ name)
+ (soa-serial soa)
+ (soa-refresh soa)
+ (soa-expire soa)
+ (soa-min-ttl soa)
+ (zone-default-ttl zone))))