X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/blobdiff_plain/2f1d381d7cf464f2ce50d6754a538d9e0fc89876..6343e7bf99d80d5c01ee598922058406fb0ebb62:/net.lisp?ds=sidebyside

diff --git a/net.lisp b/net.lisp
index 35e4340..2bbdcf0 100644
--- a/net.lisp
+++ b/net.lisp
@@ -1,7 +1,5 @@
 ;;; -*-lisp-*-
 ;;;
-;;; $Id$
-;;;
 ;;; Network (numbering) tools
 ;;;
 ;;; (c) 2006 Straylight/Edgeware
@@ -13,416 +11,944 @@
 ;;; 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.
 
-;;;--------------------------------------------------------------------------
-;;; Packaging.
-
-(defpackage #:net
-  (:use #:common-lisp #:mdw.base #:mdw.str #:collect)
-  (: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)
 
 ;;;--------------------------------------------------------------------------
-;;; Basic types.
+;;; Various random utilities.
 
+(declaim (inline mask))
 (defun mask (n)
   "Return 2^N - 1: i.e., a mask of N set bits."
   (1- (ash 1 n)))
 
-(deftype u32 ()
-  "The type of unsigned 32-bit values."
-  '(unsigned-byte 32))
+(defun find-first-bit-transition
+    (mask &optional (low 0) (high (integer-length mask)))
+  "Find the first (lowest bit-position) transition in MASK within the bounds.
 
-(deftype ipaddr ()
-  "The type of IP (version 4) addresses."
-  'u32)
+   The LOW bound is inclusive; the high bound is exclusive.  A transition is
+   a change from zero to one, or vice-versa.  The return value is the
+   upper (exclusive) bound on the initial run, and the lower (inclusive)
+   bound on the new run.
 
-;;;--------------------------------------------------------------------------
-;;; Various random utilities.
+   If there is no transition within the bounds, then return HIGH."
+
+  ;; Arrange that the initial run is ones.
+  (unless (logbitp low mask) (setf mask (lognot mask)))
+
+  ;; Now, note that MASK + 2^LOW is identical to MASK in all bit positions
+  ;; except for (a) the run of one bits starting at LOW, and (b) the zero bit
+  ;; just above it.  So MASK xor (MASK + 2^LOW) is zero except for these
+  ;; bits; so all we need now is to find the position of its most significant
+  ;; set bit.
+  (let ((pos (1- (integer-length (logxor mask (+ mask (ash 1 low)))))))
+    (if (<= low pos high) pos high)))
 
 (defun count-low-zero-bits (n)
   "Return the number of low-order zero bits in the integer N."
-  (if (zerop n) nil
-      (loop for i from 0
-	    until (logbitp i n)
-	    finally (return i))))
+  (cond ((zerop n) nil)
+	((oddp n) 0)
+	(t (find-first-bit-transition n))))
+
+(declaim (inline round-down))
+(defun round-down (n step)
+  "Return the largest multiple of STEP not greater than N."
+  (* step (floor n step)))
+
+(declaim (inline round-up))
+(defun round-up (n step)
+  "Return the smallest multiple of STEP not less than N."
+  (* step (ceiling n step)))
+
+(defgeneric extract-class-name (object)
+  (:documentation "Turn OBJECT into a class name.")
+  (:method ((instance standard-object))
+    (extract-class-name (class-of instance)))
+  (:method ((class standard-class))
+    (class-name class))
+  (:method ((name symbol))
+    name))
+
+(defclass savable-object ()
+  ())
+(defmethod make-load-form ((object savable-object) &optional environment)
+  (make-load-form-saving-slots object :environment environment))
 
 ;;;--------------------------------------------------------------------------
-;;; Simple messing with IP addresses.
+;;; Parsing primitives for addresses.
+
+(defun parse-partial-address
+    (str
+     &key (start 0) (end nil) (delim #\.)
+	  (width 8) (radix 10) (min 1) (max 32) (shiftp t)
+	  (what "address"))
+  "Parse a partial address from STR, which should be a sequence of integers
+   in the given RADIX, separated by the DELIM character, with each integer
+   N_i in the interval 0 <= N_i < 2^WIDTH.  If the sequence is N_1, N_2, ...,
+   N_k, then the basic partial address BPA is the sum
+
+	SUM_{1<=i<=k} 2^{WIDTH (k-i)} N_i
+
+   If SHIFTP is true (the default) then let OFFSET be the smallest multiple
+   of WIDTH not less than MAX - k WIDTH; otherwise, let OFFSET be zero.  The
+   partial address PA is BPA 2^SHIFT.
+
+   The return values are: PA, OFFSET, k WIDTH + OFFSET; i.e., the partial
+   address, and (inclusive) lower and (exclusive) upper bounds on the bits
+   specified by STR."
+
+  (setf-default end (length str))
+  (let ((addr 0) (nbits 0) (limit (ash 1 width)))
+    (when (< start end)
+      (loop
+	(when (>= nbits max)
+	  (error "Too many elements in ~A" what))
+	(let* ((pos (position delim str :start start :end end))
+	       (w (parse-integer str :radix radix
+				 :start start :end (or pos end))))
+	  (unless (and (<= 0 w) (< w limit))
+	    (error "Element out of range in ~A" what))
+	  (setf addr (logior (ash addr width) w))
+	  (incf nbits width)
+	  (unless pos (return))
+	  (setf start (1+ pos)))))
+    (when (< nbits min)
+      (error "Not enough elements in ~A" what))
+    (if shiftp
+	(let* ((top (round-up max width))
+	       (shift (- top nbits)))
+	  (values (ash addr shift) shift top))
+	(values addr 0 nbits))))
+
+;;;--------------------------------------------------------------------------
+;;; Simple messing about with IP addresses.
+
+(export 'ipaddr)
+(export 'ipaddr-addr)
+(defclass ipaddr (savable-object)
+  ()
+  (:documentation
+   "Base class for IP addresses."))
 
+(export 'ipaddr-family)
+(defgeneric ipaddr-family (addr))
+
+(export 'family-addrclass)
+(defgeneric family-addrclass (family)
+  (:method ((af symbol)) nil))
+
+(export 'ipaddr-width)
+(defgeneric ipaddr-width (class)
+  (:method ((object t)) (ipaddr-width (extract-class-name object))))
+
+(export 'ipaddr-comparable-p)
+(defgeneric ipaddr-comparable-p (addr-a addr-b)
+  (:method ((addr-a ipaddr) (addr-b ipaddr))
+    (eq (class-of addr-a) (class-of addr-b))))
+
+(defun guess-address-class (str &key (start 0) (end nil))
+  (cond ((position #\: str :start start :end end) 'ip6addr)
+	(t 'ip4addr)))
+
+(defgeneric parse-partial-ipaddr (class str &key start end min max)
+  (:method ((object t) str &rest keywords)
+    (apply #'parse-partial-ipaddr (extract-class-name object) str keywords)))
+
+(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
-   `stringify'.  The START and END arguments may be used to parse out a
-   substring."
-  (setf str (stringify str))
-  (unless end
-    (setf end (length str)))
-  (let ((addr 0) (noct 0))
-    (loop
-      (let* ((pos (position #\. str :start start :end end))
-	     (i (parse-integer str :start start :end (or pos end))))
-	(unless (<= 0 i 256)
-	  (error "IP address octet out of range"))
-	(setf addr (+ (* addr 256) i))
-	(incf noct)
-	(unless pos
-	  (return))
-	(setf start (1+ pos))))
-    (unless (= noct 4)
-      (error "Wrong number of octets in IP address"))
-    addr))
-
-(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-string (ip)
-  "Transform the address IP into a string in dotted-quad form."
-  (check-type ip ipaddr)
-  (join-strings #\. (collecting ()
-		      (dotimes (i 4)
-			(collect (ipaddr-byte ip i))))))
+  "Parse STR into an address; guess what kind is intended by the user.
 
+   STR may be anything at all: it's converted as if by `stringify'.
+   The START and END arguments may be used to parse out a substring."
+  (setf str (stringify str))
+  (let* ((class (guess-address-class str :start start :end end))
+	 (width (ipaddr-width class)))
+    (make-instance class :addr
+		   (parse-partial-ipaddr class str
+					 :start start :end end
+					 :min width :max width))))
+
+(export 'integer-ipaddr)
+(defgeneric integer-ipaddr (int like)
+  (:documentation "Convert INT into an address of type indicated by LIKE.
+
+   Specifically, if LIKE is an address object, then use its type; if it's
+   a class, then use it directly; if it's a symbol, then use the class it
+   names.")
+  (:method (int (like t)) (integer-ipaddr int (class-of like)))
+  (:method (int (like symbol))
+    (make-instance (or (family-addrclass like) like) :addr int))
+  (:method (int (like standard-class)) (make-instance like :addr int)))
+
+(export 'ipaddr-string)
+(defgeneric ipaddr-string (ip)
+  (:documentation
+   "Transform the address IP into a string in dotted-quad form."))
+
+(defmethod print-object ((addr ipaddr) stream)
+  (print-unreadable-object (addr stream :type t)
+    (write-string (ipaddr-string addr) stream)))
+
+(export 'ipaddrp)
 (defun ipaddrp (ip)
   "Answer true if IP is a valid IP address in integer form."
   (typep ip 'ipaddr))
 
-(defun ipaddr (ip)
-  "Convert IP to an IP address.  If it's an integer, return it unchanged;
-   otherwise convert by `string-ipaddr'."
+(defun ipaddr (ip &optional like)
+  "Convert IP to an IP address, of type similar to LIKE.
+
+   If it's an IP address, just return it unchanged; If it's an integer,
+   capture it; otherwise convert by `string-ipaddr'."
   (typecase ip
     (ipaddr ip)
+    (integer (integer-ipaddr ip like))
     (t (string-ipaddr ip))))
 
+(export 'ipaddr-rrtype)
+(defgeneric ipaddr-rrtype (addr)
+  (:documentation "Return the proper resource record type for ADDR."))
+
 ;;;--------------------------------------------------------------------------
 ;;; Netmasks.
 
-(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 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
-   `ipaddr'."
-  (typecase ip
-    (null (mask 32))
-    ((integer 0 32) (integer-netmask ip))
-    (t (ipaddr ip))))
-
-(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."
-  (dotimes (i 33)
-    (when (= mask (integer-netmask i))
-      (return i))))
+(export 'integer-netmask)
+(defun integer-netmask (n i)
+  "Given an integer I, return an N-bit netmask with its I top bits set."
+  (- (ash 1 n) (ash 1 (- n i))))
+
+(export 'ipmask-cidl-slash)
+(defun ipmask-cidl-slash (width mask)
+  "Given a netmask MASK, try to compute a prefix length.
+
+   Return an integer N such that (integer-netmask WIDTH N) = MASK, or nil if
+   this is impossible."
+  (let* ((low (logxor mask (mask width)))
+	 (bits (integer-length low)))
+    (and (= low (mask bits)) (- width bits))))
+
+(export 'ipmask)
+(defgeneric ipmask (addr mask)
+  (:documentation "Convert MASK into a suitable netmask for ADDR.")
+  (:method ((addr ipaddr) (mask null))
+    (mask (ipaddr-width addr)))
+  (:method ((addr ipaddr) (mask integer))
+    (let ((w (ipaddr-width addr)))
+      (if (<= 0 mask w)
+	  (integer-netmask w mask)
+	  (error "Prefix length out of range.")))))
+
+(export 'mask-ipaddr)
+(defun mask-ipaddr (addr mask)
+  "Apply the MASK to the ADDR, returning the base address."
+  (integer-ipaddr (logand mask (ipaddr-addr addr)) addr))
 
 ;;;--------------------------------------------------------------------------
 ;;; Networks: pairing an address and netmask.
 
-(defun make-ipnet (net mask)
-  "Construct an IP-network object given the NET and MASK; these are
-   transformed as though by `ipaddr' and `ipmask'."
-  (let ((net (ipaddr net))
-	(mask (ipmask mask)))
-    (cons (logand net mask) mask)))
+(export 'ipnet)
+(export 'ipnet-net)
+(export 'ipnet-mask)
+(defclass ipnet (savable-object)
+  ()
+  (:documentation "Base class for IP networks."))
 
-(defun string-ipnet (str &key (start 0) (end nil))
-  "Parse an IP-network from the string STR."
-  (setf str (stringify str))
-  (unless end (setf end (length str)))
-  (let ((sl (position #\/ str :start start :end end)))
-    (if sl
-	(make-ipnet (parse-ipaddr (subseq str start sl))
-		    (if (find #\. str :start (1+ sl) :end end)
-			(string-ipaddr str :start (1+ sl) :end end)
-			(integer-netmask (parse-integer str
-							:start (1+ sl)
-							:end end))))
-	(make-ipnet (parse-ipaddr (subseq str start end))
-		    (integer-netmask 32)))))
+(export 'ipnet-family)
+(defgeneric ipnet-family (ipn)
+  (:method ((ipn ipnet)) (ipaddr-family (ipnet-net ipn))))
 
-(defun ipnet (net)
-  "Construct an IP-network object from the given argument.  A number of forms
-   are acceptable:
+(export 'ipnet-addr)
+(defun ipnet-addr (ipn)
+  "Return the base network address of IPN as a raw integer."
+  (ipaddr-addr (ipnet-net ipn)))
 
-     * ADDR -- a single address (equivalent to ADDR 32)
-     * (NET . MASK|nil) -- a single-object representation.
-     * IPNET -- return an equivalent (`equal', not necessarily `eql')
-       version."
-  (cond ((or (stringp net) (symbolp net)) (string-ipnet net))
-	(t (apply #'make-ipnet (pairify net 32)))))
+(export 'ipaddr-ipnet)
+(defgeneric ipaddr-ipnet (addr mask)
+  (:documentation "Construct an `ipnet' object given a base ADDR and MASK."))
 
-(defun ipnet-net (ipn)
-  "Return the base network address of IPN."
-  (car ipn))
+(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'."
+  (let* ((net (ipaddr net))
+	 (mask (ipmask net mask)))
+    (ipaddr-ipnet (mask-ipaddr net mask) mask)))
 
-(defun ipnet-mask (ipn)
-  "Return the netmask of IPN."
-  (cdr ipn))
+(export 'with-ipnet)
+(defmacro with-ipnet ((net addr mask) ipn &body body)
+  "Evaluate the BODY with components of IPN in scope.
 
-(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
+   The NET is bound to the underlying network base address, as an `ipaddr';
+   ADDR is bound to the integer value of this address; and MASK is bound to
+   the netmask, again as an integer.  Any (or all) of these may be nil if not
    wanted."
   (with-gensyms tmp
     `(let ((,tmp ,ipn))
        (let (,@(and net `((,net (ipnet-net ,tmp))))
+	     ,@(and addr `((,addr (ipnet-addr ,tmp))))
 	     ,@(and mask `((,mask (ipnet-mask ,tmp)))))
 	 ,@body))))
 
-(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-width)
+(defun ipnet-width (ipn)
+  "Return the underlying bit width of the addressing system."
+  (ipaddr-width (ipnet-net ipn)))
 
+(export 'ipnet-string)
 (defun ipnet-string (ipn)
   "Convert IPN to a string."
-  (with-ipnet (net mask) ipn
+  (with-ipnet (net nil mask) ipn
     (format nil "~A/~A"
 	    (ipaddr-string net)
-	    (or (ipmask-cidl-slash mask) (ipaddr-string mask)))))
+	    (or (ipmask-cidl-slash (ipnet-width ipn) mask)
+		(ipaddr-string (make-instance (class-of net) :addr mask))))))
+
+(defmethod print-object ((ipn ipnet) stream)
+  (print-unreadable-object (ipn stream :type t)
+    (write-string (ipnet-string ipn) stream)))
+
+(defun parse-subnet (class width max str &key (start 0) (end nil) (slashp t))
+  "Parse a subnet description from a (substring of) STR."
+  (setf-default end (length str))
+  (let ((sl (and slashp (position #\/ str :start start :end end))))
+    (multiple-value-bind (addr lo hi)
+	(parse-partial-ipaddr class str :max max
+			      :start start :end (or sl end))
+      (let* ((present (integer-netmask hi (- hi lo)))
+	     (mask (cond ((not sl)
+			  present)
+			 ((every #'digit-char-p (subseq str (1+ sl) end))
+			  (let ((length (parse-integer str
+						       :start (1+ sl)
+						       :end end)))
+			    (unless (>= length (- width max))
+			      (error "Mask doesn't reach subnet boundary"))
+			    (integer-netmask max (- length (- width max)))))
+			 (t
+			  (parse-partial-ipaddr class str :max max
+						:start (1+ sl) :end end)))))
+	(unless (zerop (logandc2 mask present))
+	  (error "Mask selects bits not present in base address"))
+	(values addr mask)))))
+
+(defun check-subipnet (base-ipn sub-addr sub-mask)
+  "Verify that SUB-NET/SUB-MASK is an appropriate subnet of BASE-IPN.
+
+   The BASE-IPN is an `ipnet'; SUB-ADDR and SUB-MASK are plain integers.  If
+   the subnet is invalid (i.e., the subnet disagrees with its putative parent
+   over some of the fixed address bits) then an error is signalled; otherwise
+   return the combined base address (as an `ipaddr') and mask (as an
+   integer)."
+  (with-ipnet (base-net base-addr base-mask) base-ipn
+    (let* ((common (logand base-mask sub-mask))
+	   (base-overlap (logand base-addr common))
+	   (sub-overlap (logand sub-addr common))
+	   (full-mask (logior base-mask sub-mask)))
+      (unless (or (zerop sub-overlap) (= sub-overlap base-overlap))
+	(error "Subnet doesn't match base network"))
+      (values (integer-ipaddr (logand full-mask (logior base-addr sub-addr))
+			      base-net)
+	      full-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))
+  (setf-default end (length str))
+  (let ((addr-class (guess-address-class str :start start :end end)))
+    (multiple-value-bind (addr mask)
+	(let ((width (ipaddr-width addr-class)))
+	  (parse-subnet addr-class width width str
+			:start start :end end))
+      (make-ipnet (make-instance addr-class :addr addr)
+		  (make-instance addr-class :addr mask)))))
+
+(defun parse-subipnet (ipn str &key (start 0) (end nil) (slashp t))
+  "Parse STR as a subnet of IPN.
+
+   This is mostly a convenience interface over `parse-subnet'."
+  (let* ((addr-class (extract-class-name (ipnet-net ipn)))
+	 (width (ipaddr-width addr-class))
+	 (max (- width
+		 (or (ipmask-cidl-slash width (ipnet-mask ipn))
+		     (error "Base network has complex netmask")))))
+    (multiple-value-bind (addr mask)
+	(parse-subnet addr-class width max (stringify str)
+		      :start start :end end :slashp slashp)
+      (check-subipnet ipn addr mask))))
+
+(export 'string-subipnet)
+(defun string-subipnet (ipn str &key (start 0) (end nil))
+  "Parse an IP subnet from a parent net IPN and a suffix string STR."
+  (multiple-value-bind (addr mask)
+      (parse-subipnet ipn str :start start :end end)
+    (ipaddr-ipnet addr mask)))
 
-(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 (net)
+  "Construct an IP-network object from the given argument.
 
+   A number of forms are acceptable:
+
+     * ADDR -- a single address, equivalent to (ADDR . N).
+     * (NET . MASK|nil) -- a single-object representation.
+     * IPNET -- return an equivalent (`equal', not necessarily `eql')
+       version."
+  (typecase net
+    (ipnet net)
+    ((or string symbol) (string-ipnet net))
+    (t (apply #'make-ipnet (pairify net nil)))))
+
+(export 'ipnet-broadcast)
+(defgeneric ipnet-broadcast (ipn)
+  (:documentation "Return the broadcast address for the network IPN.
+
+   Returns nil if there isn't one."))
+
+(export 'ipnet-hosts)
 (defun ipnet-hosts (ipn)
   "Return the number of available addresses in network IPN."
-  (ash 1 (- 32 (logcount (ipnet-mask ipn)))))
+  (ash 1 (- (ipnet-width ipn) (logcount (ipnet-mask ipn)))))
+
+(defstruct host-map
+  "An internal object used by `ipnet-index-host' and `ipnet-host-index'.
 
+   Our objective is to be able to convert between flat host indices and a
+   possibly crazy non-flat host space.  We record the underlying IPNET for
+   convenience, and a list of byte-specifications for the runs of zero bits
+   in the netmask, in ascending order."
+  ipnet
+  bytes)
+
+(export 'ipnet-host-map)
+(defun ipnet-host-map (ipn)
+  "Work out how to enumerate the variable portion of IPN.
+
+   Returns an object which can be passed to `ipnet-index-host' and
+   `ipnet-host-index'."
+  (let* ((mask (ipnet-mask ipn)) (bytes nil) (i 0)
+	 (len (integer-length mask)) (width (ipnet-width ipn)))
+    (when (logbitp i mask) (setf i (find-first-bit-transition mask i)))
+    (loop
+      (unless (< i len) (return))
+      (let ((next (find-first-bit-transition mask i width)))
+	(push (byte (- next i) i) bytes)
+	(setf i (find-first-bit-transition mask next width))))
+    (when (< len width) (push (byte (- width len) len) bytes))
+    (make-host-map :ipnet ipn :bytes (nreverse bytes))))
+
+(export 'ipnet-index-host)
+(defun ipnet-index-host (map host)
+  "Convert a HOST index to its address."
+  (let* ((ipn (host-map-ipnet map))
+	 (addr (logand (ipnet-addr ipn) (ipnet-mask ipn))))
+    (dolist (byte (host-map-bytes map))
+      (setf (ldb byte addr) host
+	    host (ash host (- (byte-size byte)))))
+    (unless (zerop host)
+      (error "Host index out of range."))
+    (integer-ipaddr addr (ipnet-net ipn))))
+
+(export 'ipnet-host-index)
+(defun ipnet-host-index (map addr)
+  "Convert an ADDR into a host index."
+  (let ((addr (ipaddr-addr addr))
+	(host 0) (offset 0))
+    (dolist (byte (host-map-bytes map))
+      (setf host (logior host
+			 (ash (ldb byte addr) offset))
+	    offset (+ offset (byte-size byte))))
+    host))
+
+(export 'ipnet-index-bounds)
+(defun ipnet-index-bounds (map start end)
+  "Return host-index bounds corresponding to the given bit-position bounds."
+  (flet ((hack (frob-map good-byte tweak-addr)
+	   (dolist (byte (funcall frob-map (host-map-bytes map)))
+	     (let* ((low (byte-position byte))
+		    (high (+ low (byte-size byte)))
+		    (good (funcall good-byte low high)))
+	       (when good
+		 (return-from hack
+		   (ipnet-host-index map
+				     (ipaddr (funcall tweak-addr
+						      (ash 1 good))
+					     (ipnet-net
+					      (host-map-ipnet map))))))))
+	   (error "No variable bits in range.")))
+    (values (hack #'identity
+		  (lambda (low high)
+		    (and (< start high) (max start low)))
+		  #'identity)
+	    (hack #'reverse
+		  (lambda (low high)
+		    (and (>= end low) (min end high)))
+		  #'1-))))
+
+(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."
-  (check-type host u32)
-  (with-ipnet (net mask) ipn
-    (let ((i 0) (m 1) (a net) (h host))
-      (loop
-        (when (>= i 32)
-	  (error "Host index ~D out of range for network ~A"
-		 host (ipnet-pretty ipn)))
-        (cond ((zerop h)
-	       (return a))
-	      ((logbitp i mask)
-	       (setf h (ash h 1)))
-	      (t
-	       (setf a (logior a (logand m h)))
-	       (setf h (logandc2 h m))))
-	(setf m (ash m 1))
-	(incf i)))))
+  "Return the address of the given HOST in network IPN.
 
+   This works even with a non-contiguous netmask."
+  (ipnet-index-host (ipnet-host-map ipn) host))
+
+(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))))
+  "Returns true if numeric address IP is within network IPN."
+  (with-ipnet (nil addr mask) ipn
+    (= addr (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
-    (with-ipnet (subnet submask) subn
-      (and (= net (logand subnet mask))
+  (with-ipnet (net addr mask) ipn
+    (with-ipnet (subnet subaddr submask) subn
+      (and (ipaddr-comparable-p net subnet)
+	   (= addr (logand subaddr mask))
 	   (= submask (logior mask submask))))))
 
-(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."
-  (dotimes (i 4 4)
-    (when (/= (ipaddr-byte mask i) 255)
-      (return (- 4 i)))))
+(export 'ipnet-overlapp)
+(defun ipnet-overlapp (ipn-a ipn-b)
+  "Returns true if IPN-A and IPN-B have any addresses in common."
+  (with-ipnet (net-a addr-a mask-a) ipn-a
+    (with-ipnet (net-b addr-b mask-b) ipn-b
+
+      ;; In the case of an overlap, we explicitly construct a common
+      ;; address.  If this fails, we know that the networks don't overlap
+      ;; after all.
+      (flet ((narrow (addr-a mask-a addr-b mask-b)
+	       ;; Narrow network A towards B, by setting bits in A's base
+	       ;; address towards which A is indifferent, but B is not;
+	       ;; return the resulting base address.  This address is still
+	       ;; within network A, since we only set bits to which A is
+	       ;; indifferent.
+	       (logior addr-a (logand addr-b (logandc2 mask-a mask-b)))))
+
+	(and (ipaddr-comparable-p net-a net-b)
+	     (= (narrow addr-a mask-a addr-b mask-b)
+		(narrow addr-b mask-b addr-a mask-a)))))))
+
+(export 'ipnet-changeable-bits)
+(defun ipnet-changeable-bits (width mask)
+  "Work out the number of changeable bits in a network, given its MASK.
+
+   This is a conservative estimate in the case of noncontiguous masks.  The
+   WIDTH is the total width of an address."
+
+  ;; We bisect the address.  If the low-order bits are changeable then we
+  ;; recurse on them; otherwise we look at the high-order bits.  A mask M of
+  ;; width W is changeable if it's not all-ones, i.e., if M /= 2^W.  If the
+  ;; top half is changeable then we don't need to look at the bottom half.
+  (labels ((recurse (width mask offset)
+	     (if (= width 1)
+		 (if (zerop mask) (1+ offset) offset)
+		 (let* ((lowwidth (floor width 2))
+			(highwidth (- width lowwidth))
+			(highmask (ash mask (- lowwidth))))
+		   (if (logbitp highwidth (1+ highmask))
+		       (recurse lowwidth
+				(logand mask (mask lowwidth))
+				offset)
+		       (recurse highwidth highmask (+ offset lowwidth)))))))
+    (recurse width mask 0)))
+
+;;;--------------------------------------------------------------------------
+;;; Reverse lookups.
+
+(export 'reverse-domain-component-width)
+(defgeneric reverse-domain-component-width (ipaddr)
+  (:documentation "Return the component width for splitting IPADDR."))
+
+(export 'reverse-domain-component-radix)
+(defgeneric reverse-domain-radix (ipaddr)
+  (:documentation "Return the radix for representing IPADDR components."))
+
+(export 'reverse-domain-component-suffix)
+(defgeneric reverse-domain-suffix (ipaddr)
+  (:documentation "Return the reverse-lookup domain suffix for IPADDR."))
+
+(export 'reverse-domain-fragment)
+(defgeneric reverse-domain-fragment (ipaddr start end &key partialp)
+  (:documentation
+   "Return a portion of an IPADDR's reverse-resolution domain name.
+
+   Specifically, return the portion of the name which covers the bits of an
+   IPADDR between bits START (inclusive) and END (exclusive).  Address
+   components which are only partially within the given bounds are included
+   unless PARTIALP is nil.")
+  (:method ((ipaddr ipaddr) start end &key (partialp t))
+
+    (let ((addr (ipaddr-addr ipaddr))
+	  (comp-width (reverse-domain-component-width ipaddr))
+	  (radix (reverse-domain-radix ipaddr)))
+
+      (with-output-to-string (out)
+	(do ((i (funcall (if partialp #'round-down #'round-up)
+			 start comp-width)
+		(+ i comp-width))
+	     (limit (funcall (if partialp #'round-up #'round-down)
+			     end comp-width))
+	     (sep nil t))
+	    ((>= i limit))
+	  (format out "~:[~;.~]~(~vR~)"
+		  sep radix (ldb (byte comp-width i) addr)))))))
+
+(export 'reverse-domain)
+(defgeneric reverse-domain (ipaddr-or-ipn &optional prefix-len)
+  (:documentation "Return a reverse-resolution domain name for IPADDR-OR-IPN.
+
+   If PREFIX-LEN is nil then it defaults to the length of the network's fixed
+   prefix.")
+  (:method ((ipn ipnet) &optional prefix-len)
+    (let* ((addr (ipnet-net ipn))
+	   (mask (ipnet-mask ipn))
+	   (width (ipaddr-width addr)))
+      (concatenate 'string
+		   (reverse-domain-fragment
+		    addr
+		    (if prefix-len
+			(- width prefix-len)
+			(ipnet-changeable-bits width mask))
+		    width
+		    :partialp nil)
+		   "."
+		   (reverse-domain-suffix addr))))
+  (:method ((addr ipaddr) &optional prefix-len)
+    (let* ((width (ipaddr-width addr)))
+      (reverse-domain (make-ipnet addr (mask width))
+		      (or prefix-len width)))))
 
 ;;;--------------------------------------------------------------------------
-;;; Name resolution.
-
-#+cmu
-(defun resolve-hostname (name)
-  "Resolve a hostname to an IP address using the DNS, or return nil."
-  (let ((he (ext:lookup-host-entry name)))
-    (and he
-	 (ext:host-entry-addr he))))
-
-#+cmu
-(defun canonify-hostname (name)
-  "Resolve a hostname to canonical form using the DNS, or return nil."
-  (let ((he (ext:lookup-host-entry name)))
-    (and he
-	 (ext:host-entry-name he))))
+;;; Network names and specifiers.
+
+(export 'net)
+(export 'net-name)
+(export 'net-ipnets)
+(defclass net ()
+  ((name :type string :initarg :name :reader net-name)
+   (ipnets :type list :initarg :ipnets :initform nil :accessor net-ipnets)
+   (next :type unsigned-byte :initform 1 :accessor net-next)))
+
+(defmethod print-object ((net net) stream)
+  (print-unreadable-object (net stream :type t)
+    (format stream "~A~@[ = ~{~A~^, ~}~]"
+	    (net-name net)
+	    (mapcar #'ipnet-string (net-ipnets net)))))
+
+(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 (setf net-find) (net name)
+  "Make NAME map to NET."
+  (setf (gethash (string-downcase (stringify name)) *networks*) net))
+
+(export 'net-must-find)
+(defun net-must-find (name)
+  (or (net-find name)
+      (error "Unknown network ~A." name)))
+
+(defun net-ipnet (net family)
+  (find family (net-ipnets net) :key #'ipnet-family))
+(defun (setf net-ipnet) (ipnet net family)
+  (assert (eq (ipnet-family ipnet) family))
+  (let ((ipns (net-ipnets net)))
+    (if (find family ipns :key #'ipnet-family)
+	(nsubstitute ipnet family ipns :key #'ipnet-family)
+	(setf (net-ipnets net) (cons ipnet ipns)))))
+
+(defun process-net-form (name addr subnets)
+  "Unpack a net-form.
+
+   A net-form looks like (NAME ADDR [SUBNET ...]) where:
+
+     * NAME is the name for the network.
+
+     * ADDR is the subnet address (acceptable to `string-subipnet'); at
+       top-level, this is a plain network address (acceptable to
+       `string-ipnet').  Alternatively (for compatibility) the ADDR for a
+       non-top-level network can be an integer number of addresses to
+       allocate to this subnet; the subnet's base address is implicitly just
+       past the previous subnet's limit address (or, for the first subnet,
+       it's the parent network's base address).  This won't work at all well
+       if your subnets have crazy netmasks.
+
+     * The SUBNETs are further net-forms, of the same form, whose addresses
+       are interpreted relative to the parent network's address.
+
+   The return value is a list of items of the form (NAME . IPNET)."
+
+  (labels ((process-subnets (subnets parent)
+	     (let ((finger (ipnet-addr parent))
+		   (list nil))
+	       (dolist (subnet subnets list)
+		 (destructuring-bind (name addr &rest subs) subnet
+		   (let ((net (etypecase addr
+				(integer
+				 (when (or (> (count-low-zero-bits addr)
+					      (count-low-zero-bits finger))
+					   (not (zerop (logand addr
+							       (1- addr)))))
+				   (error "Bad subnet size for ~A." name))
+				 (make-ipnet
+				  (ipaddr finger (ipnet-net parent))
+				  (ipaddr (- (ash 1 (ipnet-width parent))
+					     addr)
+					  (ipnet-net parent))))
+				((or string symbol)
+				 (string-subipnet parent addr)))))
+
+		     (unless (ipnet-subnetp parent net)
+		       (error "Network `~A' (~A) falls outside parent ~A."
+			      name (ipnet-string net) (ipnet-string parent)))
+
+		     (dolist (entry list nil)
+		       (let ((ipn (cdr entry)))
+			 (when (ipnet-overlapp ipn net)
+			   (error "Network `~A' (~A) overlaps `~A' (~A)."
+				  name (ipnet-string net)
+				  (car entry) (ipnet-string ipn)))))
+
+		     (setf finger
+			   (1+ (logior
+				(ipnet-addr net)
+				(logxor (ipnet-mask net)
+					(1- (ash 1 (ipnet-width net)))))))
+
+		     (when name
+		       (push (cons name net) list))
+
+		     (when subs
+		       (setf list (nconc (process-subnets subs net)
+					 list)))))))))
+
+    (let* ((top (string-ipnet addr))
+	   (list (nreverse (process-subnets subnets top))))
+      (when name (push (cons name top) list))
+      list)))
+
+(export 'net-create)
+(defun net-create (name net)
+  "Construct a new network called NAME and add it to the map.
+
+   The NET describes the new network, in a form acceptable to the `ipnet'
+   function.  A named network may have multiple addresses with different
+   families: each `net-create' call adds a new family, or modifies the net's
+   address in an existing family."
+  (let ((ipn (ipnet net))
+	(net (net-find name)))
+    (if net
+	(progn (setf (net-ipnet net (ipnet-family ipn)) ipn) net)
+	(setf (net-find name)
+	      (make-instance 'net
+			     :name (string-downcase (stringify name))
+			     :ipnets (list ipn))))))
+
+(export 'defnet)
+(defmacro defnet (name net &rest subnets)
+  "Main network definition macro.
+
+   None of the arguments is evaluated."
+  `(progn
+     ,@(mapcar (lambda (item)
+		 (let ((name (car item)) (ipn (cdr item)))
+		   `(net-create ',name ',ipn)))
+	       (process-net-form name net subnets))
+     ',name))
+
+(export 'net-parse-to-ipnets)
+(defun net-parse-to-ipnets (form &optional (family t))
+  (flet ((hack (form family)
+	   (let* ((form (if (and (consp form)
+				 (endp (cdr form)))
+			    (car form)
+			    form))
+		  (net (net-find form))
+		  (ipns (if net (net-ipnets net)
+			    (list (ipnet form)))))
+	     (if (eq family t) ipns
+		 (remove family ipns
+			 :key #'ipnet-family
+			 :test-not #'eq)))))
+    (let* ((ipns (if (and (listp form)
+			  (every (lambda (clause)
+				   (and (listp clause)
+					(symbolp (car clause))
+					(or (eq (car clause) t)
+					    (family-addrclass
+					     (car clause)))))
+				 form))
+		     (mappend (lambda (clause)
+				(hack (cdr clause) (car clause)))
+			      form)
+		     (hack form family)))
+	   (merged (reduce (lambda (ipns ipn)
+			     (if (find (ipnet-family ipn) ipns
+				       :key #'ipnet-family)
+				 ipns
+				 (cons ipn ipns)))
+			   ipns
+			   :initial-value nil)))
+      (or merged (error "No matching addresses.")))))
+
+(export 'net-host)
+(defun net-host (net-form host &optional (family t))
+  "Return the given HOST on the NET, as an anonymous `host' object.
+
+   HOST may be an index (in range, of course), or one of the keywords:
+
+   :next       next host, as by net-next-host
+   :net        network base address
+   :broadcast  network broadcast address
+
+   If FAMILY is not `t', then only return an address with that family;
+   otherwise return all available addresses."
+  (flet ((hosts (ipns host)
+	   (mapcar (lambda (ipn) (ipnet-host ipn host))
+		   (remove host ipns :key #'ipnet-hosts :test-not #'<))))
+    (let* ((net (and (typep net-form '(or string symbol))
+		     (net-find net-form)))
+	   (ipns (net-parse-to-ipnets net-form family))
+	   (addrs (case host
+		    (:next
+		     (if net
+			 (prog1 (hosts ipns (net-next net))
+			   (incf (net-next net)))
+			 (error "Can't use `:next' without a named net.")))
+		    (:net (mapcar #'ipnet-net ipns))
+		    (:broadcast (remove nil (mapcar #'ipnet-broadcast ipns)))
+		    (t (hosts ipns host)))))
+      (unless addrs
+	(error "No networks have that address."))
+      (make-instance 'host :addrs addrs))))
 
 ;;;--------------------------------------------------------------------------
 ;;; Host names and specifiers.
 
-(defun parse-ipaddr (addr)
-  "Convert the string ADDR into an IP address: tries all sorts of things:
-
-   (NET [INDEX])	index a network: NET is a network name defined by
-			defnet; INDEX is an index or one of the special
-			symbols understood by net-host, and defaults to :next
-
-   INTEGER		an integer IP address
-
-   IPADDR		an IP address in dotted-quad form
-
-   HOST			a host name defined by defhost
-
-   DNSNAME		a name string to look up in the DNS"
-  (cond ((listp addr)
-	 (destructuring-bind
-	     (net host)
-	     (pairify addr :next)
-	   (net-host (or (net-find net)
-			 (error "Network ~A not found" net))
-		     host)))
-	((ipaddrp addr) addr)
-	(t
-	 (setf addr (string-downcase (stringify addr)))
-	 (or (host-find addr)
-	     (and (plusp (length addr))
-		  (digit-char-p (char addr 0))
-		  (string-ipaddr addr))
-	     (resolve-hostname (stringify addr))
-	     (error "Host name ~A unresolvable" addr)))))
+(export 'host)
+(export 'host-name)
+(export 'host-addrs)
+(defclass host ()
+  ((name :type (or string null) :initform nil
+	 :initarg :name :reader host-name)
+   (addrs :type list :initarg :addrs :initform nil :accessor host-addrs)))
+
+(defmethod print-object ((host host) stream)
+  (print-unreadable-object (host stream :type t)
+    (format stream "~:[<anonymous>~;~@*~A~]~@[ = ~{~A~^, ~}~]"
+	    (host-name host)
+	    (mapcar #'ipaddr-string (host-addrs host)))))
 
 (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 (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 merge-addresses (addrs-a addrs-b)
+  (append (remove-if (lambda (addr)
+		       (member (ipaddr-family addr) addrs-b
+			       :key #'ipaddr-family))
+		     addrs-a)
+	  addrs-b))
+
+(export 'host-parse)
+(defun host-parse (addr &optional (family t))
+  "Convert the ADDR into a (possibly anonymous) `host' object.
+
+   The ADDR can be one of a number of different things.
+
+   HOST				a host name defined using `defhost'
+
+   (NET INDEX)			a particular host in a network
+
+   IPADDR			an address form acceptable to `ipnet'
+
+   ((FAMILY . ADDR) ...)	the above, restricted to a particular address
+				  FAMILY (i.e., one of the keywords `:ipv4',
+				  etc.)"
+
+  (labels ((filter-addresses (addrs family)
+	     (make-instance 'host
+			    :addrs (if (eq family t) addrs
+				       (remove family addrs
+					       :key #'ipaddr-family
+					       :test-not #'eq))))
+	   (host-addresses (host family)
+	     (if (eq family t) host
+		 (filter-addresses (host-addrs host) family)))
+	   (hack (addr family)
+	     (let* ((form (listify addr))
+		    (indic (car form))
+		    (host (and (null (cdr form))
+			       (host-find indic))))
+	       (cond (host
+		      (host-addresses host family))
+		     ((and (consp (cdr form))
+			   (endp (cddr form)))
+		      (net-host (car form) (cadr form) family))
+		     (t
+		      (filter-addresses (list (ipaddr indic)) family))))))
+    (let ((host (cond
+		  ((not (eq family t))
+		   (hack addr family))
+		  ((and (listp addr)
+			(every (lambda (clause)
+				 (and (listp clause)
+				      (symbolp (car clause))
+				      (or (eq (car clause) t)
+					  (family-addrclass (car clause)))))
+			       addr))
+		    (make-instance 'host
+				   :addrs (reduce #'merge-addresses
+						  (mapcar
+						   (lambda (clause)
+						     (host-addrs
+						      (hack (cdr clause)
+							    (car clause))))
+						   (reverse addr))
+						  :initial-value nil)))
+		  (t
+		   (hack addr t)))))
+      (unless (host-addrs host)
+	(error "No matching addresses."))
+      host)))
+
+(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)))
-
+  "Make host NAME map to ADDR (anything acceptable to `host-parse')."
+  (let ((existing (host-find name))
+	(new (host-parse addr)))
+    (if (not existing)
+	(setf (host-find name)
+	      (make-instance 'host
+			     :name (string-downcase (stringify name))
+			     :addrs (host-addrs new)))
+	(progn
+	  (setf (host-addrs existing)
+		(merge-addresses (host-addrs existing) (host-addrs new)))
+	  existing))))
+
+(export 'defhost)
 (defmacro defhost (name addr)
   "Main host definition macro.  Neither NAME nor ADDR is evaluated."
   `(progn
      (host-create ',name ',addr)
      ',name))
 
-;;;--------------------------------------------------------------------------
-;;; Network names and specifiers.
-
-(defstruct (net (:predicate netp))
-  "A network structure.  Slots:
-
-   NAME       The network's name, as a string
-   IPNET      The network base address and mask
-   HOSTS      Number of hosts in the network
-   NEXT       Index of the next unassigned host"
-  name
-  ipnet
-  hosts
-  next)
-
-(defvar *networks* (make-hash-table :test #'equal)
-  "The table of known 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 net-get-as-ipnet (form)
-  "Transform FORM into an ipnet.  FORM may be a network name, or something
-acceptable to the ipnet function."
-  (let ((net (net-find form)))
-    (if net (net-ipnet net)
-	(ipnet form))))
-
-(defun process-net-form (root addr subnets)
-  "Unpack a net-form.  The return value is a list of entries, each of which
-   is a list of the form (NAME ADDR MASK).  The first entry is merely repeats
-   the given ROOT and ADDR arguments (unpacking ADDR into separate network
-   address and mask).  The SUBNETS are then processed: they are a list of
-   items of the form (NAME NUM-HOSTS . SUBNETS), where NAME names the subnet,
-   NUM-HOSTS is the number of hosts in it, and SUBNETS are its sub-subnets in
-   the same form.  An error is signalled if a net's subnets use up more hosts
-   than the net has to start with."
-  (labels ((frob (subnets limit finger)
-	     (when subnets
-	       (destructuring-bind (name size &rest subs) (car subnets)
-		 (when (> (count-low-zero-bits size)
-			  (count-low-zero-bits finger))
-		   (error "Bad subnet size for ~A." name))
-		 (when (> (+ finger size) limit)
-		   (error "Subnet ~A out of range." name))
-		 (append (and name
-			      (list (list name finger (- (ash 1 32) size))))
-			 (frob subs (+ finger size) finger)
-			 (frob (cdr subnets) limit (+ finger size)))))))
-    (let ((ipn (ipnet addr)))
-      (with-ipnet (net mask) ipn
-	(unless (ipmask-cidl-slash mask)
-	  (error "Bad mask for subnet form."))
-	(cons (list root net mask)
-	      (frob subnets (+ net (ipnet-hosts ipn) 1) net))))))
-
-(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."
-  (let ((ipn (ipnet net)))
-    (setf (net-find name)
-	  (make-net :name (string-downcase (stringify name))
-		    :ipnet ipn
-		    :hosts (ipnet-hosts ipn)
-		    :next 1))))
-
-(defmacro defnet (name net &rest subnets)
-  "Main network definition macro.  None of the arguments is evaluated."
-  `(progn
-    ,@(loop for (name addr mask) in (process-net-form name net subnets)
-	    collect `(net-create ',name '(,addr . ,mask)))
-    ',name))
-
-(defun net-next-host (net)
-  "Given a NET, return the IP address (as integer) of the next available
-   address in the network."
-  (unless (< (net-next net) (net-hosts net))
-    (error "No more hosts left in network ~A" (net-name net)))
-  (let ((next (net-next net)))
-    (incf (net-next net))
-    (net-host net next)))
-
-(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:
-
-   :NEXT       next host, as by net-next-host
-   :NET        network base address
-   :BROADCAST  network broadcast address"
-  (case host
-    (:next (net-next-host net))
-    (:net (ipnet-net (net-ipnet net)))
-    (:broadcast (ipnet-broadcast (net-ipnet net)))
-    (t (ipnet-host (net-ipnet net) host))))
-
 ;;;----- That's all, folks --------------------------------------------------