net.lisp, sys.lisp: Merge packages.

Separate out the package defintion into a new file `net-package.lisp'.
Scatter the EXPORT directives so that they decorate the functions they
refer to.

This was prompted because of a dependency cycle in a CLisp-specific
part of sys.lisp.

diff --git a/net-package.lisp b/net-package.lisp
new file mode 100644 (file)
index 0000000..e9476f6
--- /dev/null
+++ b/net-package.lisp
@@ -0,0 +1,27 @@
+;;; -*-lisp-*-
+;;;
+;;; Package definitions for network utilities
+;;;
+;;; (c) 2011 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
+  (:use #:common-lisp #:mdw.base #:mdw.str #:collect))
+
+;;;----- That's all, folks --------------------------------------------------

diff --git a/net.lisp b/net.lisp
index 751ecfd..e764581 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -21,22 +21,6 @@
 ;;; along with this program; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 ;;; along with this program; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 

-;;;--------------------------------------------------------------------------
-;;; Packaging.
-
-(defpackage #:net
-  (: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
-            #:ipnet-pretty #:ipnet-string #:ipnet-broadcast #:ipnet-hosts
-            #:ipnet-host #:ipaddr-networkp #:ipnet-subnetp
-            #:ipnet-changeable-bytes
-          #:host-find #:host-create #:defhost #:parse-ipaddr
-            #:resolve-hostname #:canonify-hostname
-            #:net #:net-find #:net-get-as-ipnet #:net-create #:defnet
-            #:net-next-host #:net-host))
-

 (in-package #:net)
 
 ;;;--------------------------------------------------------------------------
 (in-package #:net)
 
 ;;;--------------------------------------------------------------------------


@@ -50,6 +34,7 @@
   "The type of unsigned 32-bit values."
   '(unsigned-byte 32))
 
   "The type of unsigned 32-bit values."
   '(unsigned-byte 32))
 

+(export 'ipaddr)

 (deftype ipaddr ()
   "The type of IP (version 4) addresses."
   'u32)
 (deftype ipaddr ()
   "The type of IP (version 4) addresses."
   'u32)


@@ -67,6 +52,7 @@
 ;;;--------------------------------------------------------------------------
 ;;; Simple messing with IP addresses.
 
 ;;;--------------------------------------------------------------------------
 ;;; Simple messing with IP addresses.
 

+(export 'string-ipaddr)

 (defun string-ipaddr (str &key (start 0) (end nil))
   "Parse STR as an IP address in dotted-quad form and return the integer
    equivalent.  STR may be anything at all: it's converted as if by
 (defun string-ipaddr (str &key (start 0) (end nil))
   "Parse STR as an IP address in dotted-quad form and return the integer
    equivalent.  STR may be anything at all: it's converted as if by


@@ -89,11 +75,13 @@
       (error "Wrong number of octets in IP address"))
     addr))
 
       (error "Wrong number of octets in IP address"))
     addr))
 

+(export 'ipaddr-byte)

 (defun ipaddr-byte (ip n)
   "Return byte N (from most significant downwards) of an IP address."
   (assert (<= 0 n 3))
   (logand #xff (ash ip (* -8 (- 3 n)))))
 
 (defun ipaddr-byte (ip n)
   "Return byte N (from most significant downwards) of an IP address."
   (assert (<= 0 n 3))
   (logand #xff (ash ip (* -8 (- 3 n)))))
 

+(export 'ipaddr-string)

 (defun ipaddr-string (ip)
   "Transform the address IP into a string in dotted-quad form."
   (check-type ip ipaddr)
 (defun ipaddr-string (ip)
   "Transform the address IP into a string in dotted-quad form."
   (check-type ip ipaddr)


@@ -101,6 +89,7 @@
                      (dotimes (i 4)
                        (collect (ipaddr-byte ip i))))))
 
                      (dotimes (i 4)
                        (collect (ipaddr-byte ip i))))))
 

+(export 'ipaddrp)

 (defun ipaddrp (ip)
   "Answer true if IP is a valid IP address in integer form."
   (typep ip 'ipaddr))
 (defun ipaddrp (ip)
   "Answer true if IP is a valid IP address in integer form."
   (typep ip 'ipaddr))


@@ -115,10 +104,12 @@
 ;;;--------------------------------------------------------------------------
 ;;; Netmasks.
 
 ;;;--------------------------------------------------------------------------
 ;;; Netmasks.
 

+(export 'integer-netmask)

 (defun integer-netmask (i)
   "Given an integer I, return a netmask with its I top bits set."
   (- (ash 1 32) (ash 1 (- 32 i))))
 
 (defun integer-netmask (i)
   "Given an integer I, return a netmask with its I top bits set."
   (- (ash 1 32) (ash 1 (- 32 i))))
 

+(export 'ipmask)

 (defun ipmask (ip)
   "Transform IP into a netmask.  If it's a small integer then it's converted
    by `integer-netmask'; if nil, then all-bits-set; otherwise convert using
 (defun ipmask (ip)
   "Transform IP into a netmask.  If it's a small integer then it's converted
    by `integer-netmask'; if nil, then all-bits-set; otherwise convert using


@@ -128,6 +119,7 @@
     ((integer 0 32) (integer-netmask ip))
     (t (ipaddr ip))))
 
     ((integer 0 32) (integer-netmask ip))
     (t (ipaddr ip))))
 

+(export 'ipmask-cidl-slash)

 (defun ipmask-cidl-slash (mask)
   "Given a netmask MASK, return an integer N such that (integer-netmask N) =
    MASK, or nil if this is impossible."
 (defun ipmask-cidl-slash (mask)
   "Given a netmask MASK, return an integer N such that (integer-netmask N) =
    MASK, or nil if this is impossible."


@@ -138,6 +130,7 @@
 ;;;--------------------------------------------------------------------------
 ;;; Networks: pairing an address and netmask.
 
 ;;;--------------------------------------------------------------------------
 ;;; Networks: pairing an address and netmask.
 

+(export 'make-ipnet)

 (defun make-ipnet (net mask)
   "Construct an IP-network object given the NET and MASK; these are
    transformed as though by `ipaddr' and `ipmask'."
 (defun make-ipnet (net mask)
   "Construct an IP-network object given the NET and MASK; these are
    transformed as though by `ipaddr' and `ipmask'."


@@ -145,6 +138,7 @@
        (mask (ipmask mask)))
     (cons (logand net mask) mask)))
 
        (mask (ipmask mask)))
     (cons (logand net mask) mask)))
 

