- ,@(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))))
+ ,@(mapcar (lambda (item)
+ (let ((name (car item)) (ipn (cdr item)))
+ `(net-create ',name ',ipn)))
+ (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)))
+ (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 (apply #'append (filter-by-family #'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), 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
+ :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))
+ (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))
+ (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.
+
+(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* ((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)))
+
+(export 'host-create)
+(defun host-create (name 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))