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

Both `host-parse' and `net-parse-to-ipnets' had common code for
handling ((:FAMILY . ITEM)*) forms, but they (a) handled them
differently if an explicit family was provided, and (b) both
implementations were wrong.

Split out the necessary functionality, and implement it correctly.

diff --git a/net.lisp b/net.lisp
index 90e30aa..85faede 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -776,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)
@@ -790,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)
@@ -917,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)))