Add open-unix-server-socket and unix-server-connection-accept...

...and close-unix-server-socket.

diff --git a/src/microcode/ntsock.c b/src/microcode/ntsock.c
index d913bf4562b946a78d2f3f81c56827977a8f42c8..076251214127d54b18884b3323fafee9a9b9d38b 100644 (file)
--- a/src/microcode/ntsock.c
+++ b/src/microcode/ntsock.c
@@ -236,7 +236,7 @@ OS_listen_tcp_server_socket (Tchannel channel)
 }
 
 Tchannel
-OS_server_connection_accept (Tchannel channel,
+OS_tcp_server_connection_accept (Tchannel channel,
                             void * peer_host, unsigned int * peer_port)
 {
   static struct sockaddr_in address;

diff --git a/src/microcode/os2sock.c b/src/microcode/os2sock.c
index 7112e11a3f7e6fe50148ea152e3a9da0dddb16d2..583fa1a2baf83804a0d7598ece1b1064b36077ca 100644 (file)
--- a/src/microcode/os2sock.c
+++ b/src/microcode/os2sock.c
@@ -250,7 +250,7 @@ OS_listen_tcp_server_socket (Tchannel channel)
 }
 
 Tchannel
-OS_server_connection_accept (Tchannel channel,
+OS_tcp_server_connection_accept (Tchannel channel,
                             void * peer_host, unsigned int * peer_port)
 {
   static struct sockaddr_in address;

diff --git a/src/microcode/osio.h b/src/microcode/osio.h
index 4bef9dc650e70e8a43c4b0cab0b998b901b52f63..8fb17a4a6c7d7de506f498e3997471d4ba16f34e 100644 (file)
--- a/src/microcode/osio.h
+++ b/src/microcode/osio.h
@@ -38,6 +38,7 @@ enum channel_type
   channel_type_unix_fifo,
   channel_type_terminal,
   channel_type_unix_pty_master,
+  channel_type_unix_server_socket,
   channel_type_unix_stream_socket,
   channel_type_tcp_stream_socket,
   channel_type_tcp_server_socket,

diff --git a/src/microcode/pruxsock.c b/src/microcode/pruxsock.c
index a14a8ac39a9b72873f061c9d9c8ac8afc6d8bc16..2b4a398c369075cc5f26c47c31fcc1be1a9a4bd9 100644 (file)
--- a/src/microcode/pruxsock.c
+++ b/src/microcode/pruxsock.c
@@ -75,7 +75,7 @@ arg_client_socket (unsigned int arg)
 }
 
 static Tchannel
-arg_server_socket (unsigned int arg)
+arg_tcp_server_socket (unsigned int arg)
 {
   Tchannel server_socket = (arg_nonnegative_integer (arg));
   if ((OS_channel_type (server_socket)) != channel_type_tcp_server_socket)
@@ -83,6 +83,17 @@ arg_server_socket (unsigned int arg)
   return (server_socket);
 }
 
+#ifdef HAVE_UNIX_SOCKETS
+static Tchannel
+arg_unix_server_socket (unsigned int arg)
+{
+  Tchannel server_socket = (arg_nonnegative_integer (arg));
+  if ((OS_channel_type (server_socket)) != channel_type_unix_server_socket)
+    error_bad_range_arg (arg);
+  return (server_socket);
+}
+#endif /* HAVE_UNIX_SOCKETS */
+
 #else /* not HAVE_SOCKETS */
 
 #define SOCKET_CODE(code)                                              \
@@ -298,12 +309,30 @@ DEFINE_PRIMITIVE ("CREATE-TCP-SERVER-SOCKET", Prim_create_tcp_server_socket, 0,
     });
 }
 
