"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)))
(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)
(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)
(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)))
(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."
+ "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 (and slashp (position #\/ str :start start :end end))))
(multiple-value-bind (addr lo hi)
(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)))
(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'."
+ 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
(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."
+ "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)))
(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)))
(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)
(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)))
~mdw / zone / blobdiff