(push r a)
(setf val q)))))
-(export 'timespec-seconds)
-(defun timespec-seconds (ts)
- "Convert a timespec TS to seconds.
-
- A timespec may be a real count of seconds, or a list (COUNT UNIT). UNIT
- may be any of a number of obvious time units."
- (cond ((null ts) 0)
- ((realp ts) (floor ts))
- ((atom ts)
- (error "Unknown timespec format ~A" ts))
- ((null (cdr ts))
- (timespec-seconds (car ts)))
- (t (+ (to-integer (* (car ts)
- (case (intern (string-upcase
- (stringify (cadr ts)))
- '#:zone)
- ((s sec secs second seconds) 1)
- ((m min mins minute minutes) 60)
- ((h hr hrs hour hours) #.(* 60 60))
- ((d dy dys day days) #.(* 24 60 60))
- ((w wk wks week weeks) #.(* 7 24 60 60))
- ((y yr yrs year years) #.(* 365 24 60 60))
- (t (error "Unknown time unit ~A"
- (cadr ts))))))
- (timespec-seconds (cddr ts))))))
+(let ((unit-scale (make-hash-table))
+ (scales nil))
+
+ (dolist (item `(((:second :seconds :sec :secs :s) ,1)
+ ((:minute :minutes :min :mins :m) ,60)
+ ((:hour :hours :hr :hrs :h) ,(* 60 60))
+ ((:day :days :dy :dys :d) ,(* 24 60 60))
+ ((:week :weeks :wk :wks :w) ,(* 7 24 60 60))))
+ (destructuring-bind
+ ((&whole units singular plural &rest hunoz) scale) item
+ (declare (ignore hunoz))
+ (dolist (unit units) (setf (gethash unit unit-scale) scale))
+ (push (cons scale (cons singular plural)) scales)))
+ (setf scales (sort scales #'> :key #'car))
+
+ (export 'timespec-seconds)
+ (defun timespec-seconds (ts)
+ "Convert a timespec TS to seconds.
+
+ A timespec may be a real count of seconds, or a list ({COUNT UNIT}*).
+ UNIT may be any of a number of obvious time units."
+ (labels ((convert (acc ts)
+ (cond ((null ts) acc)
+ ((realp ts) (+ acc (floor ts)))
+ ((atom ts) (error "Unknown timespec format ~A" ts))
+ (t
+ (destructuring-bind
+ (count &optional unit &rest tail) ts
+ (let ((scale
+ (acond ((null unit) 1)
+ ((gethash (intern (string-upcase
+ (stringify unit))
+ :keyword)
+ unit-scale)
+ it)
+ (t
+ (error "Unknown time unit ~S"
+ unit)))))
+ (convert (+ acc (to-integer (* count scale)))
+ tail)))))))
+ (convert 0 ts)))
+
+ (export 'seconds-timespec)
+ (defun seconds-timespec (secs)
+ "Convert a count of seconds to a time specification."
+ (let ((sign (if (minusp secs) -1 +1)) (secs (abs secs)))
+ (collecting ()
+ (loop (cond ((zerop secs)
+ (unless (collected) (collect-append '(0 :seconds)))
+ (return))
+ ((< secs 60)
+ (collect (* secs sign))
+ (collect (if (= secs 1) :second :seconds))
+ (return))
+ (t
+ (let ((match (find secs scales :test #'>= :key #'car)))
+ (multiple-value-bind (quot rem) (floor secs (car match))
+ (collect (* quot sign))
+ (collect (if (= quot 1) (cadr match) (cddr match)))
+ (setf secs rem))))))))))
(defun hash-table-keys (ht)
"Return a list of the keys in hashtable HT."
"The default zone source: the current host's name.")
(export '*default-zone-refresh*)
-(defvar *default-zone-refresh* (* 8 60 60)
+(defvar *default-zone-refresh* '(8 :hours)
"Default zone refresh interval: eight hours.")
(export '*default-zone-admin*)
"Default zone administrator's email address.")
(export '*default-zone-retry*)
-(defvar *default-zone-retry* (* 20 60)
+(defvar *default-zone-retry* '(20 :minutes)
"Default zone retry interval: twenty minutes.")
(export '*default-zone-expire*)
-(defvar *default-zone-expire* (* 3 24 60 60)
+(defvar *default-zone-expire* '(3 :days)
"Default zone expiry time: three days.")
(export '*default-zone-min-ttl*)
-(defvar *default-zone-min-ttl* (* 4 60 60)
+(defvar *default-zone-min-ttl* '(4 :hours)
"Default zone minimum/negative TTL: four hours.")
(export '*default-zone-ttl*)
-(defvar *default-zone-ttl* (* 4 60 60)
+(defvar *default-zone-ttl* '(4 :hours)
"Default zone TTL (for records without explicit TTLs): four hours.")
(export '*default-mx-priority*)
5)
(defun split-txt-data (data)
+ "Split the string DATA into pieces small enough to fit in a TXT record.
+
+ Return a list of strings L such that (a) (apply #'concatenate 'string L)
+ is equal to the original string DATA, and (b) (every (lambda (s) (<=
+ (length s) 255)) L) is true."
(collecting ()
(let ((i 0) (n (length data)))
(loop
(write-char #\space out))
(let* ((width (ipnet-width net))
(mask (ipnet-mask net))
- (plen (ipmask-cidl-slash width mask)))
+ (plen (ipmask-cidr-slash width mask)))
(unless plen
(error "invalid netmask in network ~A" net))
(format out "~A~A:~A~@[/~D~]"
copy)))
(format *zone-output-stream* "~
~A~30TIN SOA~40T~A (
-~55@A~60T ;administrator
-~45T~10D~60T ;serial
-~45T~10D~60T ;refresh
-~45T~10D~60T ;retry
-~45T~10D~60T ;expire
-~45T~10D )~60T ;min-ttl~2%"
+~55@A~58T; administrator
+~45T~10D~58T; serial
+~45T~10D~58T; refresh: ~{~D ~(~A~)~^ ~}
+~45T~10D~58T; retry: ~{~D ~(~A~)~^ ~}
+~45T~10D~58T; expire: ~{~D ~(~A~)~^ ~}
+~45T~10D )~58T; min-ttl: ~{~D ~(~A~)~^ ~}~2%"
(bind-output-hostname (zone-name zone))
(bind-hostname (soa-source soa))
admin
(soa-serial soa)
- (soa-refresh soa)
- (soa-retry soa)
- (soa-expire soa)
- (soa-min-ttl soa))))
+ (soa-refresh soa) (seconds-timespec (soa-refresh soa))
+ (soa-retry soa) (seconds-timespec (soa-retry soa))
+ (soa-expire soa) (seconds-timespec (soa-expire soa))
+ (soa-min-ttl soa) (seconds-timespec (soa-min-ttl soa)))))
(export 'bind-format-record)
(defun bind-format-record (zr format &rest args)
~mdw / zone / blobdiff