+ :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))
+ (remove host ipns :key #'ipnet-hosts :test-not #'<))))
+ (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 ((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)))))
+ (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))