+(export 'string-ipnet)

 (defun string-ipnet (str &key (start 0) (end nil))
   "Parse an IP-network from the string STR."
   (setf str (stringify str))
 (defun string-ipnet (str &key (start 0) (end nil))
   "Parse an IP-network from the string STR."
   (setf str (stringify str))


@@ -160,6 +154,7 @@
        (make-ipnet (parse-ipaddr (subseq str start end))
                    (integer-netmask 32)))))
 
        (make-ipnet (parse-ipaddr (subseq str start end))
                    (integer-netmask 32)))))
 

+(export 'ipnet)

 (defun ipnet (net)
   "Construct an IP-network object from the given argument.  A number of forms
    are acceptable:
 (defun ipnet (net)
   "Construct an IP-network object from the given argument.  A number of forms
    are acceptable:


@@ -171,14 +166,17 @@
   (cond ((or (stringp net) (symbolp net)) (string-ipnet net))
        (t (apply #'make-ipnet (pairify net 32)))))
 
   (cond ((or (stringp net) (symbolp net)) (string-ipnet net))
        (t (apply #'make-ipnet (pairify net 32)))))
 

+(export 'ipnet-net)

 (defun ipnet-net (ipn)
   "Return the base network address of IPN."
   (car ipn))
 
 (defun ipnet-net (ipn)
   "Return the base network address of IPN."
   (car ipn))
 

+(export 'ipnet-mask)

 (defun ipnet-mask (ipn)
   "Return the netmask of IPN."
   (cdr ipn))
 
 (defun ipnet-mask (ipn)
   "Return the netmask of IPN."
   (cdr ipn))
 

+(export 'with-ipnet)

 (defmacro with-ipnet ((net mask) ipn &body body)
   "Evaluate BODY with NET and MASK bound to the base address and netmask of
    IPN.  Either NET or MASK (or, less usefully, both) may be nil if not
 (defmacro with-ipnet ((net mask) ipn &body body)
   "Evaluate BODY with NET and MASK bound to the base address and netmask of
    IPN.  Either NET or MASK (or, less usefully, both) may be nil if not


@@ -189,12 +187,14 @@
             ,@(and mask `((,mask (ipnet-mask ,tmp)))))
         ,@body))))
 
             ,@(and mask `((,mask (ipnet-mask ,tmp)))))
         ,@body))))
 

+(export 'ipnet-pretty)

 (defun ipnet-pretty (ipn)
   "Convert IPN to a pretty cons-cell form."
   (with-ipnet (net mask) ipn
     (cons (ipaddr-string net)
          (or (ipmask-cidl-slash mask) (ipaddr-string mask)))))
 
 (defun ipnet-pretty (ipn)
   "Convert IPN to a pretty cons-cell form."
   (with-ipnet (net mask) ipn
     (cons (ipaddr-string net)
          (or (ipmask-cidl-slash mask) (ipaddr-string mask)))))
 

+(export 'ipnet-string)

 (defun ipnet-string (ipn)
   "Convert IPN to a string."
   (with-ipnet (net mask) ipn
 (defun ipnet-string (ipn)
   "Convert IPN to a string."
   (with-ipnet (net mask) ipn


@@ -202,15 +202,18 @@
            (ipaddr-string net)
            (or (ipmask-cidl-slash mask) (ipaddr-string mask)))))
 
            (ipaddr-string net)
            (or (ipmask-cidl-slash mask) (ipaddr-string mask)))))
 

+(export 'ipnet-broadcast)

 (defun ipnet-broadcast (ipn)
   "Return the broadcast address for the network IPN."
   (with-ipnet (net mask) ipn
     (logior net (logxor (mask 32) mask))))
 
 (defun ipnet-broadcast (ipn)
   "Return the broadcast address for the network IPN."
   (with-ipnet (net mask) ipn
     (logior net (logxor (mask 32) mask))))
 

+(export 'ipnet-hosts)

 (defun ipnet-hosts (ipn)
   "Return the number of available addresses in network IPN."
   (ash 1 (- 32 (logcount (ipnet-mask ipn)))))
 
 (defun ipnet-hosts (ipn)
   "Return the number of available addresses in network IPN."
   (ash 1 (- 32 (logcount (ipnet-mask ipn)))))
 

+(export 'ipnet-host)

 (defun ipnet-host (ipn host)
   "Return the address of the given HOST in network IPN.  This works even with
    a non-contiguous netmask."
 (defun ipnet-host (ipn host)
   "Return the address of the given HOST in network IPN.  This works even with
    a non-contiguous netmask."


@@ -231,11 +234,13 @@
        (setf m (ash m 1))
        (incf i)))))
 
        (setf m (ash m 1))
        (incf i)))))
 

+(export 'ipaddr-networkp)

 (defun ipaddr-networkp (ip ipn)
   "Returns true if address IP is within network IPN."
   (with-ipnet (net mask) ipn
     (= net (logand ip mask))))
 
 (defun ipaddr-networkp (ip ipn)
   "Returns true if address IP is within network IPN."
   (with-ipnet (net mask) ipn
     (= net (logand ip mask))))
 

+(export 'ipnet-subnetp)

 (defun ipnet-subnetp (ipn subn)
   "Returns true if SUBN is a (non-strict) subnet of IPN."
   (with-ipnet (net mask) ipn
 (defun ipnet-subnetp (ipn subn)
   "Returns true if SUBN is a (non-strict) subnet of IPN."
   (with-ipnet (net mask) ipn


@@ -243,6 +248,7 @@
       (and (= net (logand subnet mask))
           (= submask (logior mask submask))))))
 
       (and (= net (logand subnet mask))
           (= submask (logior mask submask))))))
 

+(export 'ipnet-changeable-bytes)

 (defun ipnet-changeable-bytes (mask)
   "Answers how many low-order bytes of MASK are (entirely or partially)
    changeable.  This is used when constructing reverse zones."
 (defun ipnet-changeable-bytes (mask)
   "Answers how many low-order bytes of MASK are (entirely or partially)
    changeable.  This is used when constructing reverse zones."


@@ -253,6 +259,7 @@
 ;;;--------------------------------------------------------------------------
 ;;; Host names and specifiers.
 
 ;;;--------------------------------------------------------------------------
 ;;; Host names and specifiers.
 

+(export 'parse-ipaddr)

 (defun parse-ipaddr (addr)
   "Convert the string ADDR into an IP address: tries all sorts of things:
 
 (defun parse-ipaddr (addr)
   "Convert the string ADDR into an IP address: tries all sorts of things:
 


@@ -287,18 +294,20 @@
 (defvar *hosts* (make-hash-table :test #'equal)
   "The table of known hostnames.")
 
 (defvar *hosts* (make-hash-table :test #'equal)
   "The table of known hostnames.")
 

+(export 'host-find)

 (defun host-find (name)
   "Find a host by NAME."
   (gethash (string-downcase (stringify name)) *hosts*))
 (defun host-find (name)
   "Find a host by NAME."
   (gethash (string-downcase (stringify name)) *hosts*))

-

 (defun (setf host-find) (addr name)
   "Make NAME map to ADDR (must be an ipaddr in integer form)."
   (setf (gethash (string-downcase (stringify name)) *hosts*) addr))
 
 (defun (setf host-find) (addr name)
   "Make NAME map to ADDR (must be an ipaddr in integer form)."
   (setf (gethash (string-downcase (stringify name)) *hosts*) addr))
 

+(export 'host-create)

 (defun host-create (name addr)
   "Make host NAME map to ADDR (anything acceptable to parse-ipaddr)."
   (setf (host-find name) (parse-ipaddr addr)))
 
 (defun host-create (name addr)
   "Make host NAME map to ADDR (anything acceptable to parse-ipaddr)."
   (setf (host-find name) (parse-ipaddr addr)))
 

+(export 'defhost)

 (defmacro defhost (name addr)
   "Main host definition macro.  Neither NAME nor ADDR is evaluated."
   `(progn
 (defmacro defhost (name addr)
   "Main host definition macro.  Neither NAME nor ADDR is evaluated."
   `(progn


@@ -308,6 +317,7 @@
 ;;;--------------------------------------------------------------------------
 ;;; Network names and specifiers.
 
 ;;;--------------------------------------------------------------------------
 ;;; Network names and specifiers.
 

+(export 'net)

 (defstruct (net (:predicate netp))
   "A network structure.  Slots:
 
 (defstruct (net (:predicate netp))
   "A network structure.  Slots:
 


@@ -323,14 +333,15 @@
 (defvar *networks* (make-hash-table :test #'equal)
   "The table of known networks.")
 
 (defvar *networks* (make-hash-table :test #'equal)
   "The table of known networks.")
 

+(export 'net-find)

 (defun net-find (name)
   "Find a network by NAME."
   (gethash (string-downcase (stringify name)) *networks*))
 (defun net-find (name)
   "Find a network by NAME."
   (gethash (string-downcase (stringify name)) *networks*))

-

 (defun (setf net-find) (net name)
   "Make NAME map to NET."
   (setf (gethash (string-downcase (stringify name)) *networks*) net))
 
 (defun (setf net-find) (net name)
   "Make NAME map to NET."
   (setf (gethash (string-downcase (stringify name)) *networks*) net))
 

+(export 'net-get-as-ipnet)

 (defun net-get-as-ipnet (form)
   "Transform FORM into an ipnet.  FORM may be a network name, or something
 acceptable to the ipnet function."
 (defun net-get-as-ipnet (form)
   "Transform FORM into an ipnet.  FORM may be a network name, or something
 acceptable to the ipnet function."


@@ -366,6 +377,7 @@ acceptable to the ipnet function."
        (cons (list root net mask)
              (frob subnets (+ net (ipnet-hosts ipn) 1) net))))))
 
        (cons (list root net mask)
              (frob subnets (+ net (ipnet-hosts ipn) 1) net))))))
 

+(export 'net-create)

 (defun net-create (name net)
   "Construct a new network called NAME and add it to the map.  The ARGS
    describe the new network, in a form acceptable to the ipnet function."
 (defun net-create (name net)
   "Construct a new network called NAME and add it to the map.  The ARGS
    describe the new network, in a form acceptable to the ipnet function."


@@ -376,6 +388,7 @@ acceptable to the ipnet function."
                    :hosts (ipnet-hosts ipn)
                    :next 1))))
 
                    :hosts (ipnet-hosts ipn)
                    :next 1))))
 

+(export 'defnet)

 (defmacro defnet (name net &rest subnets)
   "Main network definition macro.  None of the arguments is evaluated."
   `(progn
 (defmacro defnet (name net &rest subnets)
   "Main network definition macro.  None of the arguments is evaluated."
   `(progn


@@ -383,6 +396,7 @@ acceptable to the ipnet function."
            collect `(net-create ',name '(,addr . ,mask)))
     ',name))
 
            collect `(net-create ',name '(,addr . ,mask)))
     ',name))
 

+(export 'net-next-host)

 (defun net-next-host (net)
   "Given a NET, return the IP address (as integer) of the next available
    address in the network."
 (defun net-next-host (net)
   "Given a NET, return the IP address (as integer) of the next available
    address in the network."


@@ -392,6 +406,7 @@ acceptable to the ipnet function."
     (incf (net-next net))
     (net-host net next)))
 
     (incf (net-next net))
     (net-host net next)))
 

+(export 'net-host)

 (defun net-host (net host)
   "Return the given HOST on the NEXT.  HOST may be an index (in range, of
    course), or one of the keywords:
 (defun net-host (net host)
   "Return the given HOST on the NEXT.  HOST may be an index (in range, of
    course), or one of the keywords:

diff --git a/sys.lisp b/sys.lisp
index fc7180e..9f900f7 100644 (file)
--- a/sys.lisp
+++ b/sys.lisp
@@ -21,10 +21,7 @@
 ;;; along with this program; if not, write to the Free Software Foundation,
 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
 ;;; 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)
+(cl:in-package #:net)

 
 ;;;--------------------------------------------------------------------------
 ;;; Functions provided.
 
 ;;;--------------------------------------------------------------------------
 ;;; Functions provided.


@@ -34,6 +31,7 @@
   (name :pointer)
   (len :uint))
 
   (name :pointer)
   (len :uint))
 

+(export 'gethostname)

 (defun gethostname ()
   "Return the hostname (not necessarily canonical) of the current host."
 
 (defun gethostname ()
   "Return the hostname (not necessarily canonical) of the current host."
 


@@ -55,6 +53,7 @@
   #-(or cmu sbcl clisp ecl)
   "<unknown-host>")
 
   #-(or cmu sbcl clisp ecl)
   "<unknown-host>")
 

+(export 'resolve-hostname)

 (defun resolve-hostname (name)
   "Resolve a hostname to an IP address using the DNS, or return nil."
 
 (defun resolve-hostname (name)
   "Resolve a hostname to an IP address using the DNS, or return nil."
 


@@ -79,6 +78,7 @@
   #-(or cmu sbcl clisp ecl)
   nil)
 
   #-(or cmu sbcl clisp ecl)
   nil)
 

+(export 'canonify-hostname)

 (defun canonify-hostname (name)
   "Resolve a hostname to canonical form using the DNS, or return nil."
 
 (defun canonify-hostname (name)
   "Resolve a hostname to canonical form using the DNS, or return nil."
 

diff --git a/zone.asd b/zone.asd
index 8d44774..32cd09a 100644 (file)
--- a/zone.asd
+++ b/zone.asd
@@ -5,7 +5,8 @@
   :version "1.0.0"
   :author "Mark Wooding <mdw@distorted.org.uk>"
   :depends-on ("mdw" #+ecl "cffi" #+sbcl "sb-bsd-sockets")
   :version "1.0.0"
   :author "Mark Wooding <mdw@distorted.org.uk>"
   :depends-on ("mdw" #+ecl "cffi" #+sbcl "sb-bsd-sockets")

-  :components ((:file "sys")
+  :components ((:file "net-package")
+              (:file "sys")

               (:file "net")
               (:file "serv")
               (:file "zone")
               (:file "net")
               (:file "serv")
               (:file "zone")