ffi: move socket stuff to socket module.

* alloca.h (zalloca): Macro moved here from ffi.c; it's useful
to any code that wants to do a zero-filled alloca, and
socket.c needs it now.

* ffi.c (HAVE_SOCKETS): All includes conditional on HAVE_SOCKETS
removed.
(zalloca): Macro removed; moved to alloca.h.
(ffi_type_struct_checked, ffi_type_lookup): Static functions
changed to external linkage.
(ffi_type_size, ffi_type_put, ffi_type_get): New functions,
used by external module that has incomplete definition of
struct txr_ffi_type.
(type_by_size): New static array, moved out of
ffi_init_extra_types function.
(ffi_type_by_size): New function.
(ffi_init_extra_types): type_by_size array relocated to
file scope.
(sock_opt, sock_set_opt): Moved to socket.c, and adjusted to
use newly developed external access to needed ffi mechanisms.
(ffi_init): Numerous definitions related to sockets removed;
these go to socket.c.

* ffi.h (struct txr_ffi_type): Declared here now as
incomplete type.
(ffi_type_struct_checked, ffi_type_size, ffi_type_put,
ffi_type_get, ffi_type_lookup, ffi_type_by_size): Declared.

* lib.c (init): Call new function sock_init.

* socket.c (sock_opt, sock_set_opt): New functions, moved
from ffi.c, and slightly adapted to work with external
interfaces exposed by ffi.c.
(sock_init): New function. This performs unconditional
initializations not keyed to the lazy loading lisplib.c
mechanism. Here we create the socklen-t FFI type.
FFI types lookup doesn't trigger lazy loading, so we do it
this way; the alternative would be to introduce lazy load
triggering to FFI type lookup, just for this one type.
(sock_load_init): All the socket function and variable
registrations move here from ffi_init.

1 files changed, 96 insertions, 0 deletions

diff --git a/socket.c b/socket.c
index b161aa75..56f6773c 100644
--- a/socket.c
+++ b/socket.c
@@ -50,6 +50,7 @@
 #include <sys/time.h>
 #endif
 #include <netinet/in.h>
+#include <netinet/tcp.h>
 #include "lib.h"
 #include "stream.h"
 #include "signal.h"
@@ -61,6 +62,8 @@
 #include "struct.h"
 #include "arith.h"
 #include "sysif.h"
+#include "itypes.h"
+#include "ffi.h"
 #include "socket.h"
 
 #define MIN(A, B) ((A) < (B) ? (A) : (B))
@@ -1153,6 +1156,68 @@ static val socketpair_wrap(val family, val type, val mode_str)
   return out;
 }
 
