From: Matt Birkholz Date: Sat, 16 Jan 2016 20:56:18 +0000 (-0700) Subject: Add open-unix-server-socket and unix-server-connection-accept... X-Git-Tag: mit-scheme-pucked-9.2.12~373^2 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f0f7294aa4aaa92c901866271ae6fe39966de7da;p=mit-scheme.git 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 d913bf456..076251214 100644 --- 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 7112e11a3..583fa1a2b 100644 --- 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 4bef9dc65..8fb17a4a6 100644 --- 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 a14a8ac39..2b4a398c3 100644 --- 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 6a28086fd..bac23f9fe 100644 --- 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))); } - + +#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 b723bee9f..728b4e09f 100644 --- 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 d10db78ab..ac93c1762 100644 --- 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 40070120f..8b8de1ca1 100644 --- 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))))))