[Guile-commits] GNU Guile branch, master, updated. release_1-9-3-50-g1ff4da6

[Neil Jerram]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=1ff4da6570d17b7ce5b74b926e8f9f2c99757896

The branch, master has been updated
       via  1ff4da6570d17b7ce5b74b926e8f9f2c99757896 (commit)
      from  32bc92570eb9282e46c1b851cc65cae946547ea9 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 1ff4da6570d17b7ce5b74b926e8f9f2c99757896
Author: Neil Jerram <address@hidden>
Date:   Thu Oct 1 23:27:59 2009 +0100

    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.

-----------------------------------------------------------------------

Summary of changes:
 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 04b6b39..66e21de 100644
--- 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
 
 
 Changes in 1.8.7 (since 1.8.6)
diff --git a/libguile/socket.c b/libguile/socket.c
index 3a81ed9..0574707 100644
--- 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
--- 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


hooks/post-receive
-- 
GNU Guile