+static val sock_opt(val sock, val level, val option, val type_opt)
+{
+  val self = lit("sock-opt");
+  val sfd = stream_fd(sock);
+  int lvl = c_int(level, self);
+  int opt = c_int(option, self);
+  val type = default_arg(type_opt, ffi_type_lookup(int_s));
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
+
+  if (!sfd) {
+    uw_throwf(socket_error_s, lit("~a: cannot get option on ~s"),
+              self, sock, nao);
+  } else {
+    socklen_t typesize = convert(socklen_t, ffi_type_size(tft));
+    socklen_t size = typesize;
+    mem_t *data = coerce(mem_t *, zalloca(size));
+    if (getsockopt(c_num(sfd, self), lvl, opt, data, &size) != 0)
+      uw_ethrowf(socket_error_s, lit("~a failed on ~s: ~d/~s"),
+                 self, sock, num(errno), errno_to_str(errno), nao);
+    /* TODO: Add a separate function to handle options with
+     * variable-size values, for example the platform-specific
+     * SO_BINDTODEVICE.
+     * (Or perhaps add an optional argument following type_opt
+     * specifying the requested length of the value, presumably of type
+     * carray.) */
+    if (size != typesize)
+      uw_throwf(socket_error_s, lit("~a: variable-size option on ~s"),
+                self, sock, nao);
+    return ffi_type_get(tft, data, self);
+  }
+}
+
+static val sock_set_opt(val sock, val level, val option, val value,
+                        val type_opt)
+{
+  val self = lit("sock-set-opt");
+  val sfd = stream_fd(sock);
+  int lvl = c_int(level, self);
+  int opt = c_int(option, self);
+  val type = default_arg(type_opt, ffi_type_lookup(int_s));
+  struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
+
+  if (!sfd) {
+    uw_throwf(socket_error_s, lit("~a: cannot set option on ~s"),
+              self, sock, nao);
+  } else {
+    socklen_t size = convert(socklen_t, ffi_type_size(tft));
+    mem_t *data = coerce(mem_t *, zalloca(size));
+    ffi_type_put(tft, value, data, self);
+    if (setsockopt(c_num(sfd, self), lvl, opt, data, size) != 0)
+      uw_ethrowf(socket_error_s, lit("~a failed on ~s: ~d/~s"),
+                 self, sock, num(errno), errno_to_str(errno), nao);
+    return value;
+  }
+}
+
+void sock_init(void)
+{
+  ffi_typedef(intern(lit("socklen-t"), user_package),
+              ffi_type_by_size(convert(socklen_t, -1) > 0, sizeof (socklen_t)));
+}
+
 void sock_load_init(void)
 {
   sockaddr_in_s = intern(lit("sockaddr-in"), user_package);
@@ -1217,6 +1282,37 @@ void sock_load_init(void)
   reg_fun(intern(lit("sock-send-timeout"), user_package), func_n2(sock_send_timeout));
   reg_fun(intern(lit("sock-recv-timeout"), user_package), func_n2(sock_recv_timeout));
 #endif
+  reg_fun(intern(lit("sock-opt"), user_package), func_n4o(sock_opt, 3));
+  reg_fun(intern(lit("sock-set-opt"), user_package), func_n5o(sock_set_opt, 4));
+  reg_varl(intern(lit("sol-socket"), user_package), num_fast(SOL_SOCKET));
+  reg_varl(intern(lit("ipproto-ip"), user_package), num_fast(IPPROTO_IP));
+  reg_varl(intern(lit("ipproto-ipv6"), user_package), num_fast(IPPROTO_IPV6));
+  reg_varl(intern(lit("ipproto-tcp"), user_package), num_fast(IPPROTO_TCP));
+  reg_varl(intern(lit("ipproto-udp"), user_package), num_fast(IPPROTO_UDP));
+  reg_varl(intern(lit("so-acceptconn"), user_package), num_fast(SO_ACCEPTCONN));
+  reg_varl(intern(lit("so-broadcast"), user_package), num_fast(SO_BROADCAST));
+  reg_varl(intern(lit("so-debug"), user_package), num_fast(SO_DEBUG));
+  reg_varl(intern(lit("so-dontroute"), user_package), num_fast(SO_DONTROUTE));
+  reg_varl(intern(lit("so-error"), user_package), num_fast(SO_ERROR));
+  reg_varl(intern(lit("so-keepalive"), user_package), num_fast(SO_KEEPALIVE));
+  reg_varl(intern(lit("so-linger"), user_package), num_fast(SO_LINGER));
+  reg_varl(intern(lit("so-oobinline"), user_package), num_fast(SO_OOBINLINE));
+  reg_varl(intern(lit("so-rcvbuf"), user_package), num_fast(SO_RCVBUF));
+  reg_varl(intern(lit("so-rcvlowat"), user_package), num_fast(SO_RCVLOWAT));
+  reg_varl(intern(lit("so-rcvtimeo"), user_package), num_fast(SO_RCVTIMEO));
+  reg_varl(intern(lit("so-reuseaddr"), user_package), num_fast(SO_REUSEADDR));
+  reg_varl(intern(lit("so-sndbuf"), user_package), num_fast(SO_SNDBUF));
+  reg_varl(intern(lit("so-sndlowat"), user_package), num_fast(SO_SNDLOWAT));
+  reg_varl(intern(lit("so-sndtimeo"), user_package), num_fast(SO_SNDTIMEO));
+  reg_varl(intern(lit("so-type"), user_package), num_fast(SO_TYPE));
+  reg_varl(intern(lit("ipv6-join-group"), user_package), num_fast(IPV6_JOIN_GROUP));
+  reg_varl(intern(lit("ipv6-leave-group"), user_package), num_fast(IPV6_LEAVE_GROUP));
+  reg_varl(intern(lit("ipv6-multicast-hops"), user_package), num_fast(IPV6_MULTICAST_HOPS));
+  reg_varl(intern(lit("ipv6-multicast-if"), user_package), num_fast(IPV6_MULTICAST_IF));
+  reg_varl(intern(lit("ipv6-multicast-loop"), user_package), num_fast(IPV6_MULTICAST_LOOP));
+  reg_varl(intern(lit("ipv6-unicast-hops"), user_package), num_fast(IPV6_UNICAST_HOPS));
+  reg_varl(intern(lit("ipv6-v6only"), user_package), num_fast(IPV6_V6ONLY));
+  reg_varl(intern(lit("tcp-nodelay"), user_package), num_fast(TCP_NODELAY));
 
   fill_stream_ops(&dgram_strm_ops);
   dgram_strm_ops.get_sock_family = dgram_get_sock_family;