distorted.lisp: Better processing of anycast addresses.

Introduce a custom `:anycast' record parser which hacks on descriptions
of which address families provide which services and does the right
thing.

This stuff is complicated because IPv6 anycast addresses actually
work globally so we might as well publish them properly.  Also, actual
anycast addresses have dedicated allocations, so it's right to maintain
PTR records for them; but the static-provider addresses are service
names and don't want reverse records.

diff --git a/distorted.lisp b/distorted.lisp
index a9a2b1f..b2118a4 100644 (file)
--- 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)