From 8ce7eb9bf5fdb91883c53855ff605505ed064cea Mon Sep 17 00:00:00 2001 Message-Id: <8ce7eb9bf5fdb91883c53855ff605505ed064cea.1714173715.git.mdw@distorted.org.uk> From: Mark Wooding Date: Fri, 15 Jun 2007 15:16:26 +0100 Subject: [PATCH] zone: Change default subnet selection. Organization: Straylight/Edgeware From: Mark Wooding 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 | 38 +++++++++++++++++++++++++------------- 1 file changed, 25 insertions(+), 13 deletions(-) diff --git a/zone.lisp b/zone.lisp index 74ecf58..0e579dc 100644 --- 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) -- [mdw]