From d50725ab1a9055fd3f0c83c90c9fb71bfd16c205 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 29 Feb 2016 06:30:53 -0800
Subject: IP address to string functions.
* lisplib.c (sock_set_entries): Add str-inaddr and str-in6addr
to list of autoload identifiers.
* share/txr/stdlib/socket.tl (str-inaddr, str-in6addr): New
functions.
---
share/txr/stdlib/socket.tl | 38 ++++++++++++++++++++++++++++++++++++++
1 file changed, 38 insertions(+)
(limited to 'share')
diff --git a/share/txr/stdlib/socket.tl b/share/txr/stdlib/socket.tl
index beff73be..cb9fd23d 100644
--- a/share/txr/stdlib/socket.tl
+++ b/share/txr/stdlib/socket.tl
@@ -44,3 +44,41 @@
(defvarl shut-rd 0)
(defvarl shut-wr 1)
(defvarl shut-rdwr 2)
+
+(defun str-inaddr (addr : port)
+ (let ((d (logand addr #xFF))
+ (c (logand (ash addr -8) #xFF))
+ (b (logand (ash addr -16) #xFF))
+ (a (ash addr -24))
+ (p (if port `:@port` "")))
+ (if (or (> a 255) (minusp a))
+ (throwf 'eval-error "str-inaddr: ~a out of range for IPv4 address" addr)
+ `@a.@b.@c.@d@p`)))
+
+(defun str-in6addr (addr : port)
+ (let ((str (if (and (<= (width addr) 48)
+ (= (ash addr -32) #xFFFF))
+ `::ffff:@(str-inaddr (logtrunc addr 32))`
+ (let* ((pieces (let ((count 8))
+ (nexpand-left (lambda (val)
+ (if (minusp (dec count))
+ (unless (zerop val)
+ (throwf 'eval-error
+ "str-in6addr: \
+ \ ~a out of range \
+ \ for IPv6 address"
+ 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 ":"}`))))
+ (if port
+ `[@str]:@port`
+ str)))
--
cgit v1.2.3