Add accept4 support

* doc/ref/posix.texi (Network Sockets and Communication): Add
  documentation.
* libguile/socket.c (scm_accept4): New function, replaces accept
  implementation.
  (scm_accept): Call scm_accept4.
  (scm_init_socket): Define SOCK_CLOEXEC and SOCK_NONBLOCK.
* libguile/socket.h: Add private scm_accept4 decl.
* module/ice-9/suspendable-ports.scm (accept): Update.

4 files changed, 28 insertions, 9 deletions

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index bcb16bd1a..4afe6bf20 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -3276,7 +3276,7 @@ the queue.
 The return value is unspecified.
 @end deffn
 
-@deffn {Scheme Procedure} accept sock
+@deffn {Scheme Procedure} accept sock [flags]
 @deffnx {C Function} scm_accept (sock)
 Accept a connection from socket port @var{sock} which has been enabled
 for listening with @code{listen} above.
@@ -3300,6 +3300,10 @@ connected and ready to communicate.  The @code{cdr} is a socket address
 object (@pxref{Network Socket Address}) which is where the remote
 connection is from (like @code{getpeername} below).
 
+@var{flags}, if given, may include @code{SOCK_CLOEXEC} or
+@code{SOCK_NONBLOCK}, which like @code{O_CLOEXEC} and @code{O_NONBLOCK}
+apply to the newly accepted socket.
+
 All communication takes place using the new socket returned.  The
 given @var{sock} remains bound and listening, and @code{accept} may be
 called on it again to get another incoming connection when desired.
diff --git a/libguile/socket.c b/libguile/socket.c
index 9ddc4a21f..64df64f4b 100644
--- a/libguile/socket.c
+++ b/libguile/socket.c
@@ -1243,8 +1243,8 @@ SCM_DEFINE (scm_make_socket_address, "make-socket-address", 2, 0, 1,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_accept, "accept", 1, 0, 0, 
-            (SCM sock),
+SCM_DEFINE (scm_accept4, "accept", 1, 1, 0, 
+            (SCM sock, SCM flags),
 	    "Accept a connection on a bound, listening socket.  If there\n"
 	    "are no pending connections in the queue, there are two\n"
             "possibilities: if the socket has been configured as\n"
@@ -1256,10 +1256,11 @@ SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
             "initiated the connection.\n\n"
 	    "@var{sock} does not become part of the\n"
 	    "connection and will continue to accept new requests.")
-#define FUNC_NAME s_scm_accept
+#define FUNC_NAME s_scm_accept4
 {
   int fd;
   int newfd;
+  int c_flags;
   SCM address;
   SCM newsock;
   socklen_t addr_size = MAX_ADDR_SIZE;
@@ -1267,8 +1268,11 @@ SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
 
   sock = SCM_COERCE_OUTPORT (sock);
   SCM_VALIDATE_OPFPORT (1, sock);
+  c_flags = SCM_UNBNDP (flags) ? 0 : scm_to_int (flags);
+
   fd = SCM_FPORT_FDES (sock);
-  SCM_SYSCALL (newfd = accept4 (fd, (struct sockaddr *) &addr, &addr_size, 0));
+  SCM_SYSCALL (newfd = accept4 (fd, (struct sockaddr *) &addr, &addr_size,
+                                c_flags));
   if (newfd == -1)
     {
       if (errno == EAGAIN || errno == EWOULDBLOCK)
@@ -1276,13 +1280,18 @@ SCM_DEFINE (scm_accept, "accept", 1, 0, 0,
       SCM_SYSERROR;
     }
   newsock = scm_socket_fd_to_port (newfd);
-  address = _scm_from_sockaddr (&addr, addr_size,
-				FUNC_NAME);
+  address = _scm_from_sockaddr (&addr, addr_size, FUNC_NAME);
 
   return scm_cons (newsock, address);
 }
 #undef FUNC_NAME
 
+SCM
+scm_accept (SCM sock)
+{
+  return scm_accept4 (sock, SCM_UNDEFINED);
+}
+
 SCM_DEFINE (scm_getsockname, "getsockname", 1, 0, 0, 
             (SCM sock),
 	    "Return the address of @var{sock}, in the same form as the\n"
@@ -1644,6 +1653,11 @@ scm_init_socket ()
   scm_c_define ("SOCK_RDM", scm_from_int (SOCK_RDM));
 #endif
 
+  /* accept4 flags.  No ifdef as accept4 has a gnulib
+     implementation.  */
+  scm_c_define ("SOCK_CLOEXEC", scm_from_int (SOCK_CLOEXEC));
+  scm_c_define ("SOCK_NONBLOCK", scm_from_int (SOCK_NONBLOCK));
+
   /* setsockopt level.
 
      SOL_IP, SOL_TCP and SOL_UDP are defined on gnu/linux, but not on for
diff --git a/libguile/socket.h b/libguile/socket.h
index a211867c6..d7c368a22 100644
--- a/libguile/socket.h
+++ b/libguile/socket.h
@@ -42,6 +42,7 @@ SCM_API SCM scm_shutdown (SCM sfd, SCM how);
 SCM_API SCM scm_connect (SCM sockfd, SCM fam, SCM address, SCM args);
 SCM_API SCM scm_bind (SCM sockfd, SCM fam, SCM address, SCM args);
 SCM_API SCM scm_listen (SCM sfd, SCM backlog);
+SCM_INTERNAL SCM scm_accept4 (SCM sockfd, SCM flags);
 SCM_API SCM scm_accept (SCM sockfd);
 SCM_API SCM scm_getsockname (SCM sockfd);
 SCM_API SCM scm_getpeername (SCM sockfd);
diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm
index 8ff0ba029..a366c8b9c 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -678,9 +678,9 @@
 
 (define accept
   (let ((%accept (@ (guile) accept)))
-    (lambda (port)
+    (lambda* (port #:optional (flags 0))
       (let lp ()
-        (or (%accept port)
+        (or (%accept port flags)
             (begin
               (wait-for-readable port)
               (lp)))))))