From 6343e7bf99d80d5c01ee598922058406fb0ebb62 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Sat, 13 Jul 2013 16:34:40 +0100
Subject: [PATCH] net.lisp: net.lisp: Refactor `string-subipnet' and its
 friends.

  * Kill `ipnet-subnet', which wasn't used anywhere else anyway.
    Replace with `check-subipnet', with a different interface.

  * Add `:slashp' argument to `parse-subnet', controlling whether it
    bothers to detect a `/'.

  * Introduce `parse-subipnet' as a higher-level interface to
    `parse-subnet'.
---
 net.lisp | 53 ++++++++++++++++++++++++++++-------------------------
 1 file changed, 28 insertions(+), 25 deletions(-)

diff --git a/net.lisp b/net.lisp
index 7480b3c..2bbdcf0 100644
--- a/net.lisp
+++ b/net.lisp
@@ -315,10 +315,10 @@
   (print-unreadable-object (ipn stream :type t)
     (write-string (ipnet-string ipn) stream)))
 
-(defun parse-subnet (class width max str &key (start 0) (end nil))
+(defun parse-subnet (class width max str &key (start 0) (end nil) (slashp t))
   "Parse a subnet description from a (substring of) STR."
   (setf-default end (length str))
-  (let ((sl (position #\/ str :start start :end end)))
+  (let ((sl (and slashp (position #\/ str :start start :end end))))
     (multiple-value-bind (addr lo hi)
 	(parse-partial-ipaddr class str :max max
 			      :start start :end (or sl end))
@@ -339,27 +339,24 @@
 	  (error "Mask selects bits not present in base address"))
 	(values addr mask)))))
 
-(export 'ipnet-subnet)
-(defun ipnet-subnet (base-ipn sub-net sub-mask)
-  "Construct a subnet of IPN, using the NET and MASK.
+(defun check-subipnet (base-ipn sub-addr sub-mask)
+  "Verify that SUB-NET/SUB-MASK is an appropriate subnet of BASE-IPN.
 
-   The NET must either be zero or agree with IPN at all positions indicated
-   by their respective masks."
+   The BASE-IPN is an `ipnet'; SUB-ADDR and SUB-MASK are plain integers.  If
+   the subnet is invalid (i.e., the subnet disagrees with its putative parent
+   over some of the fixed address bits) then an error is signalled; otherwise
+   return the combined base address (as an `ipaddr') and mask (as an
+   integer)."
   (with-ipnet (base-net base-addr base-mask) base-ipn
-    (let* ((sub-net (ipaddr sub-net (ipnet-net base-ipn)))
-	   (sub-addr (ipaddr-addr sub-net))
-	   (sub-mask (ipmask sub-net sub-mask))
-	   (common (logand base-mask sub-mask))
+    (let* ((common (logand base-mask sub-mask))
 	   (base-overlap (logand base-addr common))
 	   (sub-overlap (logand sub-addr common))
 	   (full-mask (logior base-mask sub-mask)))
-      (unless (or (zerop sub-overlap)
-		  (= sub-overlap base-overlap))
+      (unless (or (zerop sub-overlap) (= sub-overlap base-overlap))
 	(error "Subnet doesn't match base network"))
-      (ipaddr-ipnet (integer-ipaddr (logand full-mask
-					    (logior base-addr sub-addr))
-				    base-net)
-		    full-mask))))
+      (values (integer-ipaddr (logand full-mask (logior base-addr sub-addr))
+			      base-net)
+	      full-mask))))
 
 (export 'string-ipnet)
 (defun string-ipnet (str &key (start 0) (end nil))
@@ -374,20 +371,26 @@
       (make-ipnet (make-instance addr-class :addr addr)
 		  (make-instance addr-class :addr mask)))))
 
-(export 'string-subipnet)
-(defun string-subipnet (ipn str &key (start 0) (end nil))
-  "Parse an IP subnet from a parent net IPN and a suffix string STR."
-  (setf str (stringify str))
+(defun parse-subipnet (ipn str &key (start 0) (end nil) (slashp t))
+  "Parse STR as a subnet of IPN.
+
+   This is mostly a convenience interface over `parse-subnet'."
   (let* ((addr-class (extract-class-name (ipnet-net ipn)))
 	 (width (ipaddr-width addr-class))
 	 (max (- width
 		 (or (ipmask-cidl-slash width (ipnet-mask ipn))
 		     (error "Base network has complex netmask")))))
     (multiple-value-bind (addr mask)
-	(parse-subnet addr-class width max str :start start :end end)
-      (ipnet-subnet ipn
-		    (make-instance addr-class :addr addr)
-		    (make-instance addr-class :addr mask)))))
+	(parse-subnet addr-class width max (stringify str)
+		      :start start :end end :slashp slashp)
+      (check-subipnet ipn addr mask))))
+
+(export 'string-subipnet)
+(defun string-subipnet (ipn str &key (start 0) (end nil))
+  "Parse an IP subnet from a parent net IPN and a suffix string STR."
+  (multiple-value-bind (addr mask)
+      (parse-subipnet ipn str :start start :end end)
+    (ipaddr-ipnet addr mask)))
 
 (defun ipnet (net)
   "Construct an IP-network object from the given argument.
-- 
2.11.0