diff options
-rw-r--r-- | ffi.c | 94 | ||||
-rw-r--r-- | lisplib.c | 1 | ||||
-rw-r--r-- | stdlib/doc-syms.tl | 31 | ||||
-rw-r--r-- | stdlib/socket.tl | 7 | ||||
-rw-r--r-- | tests/014/socket-misc.tl | 12 | ||||
-rw-r--r-- | txr.1 | 189 |
6 files changed, 329 insertions, 5 deletions
@@ -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(); @@ -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))) @@ -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 ]) |