diff options
author | Neil Jerram <neil@ossau.uklinux.net> | 2009-10-01 23:43:54 +0100 |
---|---|---|
committer | Neil Jerram <neil@ossau.uklinux.net> | 2009-10-01 23:43:54 +0100 |
commit | 451e15a06c744e49a1bdab6df6d86e0f96d3aa14 (patch) | |
tree | 0d027b8368dddc8bbcc8bc489036802fce025d45 | |
parent | 7394551f61a87802dca01a29173c0b87a4b128e5 (diff) | |
download | guile-451e15a06c744e49a1bdab6df6d86e0f96d3aa14.tar.gz |
Fix handling of IPv6 addresses
Thanks to Scott McPeak for reporting this and providing a patch.
* libguile/socket.c (scm_to_ipv6): When address is the wrong type,
provide more information in the exception message.
(scm_to_sockaddr): scm_to_ipv6 expects just an address, not the
whole vector.
* test-suite/tests/socket.test ("AF_INET6/SOCK_STREAM"): New set of
tests.
-rw-r--r-- | NEWS | 1 | ||||
-rw-r--r-- | libguile/socket.c | 5 | ||||
-rw-r--r-- | test-suite/tests/socket.test | 85 |
3 files changed, 89 insertions, 2 deletions
@@ -12,6 +12,7 @@ Changes in 1.8.8 (since 1.8.7) ** Fix possible buffer overruns when parsing numbers ** Avoid clash with system setjmp/longjmp on IA64 ** Don't dynamically link an extension that is already registered +** Fix `wrong type arg' exceptions with IPv6 addresses Changes in 1.8.7 (since 1.8.6) diff --git a/libguile/socket.c b/libguile/socket.c index f34b6d49d..22398d185 100644 --- a/libguile/socket.c +++ b/libguile/socket.c @@ -347,7 +347,7 @@ scm_to_ipv6 (scm_t_uint8 dst[16], SCM src) scm_remember_upto_here_1 (src); } else - scm_wrong_type_arg (NULL, 0, src); + scm_wrong_type_arg_msg ("scm_to_ipv6", 0, src, "integer"); } #ifdef HAVE_INET_PTON @@ -1167,7 +1167,8 @@ scm_to_sockaddr (SCM address, size_t *address_size) { struct sockaddr_in6 c_inet6; - scm_to_ipv6 (c_inet6.sin6_addr.s6_addr, address); + scm_to_ipv6 (c_inet6.sin6_addr.s6_addr, + SCM_SIMPLE_VECTOR_REF (address, 1)); c_inet6.sin6_port = htons (scm_to_ushort (SCM_SIMPLE_VECTOR_REF (address, 2))); c_inet6.sin6_flowinfo = diff --git a/test-suite/tests/socket.test b/test-suite/tests/socket.test index 4bfc41557..5b738fdc9 100644 --- a/test-suite/tests/socket.test +++ b/test-suite/tests/socket.test @@ -320,3 +320,88 @@ #t))) + +(if (defined? 'AF_INET6) + (with-test-prefix "AF_INET6/SOCK_STREAM" + + ;; testing `bind', `listen' and `connect' on stream-oriented sockets + + (let ((server-socket (socket AF_INET6 SOCK_STREAM 0)) + (server-bound? #f) + (server-listening? #f) + (server-pid #f) + (ipv6-addr 1) ; ::1 + (server-port 8889) + (client-port 9998)) + + (pass-if "bind" + (catch 'system-error + (lambda () + (bind server-socket AF_INET6 ipv6-addr server-port) + (set! server-bound? #t) + #t) + (lambda args + (let ((errno (system-error-errno args))) + (cond ((= errno EADDRINUSE) (throw 'unresolved)) + (else (apply throw args))))))) + + (pass-if "bind/sockaddr" + (let* ((sock (socket AF_INET6 SOCK_STREAM 0)) + (sockaddr (make-socket-address AF_INET6 ipv6-addr client-port))) + (catch 'system-error + (lambda () + (bind sock sockaddr) + #t) + (lambda args + (let ((errno (system-error-errno args))) + (cond ((= errno EADDRINUSE) (throw 'unresolved)) + (else (apply throw args)))))))) + + (pass-if "listen" + (if (not server-bound?) + (throw 'unresolved) + (begin + (listen server-socket 123) + (set! server-listening? #t) + #t))) + + (if server-listening? + (let ((pid (primitive-fork))) + ;; Spawn a server process. + (case pid + ((-1) (throw 'unresolved)) + ((0) ;; the kid: serve two connections and exit + (let serve ((conn + (false-if-exception (accept server-socket))) + (count 1)) + (if (not conn) + (exit 1) + (if (> count 0) + (serve (false-if-exception (accept server-socket)) + (- count 1))))) + (exit 0)) + (else ;; the parent + (set! server-pid pid) + #t)))) + + (pass-if "connect" + (if (not server-pid) + (throw 'unresolved) + (let ((s (socket AF_INET6 SOCK_STREAM 0))) + (connect s AF_INET6 ipv6-addr server-port) + #t))) + + (pass-if "connect/sockaddr" + (if (not server-pid) + (throw 'unresolved) + (let ((s (socket AF_INET6 SOCK_STREAM 0))) + (connect s (make-socket-address AF_INET6 ipv6-addr server-port)) + #t))) + + (pass-if "accept" + (if (not server-pid) + (throw 'unresolved) + (let ((status (cdr (waitpid server-pid)))) + (eq? 0 (status:exit-val status))))) + + #t)))
\ No newline at end of file |