X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/blobdiff_plain/bb94753b6d10c0d54cba7f6ae387f63d1b0546ff..HEAD:/zone.lisp

diff --git a/zone.lisp b/zone.lisp
index d5d2072..7649f54 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -68,15 +68,20 @@ (defun to-mixed-base (base val)
 	(push r a)
 	(setf val q)))))
 
-(let ((unit-scale (make-hash-table)))
+(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 (units scale) item
-      (dolist (unit units) (setf (gethash unit unit-scale) scale))))
+    (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)
@@ -103,7 +108,26 @@   (defun timespec-seconds (ts)
 					       unit)))))
 			  (convert (+ acc (to-integer (* count scale)))
 				   tail)))))))
-      (convert 0 ts))))
+      (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."
@@ -276,7 +300,7 @@ (defvar *default-zone-source*
   "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*)
@@ -284,19 +308,19 @@ (defvar *default-zone-admin* nil
   "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*)
@@ -1007,7 +1031,7 @@ (defzoneparse :spf (name data rec :zname zname)
 			      (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~]"
@@ -1676,20 +1700,20 @@ (defmethod zone-write-header ((format (eql :bind)) zone)
 		  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)