From: Mark Wooding <mdw@distorted.org.uk>
Date: Sun, 16 Mar 2008 15:02:14 +0000 (+0000)
Subject: zone: Clean up the :cidr-delegation parser.
X-Git-Url: https://git.distorted.org.uk/~mdw/zone/commitdiff_plain/cc0fa47a50532786e202ee24c6518e50ba6959e2

zone: Clean up the :cidr-delegation parser.
---

diff --git a/zone.lisp b/zone.lisp
index 2e108ba..ea9fda3 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -656,9 +656,7 @@
 (defzoneparse (:rev :reverse) (name data rec)
   ":reverse ((NET :bytes BYTES) ZONE*)"
   (setf data (listify data))
-  (destructuring-bind
-      (net &key bytes)
-      (listify (car data))
+  (destructuring-bind (net &key bytes) (listify (car data))
     (setf net (zone-parse-net net name))
     (unless bytes
       (setf bytes (ipnet-changeable-bytes (ipnet-mask net))))
@@ -682,18 +680,15 @@
 		     :ttl (zr-ttl zr) :data (zr-name zr))
 		(setf (gethash name seen) t)))))))))
 
-(defzoneparse (:cidr-delegation :cidr) (name data rec)
+(defzoneparse (:cidr-delegation :cidr) (name data rec :zname zname)
   ":cidr-delegation ((NET :bytes BYTES) (TARGET-NET [TARGET-ZONE])*)"
-  (destructuring-bind
-      (net &key bytes)
-      (listify (car data))
+  (setf data (listify data))
+  (destructuring-bind (net &key bytes) (listify (car data))
     (setf net (zone-parse-net net name))
     (unless bytes
       (setf bytes (ipnet-changeable-bytes (ipnet-mask net))))
-    (dolist (map (cdr data))
-      (destructuring-bind
-	  (tnet &optional tdom)
-	  (listify map)
+    (dolist (map (or (cdr data) (list (list net))))
+      (destructuring-bind (tnet &optional tdom) (listify map)
 	(setf tnet (zone-parse-net tnet name))
 	(unless (ipnet-subnetp net tnet)
 	  (error "~A is not a subnet of ~A."
@@ -705,25 +700,25 @@
 		  (join-strings
 		   #\.
 		   (append (reverse (loop
-				       for i from (1- bytes) downto 0
-				       until (zerop (logand mask
-							    (ash #xff
-								 (* 8 i))))
-				       collect (logand #xff
-						       (ash net (* -8 i)))))
+				     for i from (1- bytes) downto 0
+				     until (zerop (logand mask
+							  (ash #xff
+							       (* 8 i))))
+				     collect (ldb (byte 8 (* i 8)) net)))
 			   (list name))))))
-	(setf tdom (string-downcase tdom))
+	(setf tdom (string-downcase (stringify tdom)))
 	(dotimes (i (ipnet-hosts tnet))
-	  (let* ((addr (ipnet-host tnet i))
-		 (tail (join-strings #\.
-				     (loop
+	  (unless (zerop i)
+	    (let* ((addr (ipnet-host tnet i))
+		   (tail (join-strings #\.
+				       (loop
 					for i from 0 below bytes
 					collect
-					  (logand #xff
-						  (ash addr (* 8 i)))))))
-	    (rec :name (format nil "~A.~A" tail name)
-		 :type :cname
-		 :data (format nil "~A.~A" tail tdom))))))))
+					(logand #xff
+						(ash addr (* 8 i)))))))
+	      (rec :name (format nil "~A.~A" tail name)
+		   :type :cname
+		   :data (format nil "~A.~A" tail tdom)))))))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Zone file output.