From: Mark Wooding <mdw@distorted.org.uk>
Date: Sat, 13 Jul 2013 15:34:40 +0000 (+0100)
Subject: net.lisp: Factor out family-switch form parsing, and fix it.
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~mdw/git/zone/commitdiff_plain/8d531634cda3f8c98ab9dca285565e29025e0379

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
--- 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)))