X-Git-Url: https://git.distorted.org.uk/~mdw/zone/blobdiff_plain/716105aa3a725242d5fac82bab8db82e0bb46995..8e7c1366598806dff2b2e4fb2016efb5a78f42ec:/zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 2e108ba..8dc3df0 100644
--- a/zone.lisp
+++ b/zone.lisp
@@ -1,7 +1,5 @@
 ;;; -*-lisp-*-
 ;;;
-;;; $Id$
-;;;
 ;;; DNS zone generation
 ;;;
 ;;; (c) 2005 Straylight/Edgeware
@@ -29,7 +27,7 @@
 (defpackage #:zone
   (:use #:common-lisp
 	#:mdw.base #:mdw.str #:collect #:safely
-	#:net #:services)
+	#:net #:net-sys #:services)
   (:export #:soa #:mx #:zone #:zone-record #:zone-subdomain
 	   #:*default-zone-source* #:*default-zone-refresh*
 	     #:*default-zone-retry* #:*default-zone-expire*
@@ -151,18 +149,8 @@
 ;;;--------------------------------------------------------------------------
 ;;; Zone defaults.  It is intended that scripts override these.
 
-#+ecl
-(cffi:defcfun gethostname :int
-  (name :pointer)
-  (len :uint))
-
 (defvar *default-zone-source*
-  (let ((hn #+cmu (unix:unix-gethostname)
-	    #+clisp (unix:get-host-name)
-	    #+ecl (cffi:with-foreign-pointer-as-string (buffer 256 len)
-		    (let ((rc (gethostname buffer len)))
-		      (unless (zerop rc)
-			(error "gethostname(2) failed (rc = ~A)." rc))))))
+  (let ((hn (gethostname)))
     (and hn (concatenate 'string (canonify-hostname hn) ".")))
   "The default zone source: the current host's name.")
 
@@ -656,9 +644,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 +668,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 +688,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.