diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2016-03-01 06:04:54 -0800 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2016-03-01 06:04:54 -0800 |
commit | 4d307415d34176be4093bfb1536cc9a175430b20 (patch) | |
tree | 7740cc2147233a621f59cd36a70368f82781ec32 | |
parent | 26a58a0d7fc48b9e609808593c830d74b15750b5 (diff) | |
download | txr-4d307415d34176be4093bfb1536cc9a175430b20.tar.gz txr-4d307415d34176be4093bfb1536cc9a175430b20.tar.bz2 txr-4d307415d34176be4093bfb1536cc9a175430b20.zip |
Fix triple-colon in ipv6 text representation.
* share/txr/stdlib/socket.tl (sys:in6addr-condensed-text): New
function containing common code. Uses window-mappend to
selectively convert a compressed range of zeros to either
colon or empty string based on whether it is in the middle
or end.
(str-in6addr, str-in6addr-net): Use new function.
-rw-r--r-- | share/txr/stdlib/socket.tl | 35 |
1 files changed, 17 insertions, 18 deletions
diff --git a/share/txr/stdlib/socket.tl b/share/txr/stdlib/socket.tl index 0898a491..e911a6a7 100644 --- a/share/txr/stdlib/socket.tl +++ b/share/txr/stdlib/socket.tl @@ -55,6 +55,19 @@ (throwf 'eval-error "str-inaddr: ~a out of range for IPv4 address" addr) `@a.@b.@c.@d@p`))) +(defun sys:in6addr-condensed-text (numeric-pieces) + (let* ((notyet t) + (texts (window-mappend + 1 nil + (lambda (pre chunk post) + (cond + ((and notyet (zerop (car chunk)) (cdr chunk)) + (zap notyet) + (if (and post pre) '("") '(":"))) + (t (mapcar (op format nil "~x") chunk)))) + [partition-by zerop numeric-pieces]))) + `@{texts ":"}`)) + (defun str-in6addr (addr : port) (let ((str (if (and (<= (width addr) 48) (= (ash addr -32) #xFFFF)) @@ -70,15 +83,8 @@ addr)) (cons (logand val #xFFFF) (ash val -16)))) - addr))) - (notyet t) - (texts (append-each ((chunk [partition-by zerop pieces])) - (cond - ((and notyet (zerop (car chunk)) (cdr chunk)) - (zap notyet) - '(":")) - (t (mapcar (op format nil "~x") chunk)))))) - `@{texts ":"}`)))) + addr)))) + (sys:in6addr-condensed-text pieces))))) (if port `[@str]:@port` str))) @@ -133,12 +139,5 @@ (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`)))) + (prefix (if (search cand-prefix '(0 0)) pieces cand-prefix))) + `@(sys:in6addr-condensed-text prefix)/@w`)))) |