(when timep
(format s "~2,'0D:~2,'0D:~2,'0D" hr min sec)))))
+(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))))
+
;;;--------------------------------------------------------------------------
;;; Simple messing with IP addresses.
(make-ipnet (parse-ipaddr (subseq str start end))
(integer-netmask 32)))))
-(defun ipnet (net &optional mask)
- "Construct an IP-network object from the given arguments. A number of
+(defun ipnet (net)
+ "Construct an IP-network object from the given argument. A number of
forms are acceptable:
- * NET MASK -- as for `make-ipnet'.
* 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 (mask (make-ipnet net mask))
- ((or (stringp net) (symbolp net)) (string-ipnet net))
+ (cond ((or (stringp net) (symbolp net)) (string-ipnet net))
(t (apply #'make-ipnet (pairify net 32)))))
(defun ipnet-net (ipn)
(if net (net-ipnet net)
(ipnet form))))
-(defun net-create (name &rest args)
+(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 (apply #'ipnet args)))
+ (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 &rest args)
- "Main network definition macro. Neither NAME nor any of the ARGS is
-evaluated."
+(defmacro defnet (name net &rest subnets)
+ "Main network definition macro. None of the arguments is evaluated."
`(progn
- (net-create ',name ,@(mapcar (lambda (x) `',x) args))
- ',name))
+ ,@(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