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'.

diff --git a/net.lisp b/net.lisp
index 7480b3c..2bbdcf0 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -315,10 +315,10 @@
   (print-unreadable-object (ipn stream :type t)
     (write-string (ipnet-string ipn) stream)))
 
   (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))
   "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))
     (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)))))
 
          (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
   (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)))
           (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"))
        (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))
 
 (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)))))
 
       (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)
   (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.
 
 (defun ipnet (net)
   "Construct an IP-network object from the given argument.