From b90cef0db99fce1646f3741919d1f3c5edf74b60 Mon Sep 17 00:00:00 2001 Message-Id: From: Mark Wooding Date: Thu, 20 Apr 2006 13:25:06 +0100 Subject: [PATCH] zone: Allow definitions of subnets in defnet Organization: Straylight/Edgeware From: Mark Wooding This makes it rather easier to describe the distorted.org.uk zones. --- zone.lisp | 57 +++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 45 insertions(+), 12 deletions(-) diff --git a/zone.lisp b/zone.lisp index 065e53a..140ade5 100644 --- a/zone.lisp +++ b/zone.lisp @@ -137,6 +137,13 @@ (defun iso-date (&optional time &key datep timep (sep #\ )) (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. @@ -234,16 +241,14 @@ (defun string-ipnet (str &key (start 0) (end nil)) (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) @@ -425,22 +430,50 @@ (defun net-get-as-ipnet (form) (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 -- [mdw]