Upgrade everything for SBCL.

[zone] / zone.lisp

diff --git a/zone.lisp b/zone.lisp
index 2e108ba..8dc3df0 100644 (file)
--- 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.