net.lisp: Factor out family-switch form parsing, and fix it.

[zone] / net.lisp

diff --git a/net.lisp b/net.lisp
index 2bbdcf0..85faede 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -496,8 +496,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)
@@ -766,6 +776,26 @@
               (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))
   (flet ((hack (form family)
@@ -780,18 +810,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)
@@ -805,7 +824,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
@@ -815,7 +835,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))
@@ -904,27 +926,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)))