Upgrade everything for SBCL.

While we're at it, isolate the system-specific stuff to its own sin-bin
for easier porting to other systems.

diff --git a/.gitignore b/.gitignore
index b94a63c..2335672 100644 (file)
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,4 @@
 *.x86f
 *.fas
 *.lib
+*.fasl

diff --git a/frontend.lisp b/frontend.lisp
index 46c5a36..1ff3e2f 100644 (file)
--- a/frontend.lisp
+++ b/frontend.lisp
@@ -1,7 +1,5 @@
 ;;; -*-lisp-*-
 ;;;
-;;; $Id$
-;;;
 ;;; Zone generator frontend
 ;;;
 ;;; (c) 2005 Straylight/Edgeware
@@ -24,7 +22,9 @@
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 (defpackage #:zone.frontend
-  (:use #:common-lisp #:optparse #:net #:zone)
+  (:use #:common-lisp #:optparse #:net #:zone
+       #+cmu #:mop
+       #+sbcl #:sb-mop)
   (:export #:main))
 (in-package #:zone.frontend)
 
@@ -60,14 +60,14 @@
                           (keyword opt-format
                                    (delete-duplicates
                                     (loop for method in
-                                          (pcl:generic-function-methods
+                                          (generic-function-methods
                                            #'zone:zone-write)
                                           for specs =
-                                          (pcl:method-specializers method)
+                                          (method-specializers method)
                                           if (typep (car specs)
-                                                    'pcl:eql-specializer)
+                                                    'eql-specializer)
                                           collect
-                                          (pcl:eql-specializer-object
+                                          (eql-specializer-object
                                            (car specs)))))
                           "Format to use for output.")
                      (#\z "zone" (:arg "NAME") (list opt-zones)

diff --git a/net.lisp b/net.lisp
index 28f10ef..751ecfd 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -1,7 +1,5 @@
 ;;; -*-lisp-*-
 ;;;
-;;; $Id$
-;;;
 ;;; Network (numbering) tools
 ;;;
 ;;; (c) 2006 Straylight/Edgeware
@@ -27,7 +25,7 @@
 ;;; Packaging.
 
 (defpackage #:net
-  (:use #:common-lisp #:mdw.base #:mdw.str #:collect)
+  (:use #:common-lisp #:mdw.base #:mdw.str #:collect #:net-sys)
   (:export #:ipaddr #:string-ipaddr #:ipaddr-byte #:ipaddr-string #:ipaddrp
           #:integer-netmask #:ipmask #:ipmask-cidl-slash #:make-ipnet
             #:string-ipnet #:ipnet #:ipnet-net #:ipnet-mask #:with-ipnet
@@ -253,27 +251,6 @@
       (return (- 4 i)))))
 
 ;;;--------------------------------------------------------------------------
-;;; Name resolution.
-
-(defun resolve-hostname (name)
-  "Resolve a hostname to an IP address using the DNS, or return nil."
-  #+cmu (let ((he (ext:lookup-host-entry name)))
-         (and he (ext:host-entry-addr he)))
-  #+clisp (let ((he (ext:resolve-host-ipaddr name)))
-           (and he (string-ipaddr (car (ext:hostent-addr-list he)))))
-  #+ecl (nth-value 2 (ext:lookup-host-entry name))
-  #-(or cmu clisp ecl) nil)
-
-(defun canonify-hostname (name)
-  "Resolve a hostname to canonical form using the DNS, or return nil."
-  #+cmu (let ((he (ext:lookup-host-entry name)))
-         (and he (ext:host-entry-name he)))
-  #+clisp (let ((he (ext:resolve-host-ipaddr name)))
-           (and he (ext:hostent-name he)))
-  #+ecl (nth-value 0 (ext:lookup-host-entry name))
-  #-(or cmu clisp ecl) name)
-
-;;;--------------------------------------------------------------------------
 ;;; Host names and specifiers.
 
 (defun parse-ipaddr (addr)

diff --git a/sys.lisp b/sys.lisp
new file mode 100644 (file)
index 0000000..fc7180e
--- /dev/null
+++ b/sys.lisp
@@ -0,0 +1,105 @@
+;;; -*-lisp-*-
+;;;
+;;; System-specific functions
+;;;
+;;; (c) 2008 Straylight/Edgeware
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+(cl:defpackage #:net-sys
+  (:use #:common-lisp)
+  (:export #:gethostname #:resolve-hostname #:canonify-hostname))
+(cl:in-package #:net-sys)
+
+;;;--------------------------------------------------------------------------
+;;; Functions provided.
+
+#+ecl
+(cffi:defcfun gethostname :int
+  (name :pointer)
+  (len :uint))
+
+(defun gethostname ()
+  "Return the hostname (not necessarily canonical) of the current host."
+
+  #+cmu
+  (unix:unix-gethostname)
+
+  #+sbcl
+  (sb-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))))
+
+  #-(or cmu sbcl clisp ecl)
+  "<unknown-host>")
+
+(defun resolve-hostname (name)
+  "Resolve a hostname to an IP address using the DNS, or return nil."
+
+  #+cmu
+  (let ((he (ext:lookup-host-entry name)))
+    (and he (ext:host-entry-addr he)))
+
+  #+sbcl
+  (handler-case
+      (let* ((he (sb-bsd-sockets:get-host-by-name name))
+            (addr (sb-bsd-sockets:host-ent-address he)))
+       (reduce (lambda (acc byte) (logior (ash acc 8) byte)) addr))
+    (sb-bsd-sockets:name-service-error () nil))
+
+  #+clisp
+  (let ((he (ext:resolve-host-ipaddr name)))
+    (and he (string-ipaddr (car (ext:hostent-addr-list he)))))
+
+  #+ecl
+  (nth-value 2 (ext:lookup-host-entry name))
+
+  #-(or cmu sbcl clisp ecl)
+  nil)
+
+(defun canonify-hostname (name)
+  "Resolve a hostname to canonical form using the DNS, or return nil."
+
+  #+cmu
+  (let ((he (ext:lookup-host-entry name)))
+    (and he (ext:host-entry-name he)))
+
+  #+sbcl
+  (handler-case
+      (let ((he (sb-bsd-sockets:get-host-by-name name)))
+       (sb-bsd-sockets:host-ent-name he))
+    (sb-bsd-sockets:name-service-error () nil))
+
+  #+clisp
+  (let ((he (ext:resolve-host-ipaddr name)))
+    (and he (ext:hostent-name he)))
+
+  #+ecl
+  (nth-value 0 (ext:lookup-host-entry name))
+
+  #-(or cmu sbcl clisp ecl)
+  name)
+
+;;;----- That's all, folks --------------------------------------------------

diff --git a/zone.asd b/zone.asd
index e16cef7..8d44774 100644 (file)
--- a/zone.asd
+++ b/zone.asd
@@ -4,8 +4,9 @@
   :description "Generation of DNS zone files"
   :version "1.0.0"
   :author "Mark Wooding <mdw@distorted.org.uk>"
-  :depends-on ("mdw" #+ecl "cffi")
-  :components ((:file "net")
+  :depends-on ("mdw" #+ecl "cffi" #+sbcl "sb-bsd-sockets")
+  :components ((:file "sys")
+              (:file "net")
               (:file "serv")
               (:file "zone")
               (:file "frontend"))

diff --git a/zone.lisp b/zone.lisp
index ea9fda3..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.")