(when timep
(format s "~2,'0D:~2,'0D:~2,'0D" hr min sec)))))
+(deftype octet () '(unsigned-byte 8))
+(deftype octet-vector (&optional n) `(array octet (,n)))
+
+(defun decode-hex (hex &key (start 0) end)
+ "Decode a hexadecimal-encoded string, returning a vector of octets."
+ (let* ((end (or end (length hex)))
+ (len (- end start))
+ (raw (make-array (floor len 2) :element-type 'octet)))
+ (unless (evenp len)
+ (error "Invalid hex string `~A' (odd length)" hex))
+ (do ((i start (+ i 2)))
+ ((>= i end) raw)
+ (let ((high (digit-char-p (char hex i) 16))
+ (low (digit-char-p (char hex (1+ i)) 16)))
+ (unless (and high low)
+ (error "Invalid hex string `~A' (bad digit)" hex))
+ (setf (aref raw (/ (- i start) 2)) (+ (* 16 high) low))))))
+
+(defun slurp-file (file &optional (element-type 'character))
+ "Read and return the contents of FILE as a vector."
+ (with-open-file (in file :element-type element-type)
+ (let ((buf (make-array 1024 :element-type element-type))
+ (pos 0))
+ (loop
+ (let ((end (read-sequence buf in :start pos)))
+ (when (< end (length buf))
+ (return (adjust-array buf end)))
+ (setf pos end
+ buf (adjust-array buf (* 2 pos))))))))
+
(defmacro defenum (name (&key export) &body values)
"Set up symbol properties for manifest constants.
"Call FUNC on TAG/VALUE pairs from the enumeration called NAME."
(maphash func (get name 'enum-forward)))
+(defun hash-file (hash file context)
+ "Hash the FILE using the OpenSSL HASH function, returning an octet string.
+
+ CONTEXT is a temporary-files context."
+ (let ((temp (temporary-file context "hash")))
+ (run-program (list "openssl" "dgst" (concatenate 'string "-" hash))
+ :input file :output temp)
+ (with-open-file (in temp)
+ (let ((line (read-line in)))
+ (assert (and (>= (length line) 9)
+ (string= line "(stdin)= " :end1 9)))
+ (decode-hex line :start 9)))))
+
;;;--------------------------------------------------------------------------
;;; Zone types.
(do ((new (* 2 have) (* 2 new)))
((<= want new) new))))))
+(export 'rec-octet-vector)
+(defun rec-octet-vector (vector &key (start 0) end)
+ "Copy (part of) the VECTOR to the output."
+ (let* ((end (or end (length vector)))
+ (len (- end start)))
+ (rec-ensure len)
+ (do ((i start (1+ i)))
+ ((>= i end))
+ (vector-push (aref vector i) *record-vector*))))
+
(export 'rec-byte)
(defun rec-byte (octets value)
"Append an unsigned byte, OCTETS octets wide, with VALUE, to the record."
(rec :type :txt
:data (nreverse things)))))
-(defenum sshfp-algorithm (rsa 1) (dsa 2) (ecdsa 3))
-(defenum sshfp-type (sha-1 1) (sha-256 2))
+(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*
(export 'bind-format-record)
(defun bind-format-record (zr format &rest args)
(format *zone-output-stream*
- "~A~20T~@[~8D~]~30TIN ~A~40T~?~%"
+ "~A~20T~@[~8D~]~30TIN ~A~40T~?"
(bind-output-hostname (zr-name zr))
(let ((ttl (zr-ttl zr)))
(and (/= ttl (zone-default-ttl *writing-zone*))
(string-upcase (symbol-name (zr-type zr)))
format args))
+(export 'bind-write-hex)
+(defun bind-write-hex (vector remain)
+ "Output the VECTOR as hex, in Bind format.
+
+ If the length (in bytes) is less than REMAIN then it's placed on the
+ current line; otherwise the Bind line-continuation syntax is used."
+ (flet ((output-octet (octet)
+ (format *zone-output-stream* "~(~2,'0X~)" octet)))
+ (let ((len (length vector)))
+ (cond ((< len remain)
+ (dotimes (i len) (output-octet (aref vector i)))
+ (terpri *zone-output-stream*))
+ (t
+ (format *zone-output-stream* "(")
+ (let ((i 0))
+ (loop
+ (when (>= i len) (return))
+ (let ((limit (min len (+ i 64))))
+ (format *zone-output-stream* "~%~8T")
+ (loop
+ (when (>= i limit) (return))
+ (output-octet (aref vector i))
+ (incf i)))))
+ (format *zone-output-stream* " )~%"))))))
+
(defmethod zone-write-raw-rrdata ((format (eql :bind)) zr type data)
(format *zone-output-stream*
- "~A~20T~@[~8D~]~30TIN TYPE~A~40T\\# ~A"
+ "~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* " )~%")))))
+ (bind-write-hex data 12))
(defmethod zone-write-record ((format (eql :bind)) (type (eql :a)) zr)
- (bind-format-record zr "~A" (ipaddr-string (zr-data 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))))
+ (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))))
+ (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))))
+ (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))))
+ (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"
+ (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"
+ (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)))
+ (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)))
+ (bind-format-record zr "~{~#[\"\"~;~S~:;(~@{~%~8T~S~} )~]~}~%"
+ (zr-data zr)))
;;;--------------------------------------------------------------------------
;;; tinydns-data output format.
(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)))))