+DEFINE_PRIMITIVE ("CREATE-UNIX-SERVER-SOCKET", Prim_create_unix_server_socket, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  CHECK_ARG (2, WEAK_PAIR_P);
+#ifdef HAVE_UNIX_SOCKETS
+  {
+    Tchannel channel = OS_create_unix_server_socket (STRING_ARG (1));
+    if (channel == NO_CHANNEL)
+      PRIMITIVE_RETURN (SHARP_F);
+    SET_PAIR_CDR ((ARG_REF (2)), (long_to_integer (channel)));
+    PRIMITIVE_RETURN (SHARP_T);
+  }
+#else
+  signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);
+  PRIMITIVE_RETURN (UNSPECIFIC);
+#endif
+}
+
 DEFINE_PRIMITIVE ("BIND-TCP-SERVER-SOCKET", Prim_bind_tcp_server_socket, 3, 3, 0)
 {
   PRIMITIVE_HEADER (3);
   SOCKET_CODE
     ({
-      OS_bind_tcp_server_socket ((arg_server_socket (1)),
+      OS_bind_tcp_server_socket ((arg_tcp_server_socket (1)),
                                 (arg_host (2)),
                                 (arg_nonnegative_integer (3)));
       PRIMITIVE_RETURN (UNSPECIFIC);
@@ -315,7 +344,7 @@ DEFINE_PRIMITIVE ("LISTEN-TCP-SERVER-SOCKET", Prim_listen_tcp_server_socket, 1,
   PRIMITIVE_HEADER (1);
   SOCKET_CODE
     ({
-      OS_listen_tcp_server_socket (arg_server_socket (1));
+      OS_listen_tcp_server_socket (arg_tcp_server_socket (1));
       PRIMITIVE_RETURN (UNSPECIFIC);
     });
 }
@@ -332,13 +361,38 @@ It is filled with the peer's address if given.")
   CHECK_ARG (3, WEAK_PAIR_P);
   SOCKET_CODE
     ({
-      Tchannel server_socket = (arg_server_socket (1));
+      Tchannel server_socket = (arg_tcp_server_socket (1));
       void * peer_host = (((ARG_REF (2)) == SHARP_F) ? 0 : (arg_host (2)));
       Tchannel connection =
-       (OS_server_connection_accept (server_socket, peer_host, 0));
+       (OS_tcp_server_connection_accept (server_socket, peer_host, 0));
       if (connection == NO_CHANNEL)
        PRIMITIVE_RETURN (SHARP_F);
       SET_PAIR_CDR ((ARG_REF (3)), (long_to_integer (connection)));
       PRIMITIVE_RETURN (SHARP_T);
     });
 }
+
+DEFINE_PRIMITIVE ("NEW-UNIX-SERVER-CONNECTION-ACCEPT",
+                 Prim_new_unix_server_connection_accept, 2, 2,
+  "Poll SERVER-SOCKET for a connection.\n\
+If a connection is available, it is opened and #T is returned;\n\
+the opened socket is stored in the cdr of WEAK-PAIR.\n\
+Otherwise, if SERVER-SOCKET is non-blocking, returns #F.")
+{
+  PRIMITIVE_HEADER (2);
+  CHECK_ARG (2, WEAK_PAIR_P);
+#ifdef HAVE_UNIX_SOCKETS
+  {
+    Tchannel server_socket = (arg_unix_server_socket (1));
+    Tchannel connection =
+      (OS_unix_server_connection_accept (server_socket));
+    if (connection == NO_CHANNEL)
+      PRIMITIVE_RETURN (SHARP_F);
+    SET_PAIR_CDR ((ARG_REF (2)), (long_to_integer (connection)));
+    PRIMITIVE_RETURN (SHARP_T);
+  }
+#else
+  signal_error_from_primitive (ERR_UNIMPLEMENTED_PRIMITIVE);
+  PRIMITIVE_RETURN (UNSPECIFIC);
+#endif
+}

diff --git a/src/microcode/uxsock.c b/src/microcode/uxsock.c
index 6a28086fd1c83b6961e1eee4ab71e5113e2bc41e..bac23f9febff5134849dbece27c31fae7cb1af29 100644 (file)
--- a/src/microcode/uxsock.c
+++ b/src/microcode/uxsock.c
@@ -290,11 +290,42 @@ OS_listen_tcp_server_socket (Tchannel channel)
     (syscall_listen,
      (UX_listen ((CHANNEL_DESCRIPTOR (channel)), SOCKET_LISTEN_BACKLOG)));
 }
-\f
+
+#ifdef HAVE_UNIX_SOCKETS
+Tchannel
+OS_create_unix_server_socket (const char * filename)
+{
+  int s;
+  Tchannel channel;
+
+  transaction_begin ();
+  STD_FD_SYSTEM_CALL
+    (syscall_socket, s, (UX_socket (AF_UNIX, SOCK_STREAM, 0)));
+  MAKE_CHANNEL (s, channel_type_unix_server_socket, channel =);
+  OS_channel_close_on_abort (channel);
+  {
+    struct sockaddr_un address;
+    memset((&address), 0, (sizeof (address)));
+    (address . sun_family) = AF_UNIX;
+    strncpy ((address . sun_path), filename, (sizeof (address . sun_path)));
+    STD_VOID_SYSTEM_CALL
+      (syscall_bind,
+       (UX_bind ((CHANNEL_DESCRIPTOR (channel)),
+                ((struct sockaddr *) (&address)),
+                (sizeof (struct sockaddr_un)))));
+    STD_VOID_SYSTEM_CALL
+      (syscall_listen,
+       (UX_listen ((CHANNEL_DESCRIPTOR (channel)), SOCKET_LISTEN_BACKLOG)));
+  }
+  transaction_commit ();
+  return (channel);
+}
+#endif /* HAVE_UNIX_SOCKETS */
+
 Tchannel
-OS_server_connection_accept (Tchannel channel,
-                            void * peer_host,
-                            unsigned int * peer_port)
+OS_tcp_server_connection_accept (Tchannel channel,
+                                void * peer_host,
+                                unsigned int * peer_port)
 {
   static struct sockaddr_in address;
   socklen_t address_length = (sizeof (struct sockaddr_in));
@@ -327,4 +358,29 @@ OS_server_connection_accept (Tchannel channel,
   MAKE_CHANNEL (s, channel_type_tcp_stream_socket, return);
 }
 
-#endif /* not HAVE_SOCKETS */
+#ifdef HAVE_UNIX_SOCKETS
+Tchannel
+OS_unix_server_connection_accept (Tchannel channel)
+{
+  int s;
+  while (1)
+    {
+      s = (UX_accept ((CHANNEL_DESCRIPTOR (channel)), NULL, NULL));
+      if (s >= 0)
+       break;
+#ifdef EAGAIN
+      if (errno == EAGAIN)
+       return (NO_CHANNEL);
+#endif
+#ifdef EWOULDBLOCK
+      if (errno == EWOULDBLOCK)
+       return (NO_CHANNEL);
+#endif
+      UX_prim_check_fd_errno (syscall_accept);
+    }
+  UX_out_of_files_p = false;
+  MAKE_CHANNEL (s, channel_type_unix_stream_socket, return);
+}
+#endif /* HAVE_UNIX_SOCKETS */
+
+#endif /* HAVE_SOCKETS */

diff --git a/src/microcode/uxsock.h b/src/microcode/uxsock.h
index b723bee9f301820db3989c465d2a5ad6ea85fca6..728b4e09f3840a1d1923f249b50e8f0fb1fde52e 100644 (file)
--- a/src/microcode/uxsock.h
+++ b/src/microcode/uxsock.h
@@ -42,12 +42,14 @@ extern void OS_host_address_any (void *);
 extern void OS_host_address_loopback (void *);
 
 #ifdef HAVE_UNIX_SOCKETS
-   extern Tchannel OS_open_unix_stream_socket (const char *);
+  extern Tchannel OS_open_unix_stream_socket (const char *);
+  extern Tchannel OS_create_unix_server_socket (const char *);
+  extern Tchannel OS_unix_server_connection_accept (Tchannel);
 #endif
 
 extern Tchannel OS_create_tcp_server_socket (void);
 extern void OS_bind_tcp_server_socket (Tchannel, void *, unsigned int);
 extern void OS_listen_tcp_server_socket (Tchannel);
-extern Tchannel OS_server_connection_accept (Tchannel, void *, unsigned int *);
+extern Tchannel OS_tcp_server_connection_accept (Tchannel, void *, unsigned int *);
 
 #endif /* SCM_UXSOCK_H */

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index d10db78ab8d43a1da3ef900bb88e5b6961868d99..ac93c1762cfc6b39101a6fd7a6e9153700f42dd9 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3831,6 +3831,7 @@ USA.
          bind-tcp-server-socket
          canonical-host-name
          close-tcp-server-socket
+         close-unix-server-socket
          create-tcp-server-socket
          get-host-by-address
          get-host-by-name
@@ -3841,10 +3842,12 @@ USA.
          open-tcp-server-socket
          open-tcp-stream-socket
          open-tcp-stream-socket-channel
+         open-unix-server-socket
          open-unix-stream-socket
          open-unix-stream-socket-channel
          os/hostname
-         tcp-server-connection-accept)
+         tcp-server-connection-accept
+         unix-server-connection-accept)
   (initialization (initialize-package!)))
 
 (define-package (runtime subprocess)

diff --git a/src/runtime/socket.scm b/src/runtime/socket.scm
index 40070120fbfee73c739483ffedaa960c040369fc..8b8de1ca152060a4a03f7b3c70cce4550d12efc7 100644 (file)
--- a/src/runtime/socket.scm
+++ b/src/runtime/socket.scm
@@ -60,10 +60,31 @@ USA.
       ((ucode-primitive get-service-by-number 1) service)
       ((ucode-primitive get-service-by-name 2) service "tcp")))
 
