X-Git-Url: https://git.distorted.org.uk/~mdw/zone/blobdiff_plain/b496b60f441cf9b91de3a9eecafc3c253c8ca458..4ea82aba4c47b65d346a71a8d32564ca842ad5ba:/net.lisp diff --git a/net.lisp b/net.lisp index 1e32684..e1adf62 100644 --- a/net.lisp +++ b/net.lisp @@ -140,26 +140,46 @@ "Base class for IP addresses.")) (export 'ipaddr-family) -(defgeneric ipaddr-family (addr)) +(defgeneric ipaddr-family (addr) + (:documentation "Return the address family of ADDR, as a keyword.")) (export 'family-addrclass) (defgeneric family-addrclass (family) + (:documentation "Convert the keyword FAMILY into an `ipaddr' subclass.") (:method ((af symbol)) nil)) (export 'ipaddr-width) (defgeneric ipaddr-width (class) + (:documentation "Return the width, in bits, of addresses from CLASS. + + Alternatively, the CLASS may be given as an example object.") (:method ((object t)) (ipaddr-width (extract-class-name object)))) (export 'ipaddr-comparable-p) (defgeneric ipaddr-comparable-p (addr-a addr-b) + (:documentation "Is it meaningful to compare ADDR-A and 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)) + "Return a class name for the address in (the given substring of) STR. + + This ought to be an extension point for additional address families, but + it isn't at the moment." (cond ((position #\: str :start start :end end) 'ip6addr) (t 'ip4addr))) (defgeneric parse-partial-ipaddr (class str &key start end min max) + (:documentation + "Parse (a substring of) STR into a partial address of the given CLASS. + + Returns three values: the parsed address fragment, as an integer; and the + low and high bit positions covered by the response. + + The CLASS may instead be an example object of the required class. The MIN + and MAX arguments bound the number of bits acceptable in the response; the + result is shifted so that the most significant component of the returned + address is in the same component as bit position MAX.") (:method ((object t) str &rest keywords) (apply #'parse-partial-ipaddr (extract-class-name object) str keywords))) @@ -191,8 +211,7 @@ (export 'ipaddr-string) (defgeneric ipaddr-string (ip) - (:documentation - "Transform the address IP into a string in dotted-quad form.")) + (:documentation "Transform the address IP into a numeric textual form.")) (defmethod print-object ((addr ipaddr) stream) (print-unreadable-object (addr stream :type t) @@ -263,6 +282,7 @@ (export 'ipnet-family) (defgeneric ipnet-family (ipn) + (:documentation "Return the address family of IPN, as a keyword.") (:method ((ipn ipnet)) (ipaddr-family (ipnet-net ipn)))) (export 'ipnet-addr) @@ -276,8 +296,9 @@ (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'." + "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))) @@ -315,10 +336,26 @@ (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)) - "Parse a subnet description from a (substring of) STR." +(defun parse-subnet (class width max str &key (start 0) (end nil) (slashp t)) + "Parse a subnet description from (a substring of) STR. + + Suppose we have a parent network, with a prefix length of MAX. The WIDTH + gives the overall length of addresses of the appropriate class, i.e., + (ipaddr-width WIDTH), but in fact callers have already computed this for + their own reasons. + + Parse (the designated substring of) STR to construct the base address of a + subnet. The string should have the form BASE/MASK, where the MASK is + either a literal bitmask (in the usual syntax for addresses) or an integer + prefix length. An explicit prefix length is expected to cover the entire + address including the parent prefix: an error is signalled if the prefix + isn't long enough to cover any of the subnet. A mask is parsed relative + to the end of the parent address, just as the subnet base address is. + + Returns the relative base address and mask as two integer values." + (setf-default end (length str)) - (let ((sl (position #\/ str :start start :end end))) + (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)) @@ -339,31 +376,32 @@ (error "Mask selects bits not present in base address")) (values addr mask))))) -(export 'ipnet-subnet) -(defun ipnet-subnet (base-ipn sub-net sub-mask) - "Construct a subnet of IPN, using the NET and MASK. +(defun check-subipnet (base-ipn sub-addr sub-mask) + "Verify that SUB-NET/SUB-MASK is an appropriate subnet of BASE-IPN. - The NET must either be zero or agree with IPN at all positions indicated - by their respective masks." + 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* ((sub-net (ipaddr sub-net (ipnet-net base-ipn))) - (sub-addr (ipaddr-addr sub-net)) - (sub-mask (ipmask sub-net sub-mask)) - (common (logand base-mask sub-mask)) + (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)) + (unless (or (zerop sub-overlap) (= sub-overlap base-overlap)) (error "Subnet doesn't match base network")) - (ipaddr-ipnet (integer-ipaddr (logand full-mask - (logior base-addr sub-addr)) - base-net) - full-mask)))) + (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." + "Parse an IP network description from the string STR. + + A network description has the form ADDRESS/MASK, where the ADDRESS is a + base address in numeric form, and the MASK is either a netmask in the same + form, or an integer prefix length." (setf str (stringify str)) (setf-default end (length str)) (let ((addr-class (guess-address-class str :start start :end end))) @@ -374,19 +412,46 @@ (make-ipnet (make-instance addr-class :addr addr) (make-instance addr-class :addr mask))))) -(export 'string-subipnet) -(defun string-subipnet (ipn str &key (start 0) (end nil)) - (setf str (stringify str)) +(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'; we compute + various of the parameters from IPN rather than requiring them to be passed + in explicitly. + + Returns two values: the combined base address, as an `ipnaddr' and + combined mask, as an integer." + (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 str :start start :end end) - (ipnet-subnet ipn - (make-instance addr-class :addr addr) - (make-instance addr-class :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. + + The (substring of) STR is expected to have the form ADDRESS/MASK, where + ADDRESS is a relative subnet base address, and MASK is either a relative + subnet mask or a (full) prefix length. Returns the resulting ipnet. If + the relative base address overlaps with the existing subnet (because the + base network's prefix length doesn't cover a whole number of components), + then the subnet base must either agree in the overlapping portion with the + parent base address or be zero. + + For example, if IPN is the network 172.29.0.0/16, then `199/24' or + `199/255' both designate the subnet 172.29.199.0/24. Similarly, starting + from 2001:ba8:1d9:8000::/52, then `8042/ffff' and `42/64' both designate + the network 2001:ba8:1d9:8042::/64." + + (multiple-value-bind (addr mask) + (parse-subipnet ipn str :start start :end end) + (ipaddr-ipnet addr mask))) (defun ipnet (net) "Construct an IP-network object from the given argument. @@ -492,8 +557,18 @@ (defun ipnet-host (ipn host) "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)) + The HOST may be a an integer index into the network (this works even with + a non-contiguous netmask) or a string or symbolic suffix (as for + `string-subnet')." + (etypecase host + (integer + (ipnet-index-host (ipnet-host-map ipn) host)) + ((or symbol string) + (multiple-value-bind (addr mask) + (parse-subipnet ipn host :slashp nil) + (unless (= mask (mask (ipaddr-width addr))) + (error "Host address incomplete")) + addr)))) (export 'ipaddr-networkp) (defun ipaddr-networkp (ip ipn) @@ -762,8 +837,38 @@ (process-net-form name net subnets)) ',name)) +(defun filter-by-family (func form family) + "Handle a family-switch form. + + Here, FUNC is a function of two arguments ITEM and FAMILY. FORM is either + a list of the form ((FAMILY . ITEM) ...), or an ITEM which is directly + acceptable to FUNC. Return a list of the resulting outputs of FUNC." + + (if (and (listp form) + (every (lambda (clause) + (and (listp clause) + (family-addrclass (car clause)))) + form)) + (mapcan (lambda (clause) + (let ((fam (car clause))) + (and (or (eq family t) + (eq family fam)) + (list (funcall func (cdr clause) fam))))) + form) + (list (funcall func form family)))) + (export 'net-parse-to-ipnets) (defun net-parse-to-ipnets (form &optional (family t)) + "Parse FORM into a list of ipnet objects. + + The FORM can be any of the following. + + * NAME -- a named network, established using `net-create' or `defnet' + + * IPNET -- a network, in a form acceptable to `ipnet' + + * ((FAMILY . FORM) ...) -- a sequence of networks, filtered by FAMILY" + (flet ((hack (form family) (let* ((form (if (and (consp form) (endp (cdr form))) @@ -776,18 +881,7 @@ (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))) + (let* ((ipns (apply #'append (filter-by-family #'hack form family))) (merged (reduce (lambda (ipns ipn) (if (find (ipnet-family ipn) ipns :key #'ipnet-family) @@ -801,7 +895,8 @@ (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: + HOST may be an index (in range, of course), a suffix (as a symbol or + string, as for `string-subnet'), or one of the keywords: :next next host, as by net-next-host :net network base address @@ -811,7 +906,9 @@ otherwise return all available addresses." (flet ((hosts (ipns host) (mapcar (lambda (ipn) (ipnet-host ipn host)) - (remove host ipns :key #'ipnet-hosts :test-not #'<)))) + (if (integerp host) + (remove host ipns :key #'ipnet-hosts :test #'>=) + ipns)))) (let* ((net (and (typep net-form '(or string symbol)) (net-find net-form))) (ipns (net-parse-to-ipnets net-form family)) @@ -900,27 +997,14 @@ (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))))) + (let* ((list (filter-by-family #'hack addr family)) + (host (if (and list (cdr list)) + (make-instance 'host + :addrs (reduce #'merge-addresses + (mapcar #'host-addrs + (reverse list)) + :initial-value nil)) + (car list)))) (unless (host-addrs host) (error "No matching addresses.")) host)))