chiark / gitweb /
net.lisp: Support string-like host designations in `net-host'.
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 12:50:57 +0000 (13:50 +0100)
net.lisp

index 2bbdcf09e76f6e6cef90ffa60e5b3c36717c51b4..90e30aa5b6d8c6df153a59af5d0988165daf1c9f 100644 (file)
--- a/net.lisp
+++ b/net.lisp
@@ -496,8 +496,18 @@ (export 'ipnet-host)
 (defun ipnet-host (ipn host)
   "Return the address of the given HOST in network IPN.
 
-   This works even with a non-contiguous netmask."
-  (ipnet-index-host (ipnet-host-map ipn) host))
+   The HOST may be a an integer index into the network (this works even with
+   a non-contiguous netmask) or a string or symbolic suffix (as for
+   `string-subnet')."
+  (etypecase host
+    (integer
+     (ipnet-index-host (ipnet-host-map ipn) host))
+    ((or symbol string)
+     (multiple-value-bind (addr mask)
+        (parse-subipnet ipn host :slashp nil)
+       (unless (= mask (mask (ipaddr-width addr)))
+        (error "Host address incomplete"))
+       addr))))
 
 (export 'ipaddr-networkp)
 (defun ipaddr-networkp (ip ipn)
@@ -805,7 +815,8 @@ (export 'net-host)
 (defun net-host (net-form host &optional (family t))
   "Return the given HOST on the NET, as an anonymous `host' object.
 
-   HOST may be an index (in range, of course), or one of the keywords:
+   HOST may be an index (in range, of course), a suffix (as a symbol or
+   string, as for `string-subnet'), or one of the keywords:
 
    :next       next host, as by net-next-host
    :net        network base address
@@ -815,7 +826,9 @@ (defun net-host (net-form host &optional (family t))
    otherwise return all available addresses."
   (flet ((hosts (ipns host)
           (mapcar (lambda (ipn) (ipnet-host ipn host))
-                  (remove host ipns :key #'ipnet-hosts :test-not #'<))))
+                  (if (integerp host)
+                      (remove host ipns :key #'ipnet-hosts :test #'>=)
+                      ipns))))
     (let* ((net (and (typep net-form '(or string symbol))
                     (net-find net-form)))
           (ipns (net-parse-to-ipnets net-form family))