mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-23 12:00:21 +02:00
Code Activity

Allow null bytes in UNIX sockets.

Browse source 
The current socket address constructors all assume, that there are no
null bytes in the socket path.  This assumption does not hold in Linux,
which uses an initial null byte to demarcate abstract sockets and
ignores all further null bytes [1].

[1] https://www.man7.org/linux/man-pages/man7/unix.7.html

* libguile/sockets.c (scm_fill_sockaddr)[HAVE_UNIX_DOMAIN_SOCKETS]:
Use scm_to_locale_stringn to construct c_address.
Use memcpy instead of strcpy and calculate size directly instead of
using SUN_LEN.
(_scm_from_sockaddr): Copy the entire path up to the limits imposed by
addr_size.
* test-suite/tests/00-socket.test: ("make-socket-address"): Add case for
abstract unix sockets.
("AF_UNIX/SOCK_STREAM"): Add abstract socket versions of bind, listen,
connect and accept.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Liliana Marie Prikler 2022-02-10 21:42:31 +01:00 • committed by Ludovic Courtès
parent e4e8afd6c8
commit 01b686b701
2 changed files with 89 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

79
test-suite/tests/00-socket.test
View file

@ -128,10 +128,15 @@
(= (sockaddr:flowinfo sa*) 1)))))
(if (defined? 'AF_UNIX)
(pass-if "AF_UNIX"
(let ((sa (make-socket-address AF_UNIX "/tmp/unix-socket")))
(and (= (sockaddr:fam sa) AF_UNIX)
(string=? (sockaddr:path sa) "/tmp/unix-socket"))))))
(begin
(pass-if "AF_UNIX"
(let ((sa (make-socket-address AF_UNIX "/tmp/unix-socket")))
(and (= (sockaddr:fam sa) AF_UNIX)
(string=? (sockaddr:path sa) "/tmp/unix-socket"))))
(pass-if "AF_UNIX abstract"
(let ((sa (make-socket-address AF_UNIX "\x00/tmp/abstract-socket")))
(and (= (sockaddr:fam sa) AF_UNIX)
(string=? (sockaddr:path sa) "\x00/tmp/abstract-socket")))))))
;;;
;;; setsockopt
@ -319,6 +324,72 @@
#t)
;; testing `bind', `listen' and `connect' on abstract stream-oriented sockets
(let ((server-socket (socket AF_UNIX SOCK_STREAM 0))
(server-bound? #f)
(server-listening? #f)
(server-pid #f)
(path (temp-file-path)))
(false-if-exception (delete-file path))
(set! path (string-append "\x00" path))
(pass-if "bind abstract"
(catch 'system-error
(lambda ()
(bind server-socket AF_UNIX path)
(set! server-bound? #t)
#t)
(lambda args
(let ((errno (system-error-errno args)))
(if (= errno EADDRINUSE)
(throw 'unresolved)
(apply throw args))))))
(pass-if "listen abstract"
(if (not server-bound?)
(throw 'unresolved)
(begin
(listen server-socket 123)
(set! server-listening? #t)
#t)))
(force-output (current-output-port))
(force-output (current-error-port))
(when server-listening?
(let ((pid (primitive-fork-if-available)))
;; Spawn a server process.
(case pid
((-1) ;; fork not available
#f)
((0) ;; the kid: serve one connection and exit
(let serve ((conn
(false-if-exception (accept server-socket)))
(count 0))
(if (not conn)
(exit 1)
(exit 0))))
(else ;; the parent
(set! server-pid pid)
#t))))
(pass-if "connect abstract"
(if (not server-pid)
(throw 'unresolved)
(let ((s (socket AF_UNIX SOCK_STREAM 0)))
(display "connect abstract\n")
(connect s AF_UNIX path)
#t)))
(pass-if "accept abstract"
(if (not server-pid)
(throw 'unresolved)
(begin
(let ((status (cdr (waitpid server-pid))))
(eqv? 0 (status:exit-val status))))))
#t)
;; Testing `send', `recv!' & co. on stream-oriented sockets (with
;; a bit of duplication with the above.)