From 590ad96179e11b59ae83bac2072a89ba1d529212 Mon Sep 17 00:00:00 2001
Message-Id: <590ad96179e11b59ae83bac2072a89ba1d529212.1714193275.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Fri, 15 Jun 2007 15:15:27 +0100
Subject: [PATCH] zone: New record type :svc creates A records without PTR
 records.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

The :svc record type inserts an A record into the zone without inserting
a matching PTR record into the reverse zone(s).  This is useful for
service role addresses.

To make this work, we add a new slot make-ptr-p to zone records which is
used to label those A records which are eligible to be turned into
PTRs.  This mechanism is, I hope, considerably simpler than the old
defsubp system.
---
 zone.lisp | 22 +++++++++++++++-------
 1 file changed, 15 insertions(+), 7 deletions(-)

diff --git a/zone.lisp b/zone.lisp
index 0ea9360..74ecf58 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -200,6 +200,7 @@ (defstruct (zone-record (:conc-name zr-))
   (name '<unnamed>)
   ttl
   type
+  (make-ptr-p nil)
   data)
 
 (defstruct (zone-subdomain (:conc-name zs-))
@@ -481,15 +482,15 @@ (defmacro defzoneparse (types (name data list
    The LIST argument names a function to be bound in the body to add a new
    low-level record to the zone.  It has the prototype
 
-     (LIST &key :name :type :data :ttl)
+     (LIST &key :name :type :data :ttl :make-ptr-p)
 
-   These default to the above arguments (even if you didn't accept the
-   arguments)."
+   These (except MAKE-PTR-P, which defaults to nil) default to the above
+   arguments (even if you didn't accept the arguments)."
   (setf types (listify types))
   (let* ((type (car types))
 	 (func (intern (format nil "ZONE-PARSE/~:@(~A~)" type))))
     (with-parsed-body (body decls doc) body
-      (with-gensyms (col tname ttype tttl tdata i)
+      (with-gensyms (col tname ttype tttl tdata tmakeptrp i)
 	`(progn
 	   (dolist (,i ',types)
 	     (setf (get ,i 'zone-parse) ',func))
@@ -500,11 +501,13 @@ 	   (defun ,func (,prefix ,zname ,data ,ttl ,col)
 	       (flet ((,list (&key ((:name ,tname) ,name)
 				   ((:type ,ttype) ,type)
 				   ((:data ,tdata) ,data)
-				   ((:ttl ,tttl) ,ttl))
+				   ((:ttl ,tttl) ,ttl)
+				   ((:make-ptr-p ,tmakeptrp) nil))
 			(collect (make-zone-record :name ,tname
 						   :type ,ttype
 						   :data ,tdata
-						   :ttl ,tttl)
+						   :ttl ,tttl
+						   :make-ptr-p ,tmakeptrp)
 				 ,col)))
 		 ,@body)))
 	  ',type)))))
@@ -572,7 +575,11 @@ (defmacro defrevzone (head &rest zf)
 
 (defzoneparse :a (name data rec)
   ":a IPADDR"
-  (rec :data (parse-ipaddr data)))
+  (rec :data (parse-ipaddr data) :make-ptr-p t))
+
+(defzoneparse :svc (name data rec)
+  ":svc IPADDR"
+  (rec :type :a :data (parse-ipaddr data)))
 
 (defzoneparse :ptr (name data rec :zname zname)
   ":ptr HOST"
@@ -637,6 +644,7 @@ (defzoneparse (:rev :reverse) (name data rec)
 		     (hash-table-keys *zones*)))
 	(dolist (zr (zone-records (zone-find z)))
 	  (when (and (eq (zr-type zr) :a)
+		     (zr-make-ptr-p zr)
 		     (ipaddr-networkp (zr-data zr) net))
 	    (let ((name (string-downcase
 			 (join-strings
-- 
[mdw]