+(define (open-unix-server-socket pathname)
+  (open-channel
+   (lambda (p)
+     ((ucode-primitive create-unix-server-socket 2) (->namestring pathname) p)
+     #t)))
+
 (define (close-tcp-server-socket server-socket)
   (channel-close server-socket))
 
+(define (close-unix-server-socket server-socket)
+  (channel-close server-socket))
+
 (define (tcp-server-connection-accept server-socket block? peer-address)
+  (connection-accept (ucode-primitive new-tcp-server-connection-accept 3)
+                    server-socket block? peer-address))
+
+(define (unix-server-connection-accept server-socket block?)
+  (connection-accept (named-lambda (new-unix-server-connection-accept
+                                   socket peer pair)
+                      (declare (ignore peer))
+                      ((ucode-primitive new-unix-server-connection-accept 2)
+                       socket pair))
+                    server-socket block? #f))
+
+(define (connection-accept accept! server-socket block? peer-address)
   (let ((channel
         (with-thread-events-blocked
           (lambda ()
@@ -79,9 +100,7 @@ USA.
                            (lambda (p)
                              (with-thread-timer-stopped
                                (lambda ()
-                                 ((ucode-primitive
-                                   new-tcp-server-connection-accept
-                                   3)
+                                 (accept!
                                   (channel-descriptor server-socket)
                                   peer-address
                                   p))))))