zone: New macro preferred-subnet-case.

A pleasant way to make decisions based on which subnets are preferred.

diff --git a/zone.lisp b/zone.lisp
index 0e579dc..be6a16e 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -35,6 +35,7 @@
             #:*default-mx-priority* #:*default-zone-admin*
           #:*zone-output-path*
           #:*preferred-subnets* #:zone-preferred-subnet-p
+          #:preferred-subnet-case
           #:zone-find #:zone-parse #:zone-write #:zone-create #:defzone
           #:defrevzone #:zone-save #:zone-make-name
           #:defzoneparse #:zone-parse-host
@@ -230,6 +231,26 @@
   "Answer whether NAME (a string or symbol) names a preferred subnet."
   (member name *preferred-subnets* :test #'string-equal))
 
+(defmacro preferred-subnet-case (&body clauses)
+  "CLAUSES have the form (SUBNETS . FORMS) -- evaluate the first FORMS whose
+   SUBNETS (a list or single symbol, not evaluated) are considered preferred
+   by zone-preferred-subnet-p.  If SUBNETS is the symbol t then the clause
+   always matches."
+  `(cond
+    ,@(mapcar (lambda (clause)
+               (let ((subnets (car clause)))
+                 (cons (cond ((eq subnets t)
+                              t)
+                             ((listp subnets)
+                              `(or ,@(mapcar (lambda (subnet)
+                                               `(zone-preferred-subnet-p
+                                                 ',subnet))
+                                             subnets)))
+                             (t
+                              `(zone-preferred-subnet-p ',subnets)))
+                       (cdr clause))))
+             clauses)))
+
 (defun zone-process-records (rec ttl func)
   "Sort out the list of records in REC, calling FUNC for each one.  TTL is
    the default time-to-live for records which don't specify one."