diff --git a/lib_eio/mock/sockopt.ml b/lib_eio/mock/sockopt.ml index ded2cab05..d6da41aa8 100644 --- a/lib_eio/mock/sockopt.ml +++ b/lib_eio/mock/sockopt.ml @@ -21,6 +21,7 @@ let default (type a) (opt : a Eio.Net.Sockopt.t) : a = | SO_LINGER -> None | SO_RCVTIMEO -> 0.0 | SO_SNDTIMEO -> 0.0 + | SO_TYPE -> `Stream | _ -> raise (Eio.Net.err Invalid_option) let getsockopt : type a. string -> a Eio.Net.Sockopt.t -> a = fun label opt -> diff --git a/lib_eio/net.ml b/lib_eio/net.ml index 534835f5b..dded34e31 100644 --- a/lib_eio/net.ml +++ b/lib_eio/net.ml @@ -214,6 +214,14 @@ module Sockaddr = struct Format.fprintf f "udp:%a:%d" Ipaddr.pp_for_uri addr port end +type socket_type = [ `Stream | `Dgram | `Raw | `Seqpacket ] + +let pp_socket_type f = function + | `Stream -> Fmt.string f "stream" + | `Dgram -> Fmt.string f "dgram" + | `Raw -> Fmt.string f "raw" + | `Seqpacket -> Fmt.string f "seqpacket" + module Sockopt = struct type _ t = .. @@ -264,6 +272,7 @@ module Sockopt = struct | SO_LINGER : int option t | SO_RCVTIMEO : float t | SO_SNDTIMEO : float t + | SO_TYPE : socket_type t type _ t += | TCP_CORK : bool t @@ -312,6 +321,7 @@ module Sockopt = struct | SO_LINGER -> Some ("SO_LINGER", Fmt.(option ~none:(any "") int)) | SO_RCVTIMEO -> Some ("SO_RCVTIMEO", Fmt.float) | SO_SNDTIMEO -> Some ("SO_SNDTIMEO", Fmt.float) + | SO_TYPE -> Some ("SO_TYPE", pp_socket_type) | TCP_CORK -> Some ("TCP_CORK", Fmt.bool) | TCP_KEEPIDLE -> Some ("TCP_KEEPIDLE", Fmt.int) | TCP_KEEPINTVL -> Some ("TCP_KEEPINTVL", Fmt.int) diff --git a/lib_eio/net.mli b/lib_eio/net.mli index 877d0f97d..9b4abaded 100644 --- a/lib_eio/net.mli +++ b/lib_eio/net.mli @@ -156,6 +156,12 @@ type 'a t = 'a r (** {2 Socket options} *) +type socket_type = [ `Stream | `Dgram | `Raw | `Seqpacket ] +(** The communication semantics of a socket. *) + +val pp_socket_type : socket_type Fmt.t +(** [pp_socket_type] formats a {!socket_type} for display. *) + module Sockopt : sig (** An extensible type for socket options. Portable options can be defined here, while platform-specific options can be added by backends. @@ -186,6 +192,7 @@ module Sockopt : sig | SO_LINGER : int option t (** Linger on close if data present *) | SO_RCVTIMEO : float t (** Receive timeout *) | SO_SNDTIMEO : float t (** Send timeout *) + | SO_TYPE : socket_type t (** Get the socket type (read-only) *) (** {2 Linux-specific options} *) diff --git a/lib_eio/unix/eio_unix_stubs.c b/lib_eio/unix/eio_unix_stubs.c index 2757aa0f2..4f70c1433 100644 --- a/lib_eio/unix/eio_unix_stubs.c +++ b/lib_eio/unix/eio_unix_stubs.c @@ -405,3 +405,30 @@ CAMLprim value caml_eio_sockopt_string_get(value v_fd, value v_id) { v_result = caml_alloc_initialized_string(slen, buffer); CAMLreturn(v_result); } + +CAMLprim value caml_eio_unix_so_type(value v_fd) { + CAMLparam1(v_fd); + int ty; + socklen_t optlen = sizeof(ty); + #ifdef _WIN32 + SOCKET sock = Socket_val(v_fd); + if (getsockopt(sock, SOL_SOCKET, SO_TYPE, (char *)&ty, &optlen) != 0) { + caml_win32_maperr(WSAGetLastError()); + caml_uerror("getsockopt", Nothing); + } + #else + int sock = Int_val(v_fd); + if (getsockopt(sock, SOL_SOCKET, SO_TYPE, &ty, &optlen) != 0) + caml_uerror("getsockopt", Nothing); + #endif + switch (ty) { + case SOCK_STREAM: CAMLreturn(caml_hash_variant("Stream")); + case SOCK_DGRAM: CAMLreturn(caml_hash_variant("Dgram")); + case SOCK_RAW: CAMLreturn(caml_hash_variant("Raw")); + #ifdef SOCK_SEQPACKET + case SOCK_SEQPACKET: CAMLreturn(caml_hash_variant("Seqpacket")); + #endif + default: caml_invalid_argument("Eio_unix: unrecognised SO_TYPE"); + } + CAMLreturn(Val_unit); /* unreachable */ +} diff --git a/lib_eio/unix/primitives.h b/lib_eio/unix/primitives.h index a5cbe8491..0bf76895d 100644 --- a/lib_eio/unix/primitives.h +++ b/lib_eio/unix/primitives.h @@ -25,4 +25,5 @@ CAMLprim value caml_eio_sockopt_int_set(value, value, value); CAMLprim value caml_eio_sockopt_int_get(value, value); CAMLprim value caml_eio_sockopt_string_set(value, value, value); CAMLprim value caml_eio_sockopt_string_get(value, value); +CAMLprim value caml_eio_unix_so_type(value); CAMLprim value eio_unix_is_blocking(value); diff --git a/lib_eio/unix/private.ml b/lib_eio/unix/private.ml index 1cba7452a..8195269de 100644 --- a/lib_eio/unix/private.ml +++ b/lib_eio/unix/private.ml @@ -94,6 +94,7 @@ external setsockopt_int : Unix.file_descr -> Sockopt.t -> int -> unit = "caml_ei external getsockopt_int : Unix.file_descr -> Sockopt.t -> int = "caml_eio_sockopt_int_get" external setsockopt_string : Unix.file_descr -> Sockopt.t -> string -> unit = "caml_eio_sockopt_string_set" external getsockopt_string : Unix.file_descr -> Sockopt.t -> string = "caml_eio_sockopt_string_get" +external so_type : Unix.file_descr -> Eio.Net.socket_type = "caml_eio_unix_so_type" let err_run_sock fn x = try fn x @@ -207,6 +208,7 @@ let setsockopt : type a. Fd.t -> a Eio.Net.Sockopt.t -> a -> unit = fun fd opt v | Eio.Net.Sockopt.SO_LINGER -> Unix.setsockopt_optint fd Unix.SO_LINGER v | Eio.Net.Sockopt.SO_RCVTIMEO -> Unix.setsockopt_float fd Unix.SO_RCVTIMEO v | Eio.Net.Sockopt.SO_SNDTIMEO -> Unix.setsockopt_float fd Unix.SO_SNDTIMEO v + | Eio.Net.Sockopt.SO_TYPE -> invalid_arg "SO_TYPE is a read-only socket option" | Net.Sockopt_bool bo -> Unix.setsockopt fd bo v | Net.Sockopt_int bo -> Unix.setsockopt_int fd bo v | Net.Sockopt_optint bo -> Unix.setsockopt_optint fd bo v @@ -286,6 +288,7 @@ let getsockopt : type a. Fd.t -> a Eio.Net.Sockopt.t -> a = fun fd opt -> | Eio.Net.Sockopt.SO_LINGER -> Unix.getsockopt_optint fd Unix.SO_LINGER | Eio.Net.Sockopt.SO_RCVTIMEO -> Unix.getsockopt_float fd Unix.SO_RCVTIMEO | Eio.Net.Sockopt.SO_SNDTIMEO -> Unix.getsockopt_float fd Unix.SO_SNDTIMEO + | Eio.Net.Sockopt.SO_TYPE -> so_type fd | Net.Sockopt_bool bo -> Unix.getsockopt fd bo | Net.Sockopt_int bo -> Unix.getsockopt_int fd bo | Net.Sockopt_optint bo -> Unix.getsockopt_optint fd bo diff --git a/tests/network.md b/tests/network.md index df96d5da6..4ee2c84ca 100644 --- a/tests/network.md +++ b/tests/network.md @@ -579,6 +579,7 @@ Test portable socket options on a TCP socket: # run @@ fun ~net sw -> let server = Eio.Net.listen net ~sw ~reuse_addr:true ~backlog:5 addr in let client = Eio.Net.connect ~sw net (Eio.Net.listening_addr server) in + try_getsockopt client Eio.Net.Sockopt.SO_TYPE; Eio.Net.setsockopt client Eio.Net.Sockopt.TCP_NODELAY true; assert (Eio.Net.getsockopt client Eio.Net.Sockopt.TCP_NODELAY); Eio.Net.setsockopt client Eio.Net.Sockopt.SO_KEEPALIVE true; @@ -592,6 +593,7 @@ Test portable socket options on a TCP socket: Eio.Net.setsockopt client Eio.Net.Sockopt.SO_RCVTIMEO 5.0; let timeout = Eio.Net.getsockopt client Eio.Net.Sockopt.SO_RCVTIMEO in traceln "SO_RCVTIMEO: %.1f seconds" timeout;; ++SO_TYPE = stream +SO_SNDBUF: positive +SO_LINGER = 10 +SO_RCVTIMEO: 5.0 seconds @@ -614,8 +616,10 @@ Test socket options on datagram socket: ```ocaml # run @@ fun ~net sw -> let udp = Eio.Net.datagram_socket net ~sw `UdpV4 in + try_getsockopt udp Eio.Net.Sockopt.SO_TYPE; Eio.Net.setsockopt udp Eio.Net.Sockopt.SO_BROADCAST true; try_getsockopt udp Eio.Net.Sockopt.SO_BROADCAST;; ++SO_TYPE = dgram +SO_BROADCAST = true - : unit = () ```