From 451e15a06c744e49a1bdab6df6d86e0f96d3aa14 Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@ossau.uklinux.net>
Date: Thu, 1 Oct 2009 23:43:54 +0100
Subject: [PATCH] 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.
---
 NEWS                         |  1 +
 libguile/socket.c            |  5 ++-
 test-suite/tests/socket.test | 85 ++++++++++++++++++++++++++++++++++++
 3 files changed, 89 insertions(+), 2 deletions(-)

diff --git a/NEWS b/NEWS
index 20c0f5531..9d84e0669 100644
--- a/NEWS
+++ b/NEWS
@@ -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