ffi, sockets: add sock-opt and sock-set-opt.

The new sock-opt and sock-set-opt functions are wrappers around
getsockopt and setsockopt, respectively.

All POSIX socket options are registered. Platform-specific
options may be added in the future.

* ffi.c (sock_opt, sock_set_opt): New functions.
(ffi_init): Register sock-opt, sock-set-opt, sol-socket,
ipproto-ip, ipproto-ipv6, ipproto-tcp, ipproto-udp,
so-acceptconn, so-broadcast, so-debug, so-dontroute, so-error,
so-keepalive, so-linger, so-oobinline, so-rcvbuf, so-rcvlowat,
so-rcvtimeo, so-reuseaddr, so-sndbuf, so-sndlowat, so-sndtimeo,
so-type, ipv6-join-group, ipv6-leave-group, ipv6-multicast-hops,
ipv6-multicast-if, ipv6-multicast-loop, ipv6-unicast-hops,
ipv6-v6only, tcp-nodelay.

* lisplib.c (sock_set_entries): Add sock-opt and sock-set-opt.

* stdlib/socket.tl (sock-opt): Define as syntactic place.

* tests/014/socket-misc.tl: New cases, for sock-opt.
(set-and-get): New macro.

* txr.1: Documented. Also, mention that sock-bind enables
so-reuseaddr.

* stdlib/doc-syms.tl: Updated.

1 files changed, 94 insertions, 0 deletions

diff --git a/ffi.c b/ffi.c
index c8239a3b..dc92c5b2 100644
--- a/ffi.c
+++ b/ffi.c
@@ -46,6 +46,8 @@
 #endif
 #if HAVE_SOCKETS
 #include <sys/socket.h>
+#include <netinet/in.h>
+#include <netinet/tcp.h>
 #endif
 #if HAVE_MMAP
 #include <sys/mman.h>
@@ -6608,6 +6610,65 @@ static val dyn_size(val type, val obj)
   return num(tft->dynsize(tft, obj, self));
 }
 
+#if HAVE_SOCKETS
+
+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 size = coerce(socklen_t, tft->size);
+    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 != coerce(socklen_t, tft->size))
+      uw_throwf(socket_error_s, lit("~a: variable-size option on ~s"),
+                self, sock, nao);
+    return tft->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 = coerce(socklen_t, tft->size);
+    mem_t *data = coerce(mem_t *, zalloca(size));
+    tft->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;
+  }
+}
+
+#endif
+
 void ffi_init(void)
 {
   prot1(&ffi_typedef_hash);
@@ -6804,6 +6865,39 @@ void ffi_init(void)
   reg_fun(intern(lit("get-obj"), user_package), func_n2o(get_obj, 1));
   reg_fun(intern(lit("fill-obj"), user_package), func_n3o(fill_obj, 2));
   reg_fun(intern(lit("dyn-size"), system_package), func_n2(dyn_size));
+#if HAVE_SOCKETS
+  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));
+#endif
   ffi_typedef_hash = make_hash(hash_weak_none, nil);
   ffi_struct_tag_hash = make_hash(hash_weak_none, nil);
   ffi_init_types();