X-Git-Url: https://git.distorted.org.uk/~mdw/zones/blobdiff_plain/3503589d50bb3d820ecd5f81a6e61b2113562bf2..aef7892ba4aa9ba78d761b2943d5df76f8bbd2d1:/distorted.lisp

diff --git a/distorted.lisp b/distorted.lisp
index a9a2b1f..b2118a4 100644
--- a/distorted.lisp
+++ b/distorted.lisp
@@ -3,6 +3,36 @@
 (load "hosts.lisp" :verbose nil)
 
 ;;;--------------------------------------------------------------------------
+;;; Anycast services.
+
+(defvar *anycast-routable-families* (list :ipv6))
+
+(defzoneparse :anycast (name data rec :prefix prefix :zname zname)
+  (destructuring-bind (any-provider default-provider &rest other-providers)
+      data
+
+    ;; First, the default address.  If the anycast network is preferred then
+    ;; this is easy; otherwise we have something complicated to do because
+    ;; IPv6 anycast addresses are globally routable, while IPv4 ones aren't.
+    (if (zone-preferred-subnet-p (car any-provider))
+	(zone-set-address #'rec (cdr any-provider) :make-ptr-p t)
+	(dolist (addr (host-addrs (host-parse (cdr any-provider))))
+	  (let ((family (ipaddr-family addr)))
+	    (if (member family *anycast-routable-families*)
+		(zone-set-address #'rec addr
+				  :family family :make-ptr-p t)
+		(zone-set-address #'rec (cdr default-provider)
+				  :family family :make-ptr-p nil)))))
+
+    ;; Now for all of the others.
+    (dolist (provider (list* any-provider default-provider other-providers))
+      (zone-set-address #'rec (cdr provider)
+			:make-ptr-p (eq provider any-provider)
+			:name (concatenate 'string prefix "."
+					   (string-downcase (car provider))
+					   "." (string-downcase zname))))))
+
+;;;--------------------------------------------------------------------------
 ;;; Other definitions.
 
 (setf *default-zone-admin* "hostmaster@distorted.org.uk")
@@ -38,44 +68,44 @@
 	  :v "DKIM1" :k "rsa" :h "sha256" :s "email"))
 
   ;; Anycast services.
-  (dns0 (any :a dns0.any)
-	(jump :svc precision.jump)
-	(dmz :svc radius.dmz)
-	(unsafe :svc radius.unsafe)
-	(colo :svc precision.colo))
-  (dns1 (any :a dns1.any)
-	(jump :svc telecaster.jump)
-	(dmz :svc vampire.dmz)
-	(unsafe :svc vampire.unsafe)
-	(colo :svc telecaster.colo))
+  (dns0 :anycast ((any dns0.any)
+		  (jump precision.jump)
+		  (colo precision.colo)
+		  (dmz radius.dmz)
+		  (unsafe radius.unsafe)))
+  (dns1 :anycast ((any dns1.any)
+		  (jump telecaster.jump)
+		  (dmz vampire.dmz)
+		  (unsafe vampire.unsafe)
+		  (colo telecaster.colo)))
   (dns :cname dns0)
 
-  (ntp0 (any :a ntp0.any)
-	(jump :svc fender.jump)
-	(dmz :svc ibanez.dmz)
-	(unsafe :svc ibanez.unsafe)
-	(colo :svc fender.colo))
-  (ntp1 (any :a ntp1.any)
-	(dmz :svc vampire.dmz)
-	(unsafe :svc vampire.unsafe))
+  (ntp0 :anycast ((any ntp0.any)
+		  (jump fender.jump)
+		  (dmz ibanez.dmz)
+		  (unsafe ibanez.unsafe)
+		  (colo  fender.colo)))
+  (ntp1 :anycast ((any ntp1.any)
+		  (dmz vampire.dmz)
+		  (unsafe vampire.unsafe)))
   (ntp :cname ntp0)
 
-  (www-cache (any :a www-cache.any)
-	     (jump :svc telecaster.jump)
-	     (dmz :svc roadstar.dmz)
-	     (unsafe :svc roadstar.unsafe)
-	     (colo :svc telecaster.colo))
+  (www-cache :anycast ((any www-cache.any)
+		       (jump telecaster.jump)
+		       (dmz roadstar.dmz)
+		       (unsafe roadstar.unsafe)
+		       (colo telecaster.colo)))
   (wpad :cname www-cache)
 
   (_kerberos :txt "DISTORTED.ORG.UK")
-  (krb0 (any :a krb0.any)
-	(jump :svc precision.jump)
-	(dmz :svc radius.dmz)
-	(unsafe :svc radius.unsafe)
-	(colo :svc precision.colo))
-  (krb1 (any :a krb1.any)
-	(dmz :svc vampire.dmz)
-	(unsafe :svc vampire.unsafe))
+  (krb0 :anycast ((any krb0.any)
+		  (jump precision.jump)
+		  (dmz radius.dmz)
+		  (unsafe radius.unsafe)
+		  (colo precision.colo)))
+  (krb1 :anycast ((any krb1.any)
+		  (dmz vampire.dmz)
+		  (unsafe vampire.unsafe)))
   (krb-master (unsafe :svc radius.unsafe)
 	      (dmz :svc radius.dmz))
   :srv (((:kerberos :protocol :udp)