diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2016-02-29 06:30:53 -0800 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2016-02-29 06:30:53 -0800 |
| commit | d50725ab1a9055fd3f0c83c90c9fb71bfd16c205 (patch) | |
| tree | ccb0374b5d2d97685989f5bbb7f41da3a46ac7ef /share | |
| parent | 5ee9c14113a3ebcc4cf5488e243cb97babd8be93 (diff) | |
| download | txr-d50725ab1a9055fd3f0c83c90c9fb71bfd16c205.tar.gz txr-d50725ab1a9055fd3f0c83c90c9fb71bfd16c205.tar.bz2 txr-d50725ab1a9055fd3f0c83c90c9fb71bfd16c205.zip | |
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.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/socket.tl | 38 |
1 files changed, 38 insertions, 0 deletions
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))) |