Functions for address prefixes to slash notation.

* lisplib.c (sock_set_entries): Autload entries for
str-inaddr-net and str-in6addr-net.

* share/txr/stdlib/socket.tl (str-inaddr-net,
str-in6addr-net): New functions.

* txr.1: Documented str-inaddr, str-in6-addr,
str-inaddr-net and str-in6addr-net.

3 files changed, 109 insertions, 0 deletions

diff --git a/lisplib.c b/lisplib.c
index d0cf7a2a..9ac7e3a7 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -291,6 +291,7 @@ static val sock_set_entries(val dlt, val fun)
     lit("ai-v4mapped"), lit("ai-all"), lit("ai-addrconfig"),
     lit("ai-numericserv"),
     lit("str-inaddr"), lit("str-in6addr"),
+    lit("str-inaddr-net"), lit("str-in6addr-net"),
     nil
   };
   set_dlt_entries(dlt, name, fun);
diff --git a/share/txr/stdlib/socket.tl b/share/txr/stdlib/socket.tl
index cb9fd23d..0898a491 100644
--- a/share/txr/stdlib/socket.tl
+++ b/share/txr/stdlib/socket.tl
@@ -82,3 +82,63 @@
     (if port
       `[@str]:@port`
       str)))
+
+(defun sys:str-inaddr-net-impl (addr wextra)
+  (let ((mask addr))
+    (set mask (logior mask (ash mask 1)))
+    (set mask (logior mask (ash mask 2)))
+    (set mask (logior mask (ash mask 4)))
+    (set mask (logior mask (ash mask 8)))
+    (set mask (logior mask (ash mask 16)))
+    (let ((w (+ (- 32 (width (lognot mask 32))) wextra))
+          (d (logand addr #xFF))
+          (c (logand (ash addr -8) #xFF))
+          (b (logand (ash addr -16) #xFF))
+          (a         (ash addr -24)))
+      (cond
+        ((or (> a 255) (minusp a))
+         (throwf 'eval-error "str-inaddr-net: ~a out of range for IPv4 address"
+                 addr))
+        ((> w 24) `@a.@b.@c.@d/@w`)
+        ((> w 16) `@a.@b.@c/@w`)
+        ((> w 8) `@a.@b/@w`)
+        (t `@a/@w`)))))
+
+(defun str-inaddr-net (addr)
+  (sys:str-inaddr-net-impl addr 0))
+
+(defun str-in6addr-net (addr)
+  (if (and (<= (width addr) 48)
+           (= (ash addr -32) #xFFFF))
+    `::ffff:@(sys:str-inaddr-net-impl (logtrunc addr 32) 96)`
+    (let ((mask addr))
+      (set mask (logior mask (ash mask 1)))
+      (set mask (logior mask (ash mask 2)))
+      (set mask (logior mask (ash mask 4)))
+      (set mask (logior mask (ash mask 8)))
+      (set mask (logior mask (ash mask 16)))
+      (set mask (logior mask (ash mask 32)))
+      (set mask (logior mask (ash mask 64)))
+      (let* ((w (- 128 (width (lognot mask 128))))
+             (pieces (let ((count 8))
+                       (nexpand-left (lambda (val)
+                                       (if (minusp (dec count))
+                                         (unless (zerop val)
+                                           (throwf 'eval-error
+                                                   "str-in6addr-net: \
+                                                   \ ~a out of range \
+                                                   \ for IPv6 address"
+                                                   addr))
+                                           (cons (logand val #xFFFF)
+                                                 (ash val -16))))
+                                       addr)))
+             (cand-prefix [pieces 0..(trunc (+ w 15) 16)])
+             (prefix (if (search cand-prefix '(0 0)) pieces cand-prefix))
+             (notyet t)
+             (texts (append-each ((chunk [partition-by zerop prefix]))
+                      (cond
+                        ((and notyet (zerop (car chunk)) (cdr chunk))
+                         (zap notyet)
+                         '(":"))
+                        (t (mapcar (op format nil "~x") chunk))))))
+             `@{texts ":"}/@w`))))
diff --git a/txr.1 b/txr.1
index a27ab08b..fb51074f 100644
--- a/txr.1
+++ b/txr.1
@@ -37815,6 +37815,54 @@ Shutting down in the reading direction is potentially abrupt. If it is executed
 before an "end of stream" indication is received from a peer, it results in an
 abortive close.
 
+.coNP Functions @ str-inaddr and @ str-in6addr
+.synb
+.mets (str-inaddr address <> [ port ])
+.mets (str-in6addr address <> [ port ])
+.syne
+.desc
+The
+.code str-inaddr
+and
+.code str-in6addr
+functions convert an IPv4 and IPv6 address, respectively, to textual
+notation which is returned as a character string.
+The conversion is done in conformance with RFC 5952, section 4.
+
+IPv6 addresses representing IPv6-mapped IPv4 addresses are printed
+in the hybrid notation exemplified by
+.codn ::ffff:192.168.1.1 .
+
+The
+.meta address
+parameter must be a non-negative integer in the appropriate range
+for the address type.
+
+If the
+.meta port
+number argument is supplied, it is included in the returned character string,
+according to the requirements in section 6 of RFC 5952 pertaining to IPv6
+addresses (including IPv6-mapped IPv6 addresses) and section 3.2.3 of RFC 3986
+for IPv4 addresses. In brief, IPv6 addresses with ports are expressed as
+.code [address]:port
+and IPv6 addresses follow the traditional
+.code address:port
+pattern.
+
+.coNP Functions @ str-inaddr-net and @ str-in6addr-net
+.synb
+.mets (str-inaddr-net address)
+.mets (str-in6addr-net address)
+.syne
+.desc
+The functions
+.code str-inaddr-net
+and
+.code str-in6addr-net
+convert, respectively, IPv4 and IPv6 network prefix addresses to
+the "slash notation". For IPv6 addresses, the requirements of section
+2.3 of RFC 4291 are implemented. For IPv4, section 3.1 of RFC 4632 is followed.
+
 .SS* Web Programming Support
 
 .coNP Functions @ url-encode and @ url-decode