chiark / gitweb /
net.lisp: Factor out family-switch form parsing, and fix it.
authorMark Wooding <mdw@distorted.org.uk>
Sat, 13 Jul 2013 15:34:40 +0000 (16:34 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Sat, 19 Apr 2014 14:55:40 +0000 (15:55 +0100)
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.

net.lisp

index 90e30aa..85faede 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -776,6 +776,26 @@ (defmacro defnet (name net &rest subnets)
               (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 @@ (defun net-parse-to-ipnets (form &optional (family t))
                 (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 @@ (defun host-parse (addr &optional (family t))
                      (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)))