chiark / gitweb /
zone: Change default subnet selection.
authorMark Wooding <mdw@distorted.org.uk>
Fri, 15 Jun 2007 14:16:26 +0000 (15:16 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Fri, 15 Jun 2007 14:16:26 +0000 (15:16 +0100)
We now have a concept of `preferred subnets'.  If a record has a subnet
whose name is on the list *preferred-subnets*, and no explicit default
record, then the record for the first such subnet is used as the
default.  If no preferred subnet is found, then the first listed subnet
is used, as before.

The objective is to make describing split-horizon DNS systems easier.

zone.lisp

index 74ecf58..0e579dc 100644 (file)
--- a/zone.lisp
+++ b/zone.lisp
@@ -34,6 +34,7 @@ (defpackage #:zone
             #:*default-zone-min-ttl* #:*default-zone-ttl*
             #:*default-mx-priority* #:*default-zone-admin*
           #:*zone-output-path*
+          #:*preferred-subnets* #:zone-preferred-subnet-p
           #:zone-find #:zone-parse #:zone-write #:zone-create #:defzone
           #:defrevzone #:zone-save #:zone-make-name
           #:defzoneparse #:zone-parse-host
@@ -213,6 +214,9 @@ (defstruct (zone-subdomain (:conc-name zs-))
 (defvar *zone-output-path* *default-pathname-defaults*
   "Pathname defaults to merge into output files.")
 
+(defvar *preferred-subnets* nil
+  "Subnets to prefer when selecting defaults.")
+
 ;;;--------------------------------------------------------------------------
 ;;; Zone infrastructure.
 
@@ -222,6 +226,10 @@ (defun zone-file-name (zone type)
                                  :type (string-downcase type))
                   *zone-output-path*))
 
+(defun zone-preferred-subnet-p (name)
+  "Answer whether NAME (a string or symbol) names a preferred subnet."
+  (member name *preferred-subnets* :test #'string-equal))
+
 (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."
@@ -249,19 +257,23 @@ (defun zone-process-records (rec ttl func)
           (process (rec dom ttl)
             (multiple-value-bind (top sub) (sift rec ttl)
               (if (and dom (null top) sub)
-                  (let ((s (pop sub)))
-                    (process (zs-records s)
-                             dom
-                             (zs-ttl s))
-                    (process (zs-records s)
-                             (cons (zs-name s) dom)
-                             (zs-ttl s)))
-                (let ((name (and dom
-                                 (string-downcase
-                                  (join-strings #\. (reverse dom))))))
-                  (dolist (zr top)
-                    (setf (zr-name zr) name)
-                    (funcall func zr))))
+                  (let ((preferred nil))
+                    (dolist (s sub)
+                      (when (some #'zone-preferred-subnet-p
+                                  (listify (zs-name s)))
+                        (setf preferred s)))
+                    (unless preferred
+                      (setf preferred (car sub)))
+                    (when preferred
+                      (process (zs-records preferred)
+                               dom
+                               (zs-ttl preferred))))
+                  (let ((name (and dom
+                                   (string-downcase
+                                    (join-strings #\. (reverse dom))))))
+                    (dolist (zr top)
+                      (setf (zr-name zr) name)
+                      (funcall func zr))))
               (dolist (s sub)
                 (process (zs-records s)
                          (cons (zs-name s) dom)