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.

diff --git a/NEWS b/NEWS
index 04b6b39..66e21de 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -805,6 +805,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
+** Fix `wrong type arg' exceptions with IPv6 addresses
 
 \f
 Changes in 1.8.7 (since 1.8.6)

diff --git a/libguile/socket.c b/libguile/socket.c
index 3a81ed9..0574707 100644 (file)
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -349,7 +349,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
@@ -1169,7 +1169,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 7626cee..718fb94 100644 (file)
--- 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