summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ffi.c94
-rw-r--r--lisplib.c1
-rw-r--r--stdlib/doc-syms.tl31
-rw-r--r--stdlib/socket.tl7
-rw-r--r--tests/014/socket-misc.tl12
-rw-r--r--txr.1189
6 files changed, 329 insertions, 5 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();
diff --git a/lisplib.c b/lisplib.c
index f1e41547..582788f2 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -350,6 +350,7 @@ static val sock_set_entries(val dlt, val fun)
lit("sock-bind"), lit("sock-connect"), lit("sock-listen"),
lit("sock-accept"), lit("sock-shutdown"), lit("open-socket"),
lit("open-socket-pair"), lit("sock-send-timeout"), lit("sock-recv-timeout"),
+ lit("sock-opt"), lit("sock-set-opt"),
nil
};
val name_noload[] = {
diff --git a/stdlib/doc-syms.tl b/stdlib/doc-syms.tl
index 8875254b..3de245da 100644
--- a/stdlib/doc-syms.tl
+++ b/stdlib/doc-syms.tl
@@ -1024,6 +1024,17 @@
("invoke-catch" "N-0337FC1B")
("ip" "N-011CFC0C")
("ipf" "N-012A7E6A")
+ ("ipproto-ip" "N-031C01CB")
+ ("ipproto-ipv6" "N-031C01CB")
+ ("ipproto-tcp" "N-031C01CB")
+ ("ipproto-udp" "N-031C01CB")
+ ("ipv6-join-group" "N-001E8B40")
+ ("ipv6-leave-group" "N-001E8B40")
+ ("ipv6-multicast-hops" "N-001E8B40")
+ ("ipv6-multicast-if" "N-001E8B40")
+ ("ipv6-multicast-loop" "N-001E8B40")
+ ("ipv6-unicast-hops" "N-001E8B40")
+ ("ipv6-v6only" "N-001E8B40")
("iread" "N-03FE5500")
("isatty" "N-03709E8A")
("isec" "N-0385B074")
@@ -1752,15 +1763,33 @@
("slots" "N-00E90177")
("slotset" "N-02657437")
("sme" "N-008C6621")
+ ("so-acceptconn" "N-02FFF4E8")
+ ("so-broadcast" "N-02FFF4E8")
+ ("so-debug" "N-02FFF4E8")
+ ("so-dontroute" "N-02FFF4E8")
+ ("so-error" "N-02FFF4E8")
+ ("so-keepalive" "N-02FFF4E8")
+ ("so-linger" "N-02FFF4E8")
+ ("so-oobinline" "N-02FFF4E8")
+ ("so-rcvbuf" "N-02FFF4E8")
+ ("so-rcvlowat" "N-02FFF4E8")
+ ("so-rcvtimeo" "N-02FFF4E8")
+ ("so-reuseaddr" "N-02FFF4E8")
+ ("so-sndbuf" "N-02FFF4E8")
+ ("so-sndlowat" "N-02FFF4E8")
+ ("so-sndtimeo" "N-02FFF4E8")
+ ("so-type" "N-02FFF4E8")
("sock-accept" "N-00AF0FE8")
("sock-bind" "N-02B052CF")
("sock-connect" "N-00E5DFD4")
("sock-dgram" "N-01D17D22")
("sock-family" "N-0323EB36")
("sock-listen" "N-02F624A8")
+ ("sock-opt" "N-022F35E2")
("sock-peer" "N-015ABEC7")
("sock-recv-timeout" "N-03DF15F2")
("sock-send-timeout" "N-03DF15F2")
+ ("sock-set-opt" "N-02A4F848")
("sock-set-peer" "N-01FE18ED")
("sock-shutdown" "N-0222BA70")
("sock-stream" "N-01D17D22")
@@ -1770,6 +1799,7 @@
("sockaddr-in6" "N-013DD169")
("sockaddr-un" "N-01DD05D2")
("socklen-t" "N-01153D9E")
+ ("sol-socket" "N-031C01CB")
("some" "D-0040")
("sort" "N-01FE5176")
("sort-group" "N-01E65DDC")
@@ -1891,6 +1921,7 @@
("tcoflush" "N-0279ED46")
("tcooff" "N-02173FF9")
("tcoon" "N-02173FF9")
+ ("tcp-nodelay" "N-02C5CE3B")
("tcsadrain" "N-02C6ECF5")
("tcsaflush" "N-02C6ECF5")
("tcsanow" "N-02C6ECF5")
diff --git a/stdlib/socket.tl b/stdlib/socket.tl
index 0b39151e..eac123be 100644
--- a/stdlib/socket.tl
+++ b/stdlib/socket.tl
@@ -272,3 +272,10 @@
^(macrolet ((,getter () ^(sock-peer ,',sock))
(,setter (val) ^(sock-set-peer ,',sock ,val)))
,body)))
+
+(defplace (sock-opt sock level option : type) body
+ (getter setter
+ ^(macrolet ((,getter () ^(sock-opt ,',sock ,',level ,',option ,',type))
+ (,setter (val)
+ ^(sock-set-opt ,',sock ,',level ,',option ,val ,',type)))
+ ,body)))
diff --git a/tests/014/socket-misc.tl b/tests/014/socket-misc.tl
index de57e465..bd94acac 100644
--- a/tests/014/socket-misc.tl
+++ b/tests/014/socket-misc.tl
@@ -1,8 +1,20 @@
+(load "../sock-common")
(load "../common")
+(defmacro set-and-get (:env env place val)
+ (with-update-expander (getter setter) place env
+ ^(progn (,setter ,val) (,getter))))
+
(with-stream (s (open-socket af-inet (logior sock-dgram sock-nonblock)))
(test (sock-listen s) t)
(let* ((orig #S(sockaddr-in))
(addr orig))
(rotate addr (sock-peer s))
(vtest (sock-peer s) orig)))
+
+(with-stream (s (open-socket af-inet sock-stream))
+ (test (set-and-get (sock-opt s sol-socket so-reuseaddr) 1) 1)
+ (test (set-and-get (sock-opt s sol-socket so-reuseaddr (ffi int)) 0) 0)
+ (whenlet ((addr (bindfree s 1025 65535)))
+ ;; sock-bind enables so-reuseaddr.
+ (test (sock-opt s sol-socket so-reuseaddr) 1)))
diff --git a/txr.1 b/txr.1
index 0e8b5b93..9e0d95eb 100644
--- a/txr.1
+++ b/txr.1
@@ -13847,6 +13847,7 @@ defined by \*(TX programs.
.mets (qref < struct-obj << slot-name ) ;; by macro-expansion to (slot ...)
.mets >< struct-obj . slot-name ;; equivalent to qref
.mets (sock-peer << socket )
+.mets (sock-opt < socket < level < option <> [ ffi-type ])
.mets (carray-sub < carray >> [ from <> [ to ]])
.mets (sub-buf < buf >> [ from <> [ to ]])
.mets (left << node )
@@ -71219,7 +71220,10 @@ is thrown.
.desc
The
.code sock-bind
-function binds a socket stream to a local address.
+function binds a socket stream to a local address
+after enabling the socket stream's
+.code so-reuseaddr
+option.
The
.meta address
@@ -71232,10 +71236,6 @@ If the operation fails, an exception of type
is thrown. Otherwise, the function returns
.codn t .
-Returns
-.code t
-if successful.
-
.coNP Function @ sock-listen
.synb
.mets (sock-listen < socket <> [ backlog ])
@@ -71369,6 +71369,185 @@ is thrown when an output operation waits for at least
.code usec
microseconds for the availability of buffer space in the socket.
+.coNP Variables @, sol-socket @, ipproto-ip @, ipproto-ipv6 @ ipproto-tcp and @ ipproto-udp
+.desc
+These variables represent the protocol levels of socket options and are
+suitable for use as the
+.meta level
+argument of the
+.code sock-opt
+and
+.code sock-set-opt
+functions.
+The variables correspond to the POSIX C constants
+.codn SOL_SOCKET ,
+.codn IPPROTO_IP ,
+.codn IPPROTO_IPV6 ,
+.code IPPROTO_TCP
+and
+.codn IPPROTO_UDP .
+
+.coNP Variables @, 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 and @ so-type
+.desc
+These variables represent socket options at the
+.code sol-socket
+protocol level and are suitable for use as the
+.meta option
+argument of the
+.code sock-opt
+and
+.code sock-set-opt
+functions.
+The variables correspond to the POSIX C constants
+.codn SO_ACCEPTCONN ,
+.codn SO_BROADCAST ,
+.codn SO_DEBUG ,
+etc.
+
+Note that the
+.code sock-recv-timeout
+and
+.code sock-send-timeout
+are a more convenient interface for setting the value of the
+.code so-rcvtimeo
+and
+.code so-sndtimeo
+socket options.
+
+.coNP Variables @, ipv6-join-group @, ipv6-leave-group @, ipv6-multicast-hops @, ipv6-multicast-if @, ipv6-multicast-loop @ ipv6-unicast-hops and @ ipv6-v6only
+.desc
+These variables represent socket options at the
+.code ipproto-ipv6
+protocol level and are suitable for use as the
+.meta option
+argument of the
+.code sock-opt
+and
+.code sock-set-opt
+functions.
+The variables correspond to the POSIX C constants
+.codn IPV6_JOIN_GROUP ,
+.codn IPV6_LEAVE_GROUP ,
+.codn IPV6_MULTICAST_HOPS ,
+etc.
+
+.coNP Variable @ tcp-nodelay
+.desc
+This variable represents a socket option at the
+.code ipproto-tcp
+protocol level and is suitable for use as the
+.meta option
+argument of the
+.code sock-opt
+and
+.code sock-set-opt
+functions.
+The variable corresponds to the POSIX C constant
+.codn TCP_NODELAY .
+
+.coNP Accessor @ sock-opt
+.synb
+.mets (sock-opt < socket < level < option <> [ ffi-type ])
+.mets (set (sock-opt < socket < level < option <> [ ffi-type ]) << value )
+.syne
+.desc
+The
+.code sock-opt
+function retrieves the value of the specified socket option,
+at the specified protocol level,
+associated with
+.codn socket ,
+which must be a socket stream.
+
+The
+.code level
+argument should be one of the protocol levels
+.codn sol-socket ,
+.codn ipproto-ip ,
+.codn ipproto-ipv6 ,
+.code ipproto-tcp
+and
+.codn ipproto-udp .
+
+The
+.code option
+argument should be one of the socket options
+.codn so-acceptconn ,
+.codn so-broadcast ,
+.codn so-debug ,
+\...,
+.codn ipv6-join-group ,
+\...,
+.code ipv6-v6only
+and
+.codn tcp-nodelay .
+
+The
+.meta ffi-type
+argument, which must be a compiled FFI type,
+specifies the type of the socket option's value.
+The type is most commonly
+.code int
+or
+.codn uint ,
+but it can be any other fixed-size type, including
+.codn struct s.
+(Variable-size types, such as C
+.code char
+arrays, are unsupported.)
+The
+.meta ffi-type
+argument defaults to
+.codn "(ffi int)" .
+
+Assigning a value to a
+.code sock-opt
+place is equivalent to calling
+.code sock-set-opt
+with that value.
+
+Note: the
+.code sock-opt
+and
+.code sock-set-opt
+functions call the POSIX C
+.code getsockopt
+and
+.code setsockopt
+functions, respectively.
+Consult the POSIX specification for more information about these
+functions and in particular the various socket options
+(and the types they require).
+
+.coNP Function @ sock-set-opt
+.synb
+.mets (sock-set-opt < socket < level < option < value <> [ ffi-type ])
+.syne
+.desc
+The
+.code sock-set-opt
+function sets the value of the specified socket option,
+at the specified protocol level,
+associated with
+.codn socket ,
+which must be a socket stream.
+
+See the documentation of the
+.code sock-opt
+function for a description of the
+.metn level ,
+.meta option
+and
+.meta ffi-type
+arguments.
+Like the
+.code sock-opt
+function,
+.codn sock-set-opt 's
+.meta ffi-type
+argument defaults to
+.codn "(ffi int)" .
+
.coNP Functions @ str-inaddr and @ str-in6addr
.synb
.mets (str-inaddr address <> [ port ])