From 5c5598a1ffca2c93594bbd6b9848ed94c314a309 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Sat, 27 Sep 2025 17:48:27 +0000 Subject: [PATCH 1/4] Add support for setting/getting socket options This adds a Eio.Net.Sockopt.t extensible variant where portable options are exposed, and backend-specific sockopts for Unix and Linux. Windows can be added later, but is not part of this commit. Reviewed-by: Thomas Leonard --- lib_eio/mock/flow.ml | 3 + lib_eio/mock/net.ml | 3 + lib_eio/mock/sockopt.ml | 47 +++++++ lib_eio/mock/sockopt.mli | 21 +++ lib_eio/net.ml | 47 ++++++- lib_eio/net.mli | 49 ++++++- lib_eio/unix/net.ml | 62 +++++++++ lib_eio/unix/net.mli | 41 ++++++ lib_eio_linux/eio_linux.ml | 6 + lib_eio_linux/eio_stubs.c | 45 +++++++ lib_eio_linux/flow.ml | 3 + lib_eio_linux/low_level.ml | 228 +++++++++++++++++++++++++++++++++ lib_eio_linux/low_level.mli | 73 +++++++++++ lib_eio_linux/tests/network.md | Bin 0 -> 11041 bytes lib_eio_posix/flow.ml | 3 + lib_eio_posix/net.ml | 6 + lib_eio_windows/flow.ml | 3 + lib_eio_windows/net.ml | 6 + tests/network.md | 92 ++++++++++++- 19 files changed, 735 insertions(+), 3 deletions(-) create mode 100644 lib_eio/mock/sockopt.ml create mode 100644 lib_eio/mock/sockopt.mli create mode 100644 lib_eio_linux/tests/network.md diff --git a/lib_eio/mock/flow.ml b/lib_eio/mock/flow.ml index 7ca0bd89f..8254eaccf 100644 --- a/lib_eio/mock/flow.ml +++ b/lib_eio/mock/flow.ml @@ -108,6 +108,9 @@ module Mock_flow = struct done; traceln "%s: closed" t.label + let setsockopt t opt v = Sockopt.setsockopt t.label opt v + let getsockopt t opt = Sockopt.getsockopt t.label opt + let make ?(pp=pp_default) label = { pp; diff --git a/lib_eio/mock/net.ml b/lib_eio/mock/net.ml index 933791ef2..2932c57f6 100644 --- a/lib_eio/mock/net.ml +++ b/lib_eio/mock/net.ml @@ -123,6 +123,9 @@ module Listening_socket = struct let listening_addr { listening_addr; _ } = listening_addr + let setsockopt t opt v = Sockopt.setsockopt t.label opt v + let getsockopt t opt = Sockopt.getsockopt t.label opt + type (_, _, _) Eio.Resource.pi += Type : ('t, 't -> t, listening_socket_ty) Eio.Resource.pi let raw (Eio.Resource.T (t, ops)) = Eio.Resource.get ops Type t end diff --git a/lib_eio/mock/sockopt.ml b/lib_eio/mock/sockopt.ml new file mode 100644 index 000000000..86777af5c --- /dev/null +++ b/lib_eio/mock/sockopt.ml @@ -0,0 +1,47 @@ +open Eio.Std + +let pp_sockopt_value : type a. a Eio.Net.Sockopt.t -> a -> string = fun opt v -> + match opt with + | Eio.Net.Sockopt.SO_DEBUG -> Fmt.str "SO_DEBUG = %b" v + | Eio.Net.Sockopt.SO_BROADCAST -> Fmt.str "SO_BROADCAST = %b" v + | Eio.Net.Sockopt.SO_REUSEADDR -> Fmt.str "SO_REUSEADDR = %b" v + | Eio.Net.Sockopt.SO_KEEPALIVE -> Fmt.str "SO_KEEPALIVE = %b" v + | Eio.Net.Sockopt.SO_DONTROUTE -> Fmt.str "SO_DONTROUTE = %b" v + | Eio.Net.Sockopt.SO_OOBINLINE -> Fmt.str "SO_OOBINLINE = %b" v + | Eio.Net.Sockopt.TCP_NODELAY -> Fmt.str "TCP_NODELAY = %b" v + | Eio.Net.Sockopt.IPV6_ONLY -> Fmt.str "IPV6_ONLY = %b" v + | Eio.Net.Sockopt.SO_REUSEPORT -> Fmt.str "SO_REUSEPORT = %b" v + | Eio.Net.Sockopt.SO_SNDBUF -> Fmt.str "SO_SNDBUF = %d" v + | Eio.Net.Sockopt.SO_RCVBUF -> Fmt.str "SO_RCVBUF = %d" v + | Eio.Net.Sockopt.SO_TYPE -> Fmt.str "SO_TYPE = %d" v + | Eio.Net.Sockopt.SO_RCVLOWAT -> Fmt.str "SO_RCVLOWAT = %d" v + | Eio.Net.Sockopt.SO_SNDLOWAT -> Fmt.str "SO_SNDLOWAT = %d" v + | Eio.Net.Sockopt.SO_LINGER -> Fmt.str "SO_LINGER = %s" (match v with None -> "None" | Some n -> string_of_int n) + | Eio.Net.Sockopt.SO_RCVTIMEO -> Fmt.str "SO_RCVTIMEO = %f" v + | Eio.Net.Sockopt.SO_SNDTIMEO -> Fmt.str "SO_SNDTIMEO = %f" v + | _ -> "unknown" + +let setsockopt : type a. string -> a Eio.Net.Sockopt.t -> a -> unit = fun label opt v -> + let opt_desc = pp_sockopt_value opt v in + traceln "%s: setsockopt %s" label opt_desc + +let getsockopt : type a. string -> a Eio.Net.Sockopt.t -> a = fun label opt -> + match opt with + | Eio.Net.Sockopt.SO_DEBUG -> traceln "%s: getsockopt SO_DEBUG = false" label; false + | Eio.Net.Sockopt.SO_BROADCAST -> traceln "%s: getsockopt SO_BROADCAST = false" label; false + | Eio.Net.Sockopt.SO_REUSEADDR -> traceln "%s: getsockopt SO_REUSEADDR = false" label; false + | Eio.Net.Sockopt.SO_KEEPALIVE -> traceln "%s: getsockopt SO_KEEPALIVE = false" label; false + | Eio.Net.Sockopt.SO_DONTROUTE -> traceln "%s: getsockopt SO_DONTROUTE = false" label; false + | Eio.Net.Sockopt.SO_OOBINLINE -> traceln "%s: getsockopt SO_OOBINLINE = false" label; false + | Eio.Net.Sockopt.TCP_NODELAY -> traceln "%s: getsockopt TCP_NODELAY = false" label; false + | Eio.Net.Sockopt.IPV6_ONLY -> traceln "%s: getsockopt IPV6_ONLY = false" label; false + | Eio.Net.Sockopt.SO_REUSEPORT -> traceln "%s: getsockopt SO_REUSEPORT = false" label; false + | Eio.Net.Sockopt.SO_SNDBUF -> traceln "%s: getsockopt SO_SNDBUF = 0" label; 0 + | Eio.Net.Sockopt.SO_RCVBUF -> traceln "%s: getsockopt SO_RCVBUF = 0" label; 0 + | Eio.Net.Sockopt.SO_TYPE -> traceln "%s: getsockopt SO_TYPE = 0" label; 0 + | Eio.Net.Sockopt.SO_RCVLOWAT -> traceln "%s: getsockopt SO_RCVLOWAT = 0" label; 0 + | Eio.Net.Sockopt.SO_SNDLOWAT -> traceln "%s: getsockopt SO_SNDLOWAT = 0" label; 0 + | Eio.Net.Sockopt.SO_LINGER -> traceln "%s: getsockopt SO_LINGER = None" label; None + | Eio.Net.Sockopt.SO_RCVTIMEO -> traceln "%s: getsockopt SO_RCVTIMEO = 0.0" label; 0.0 + | Eio.Net.Sockopt.SO_SNDTIMEO -> traceln "%s: getsockopt SO_SNDTIMEO = 0.0" label; 0.0 + | _ -> raise (Failure "Mock getsockopt not implemented") \ No newline at end of file diff --git a/lib_eio/mock/sockopt.mli b/lib_eio/mock/sockopt.mli new file mode 100644 index 000000000..b52d9fbac --- /dev/null +++ b/lib_eio/mock/sockopt.mli @@ -0,0 +1,21 @@ +(** Mock socket option helpers *) + +val pp_sockopt_value : 'a Eio.Net.Sockopt.t -> 'a -> string +(** [pp_sockopt_value opt v] formats socket option [opt] with value [v] as a string + for trace output. Returns [unknown] for unrecognised options. *) + +val setsockopt : string -> 'a Eio.Net.Sockopt.t -> 'a -> unit +(** [setsockopt label opt v] simulates setting socket option [opt] to value [v]. + Outputs a trace message using [label] to identify the socket. *) + +val getsockopt : string -> 'a Eio.Net.Sockopt.t -> 'a +(** [getsockopt label opt] simulates getting the value of socket option [opt]. + Outputs a trace message using [label] to identify the socket. + Returns default mock values for all standard options. + + Default values: + - Boolean options: [false] + - Integer options: [0] + - Timeout options: [0.0] + + @raise Failure if the option is not recognized. *) diff --git a/lib_eio/net.ml b/lib_eio/net.ml index 3dffe2c4a..a23e611b6 100644 --- a/lib_eio/net.ml +++ b/lib_eio/net.ml @@ -159,6 +159,29 @@ module Sockaddr = struct Format.fprintf f "udp:%a:%d" Ipaddr.pp_for_uri addr port end +module Sockopt = struct + type _ t = .. + + type _ t += + | SO_DEBUG : bool t + | SO_BROADCAST : bool t + | SO_REUSEADDR : bool t + | SO_KEEPALIVE : bool t + | SO_DONTROUTE : bool t + | SO_OOBINLINE : bool t + | TCP_NODELAY : bool t + | IPV6_ONLY : bool t + | SO_REUSEPORT : bool t + | SO_SNDBUF : int t + | SO_RCVBUF : int t + | SO_TYPE : int t + | SO_RCVLOWAT : int t + | SO_SNDLOWAT : int t + | SO_LINGER : int option t + | SO_RCVTIMEO : float t + | SO_SNDTIMEO : float t +end + type socket_ty = [`Socket | `Close] type 'a socket = ([> socket_ty] as 'a) r @@ -181,22 +204,34 @@ type 'a t = 'a r constraint 'a = [> [> `Generic] ty] module Pi = struct + module type SOCKET = sig + type t + val setsockopt : t -> 'a Sockopt.t -> 'a -> unit + val getsockopt : t -> 'a Sockopt.t -> 'a + end + + type (_, _, _) Resource.pi += + | Socket : ('t, (module SOCKET with type t = 't), [> `Socket]) Resource.pi + module type STREAM_SOCKET = sig type tag include Flow.Pi.SHUTDOWN include Flow.Pi.SOURCE with type t := t include Flow.Pi.SINK with type t := t + include SOCKET with type t := t val close : t -> unit end let stream_socket (type t tag) (module X : STREAM_SOCKET with type t = t and type tag = tag) = Resource.handler @@ H (Resource.Close, X.close) :: + H (Socket, (module X)) :: Resource.bindings (Flow.Pi.two_way (module X)) module type DATAGRAM_SOCKET = sig type tag include Flow.Pi.SHUTDOWN + include SOCKET with type t := t val send : t -> ?dst:Sockaddr.datagram -> Cstruct.t list -> unit val recv : t -> Cstruct.t -> Sockaddr.datagram * int val close : t -> unit @@ -208,6 +243,7 @@ module Pi = struct let datagram_socket (type t tag) (module X : DATAGRAM_SOCKET with type t = t and type tag = tag) = Resource.handler @@ Resource.bindings (Flow.Pi.shutdown (module X)) @ [ + H (Socket, (module X)); H (Datagram_socket, (module X)); H (Resource.Close, X.close) ] @@ -215,7 +251,7 @@ module Pi = struct module type LISTENING_SOCKET = sig type t type tag - + include SOCKET with type t := t val accept : t -> sw:Switch.t -> tag stream_socket_ty r * Sockaddr.stream val close : t -> unit val listening_addr : t -> Sockaddr.stream @@ -227,6 +263,7 @@ module Pi = struct let listening_socket (type t tag) (module X : LISTENING_SOCKET with type t = t and type tag = tag) = Resource.handler [ H (Resource.Close, X.close); + H (Socket, (module X)); H (Listening_socket, (module X)) ] @@ -278,6 +315,14 @@ let accept_fork ~sw (t : [> 'a listening_socket_ty] r) ~on_error handle = ) ) +let setsockopt (Resource.T (t, ops)) opt v = + let module X = (val (Resource.get ops Pi.Socket)) in + X.setsockopt t opt v + +let getsockopt (Resource.T (t, ops)) opt = + let module X = (val (Resource.get ops Pi.Socket)) in + X.getsockopt t opt + let listening_addr (type tag) (Resource.T (t, ops) : [> tag listening_socket_ty] r) = let module X = (val (Resource.get ops Pi.Listening_socket)) in X.listening_addr t diff --git a/lib_eio/net.mli b/lib_eio/net.mli index f677707b5..80d157c99 100644 --- a/lib_eio/net.mli +++ b/lib_eio/net.mli @@ -102,6 +102,33 @@ module Sockaddr : sig val pp : Format.formatter -> [< t] -> unit end +(** Socket options. *) +module Sockopt : sig + (** An extensible type for socket options. Portable options can be defined + here, while platform-specific options can be added by backends. *) + + type _ t = .. + + type _ t += + | SO_DEBUG : bool t (** Enable socket debugging *) + | SO_BROADCAST : bool t (** Permit sending of broadcast messages *) + | SO_REUSEADDR : bool t (** Allow reuse of local addresses *) + | SO_KEEPALIVE : bool t (** Keep TCP connection alive *) + | SO_DONTROUTE : bool t (** Bypass routing tables *) + | SO_OOBINLINE : bool t (** Leave out-of-band data in line *) + | TCP_NODELAY : bool t (** Disable Nagle's algorithm *) + | IPV6_ONLY : bool t (** Restrict to IPv6 only *) + | SO_REUSEPORT : bool t (** Allow reuse of local port *) + | SO_SNDBUF : int t (** Send buffer size *) + | SO_RCVBUF : int t (** Receive buffer size *) + | SO_TYPE : int t (** Socket type (get only) *) + | SO_RCVLOWAT : int t (** Receive low water mark *) + | SO_SNDLOWAT : int t (** Send low water mark *) + | SO_LINGER : int option t (** Linger on close if data present *) + | SO_RCVTIMEO : float t (** Receive timeout *) + | SO_SNDTIMEO : float t (** Send timeout *) +end + (** {2 Types} *) type socket_ty = [`Socket | `Close] @@ -127,6 +154,18 @@ type 'tag ty = [`Network | `Platform of 'tag] type 'a t = 'a r constraint 'a = [> [> `Generic] ty] +(** {2 Socket options} *) + +val setsockopt : [> `Socket] r -> 'a Sockopt.t -> 'a -> unit +(** [setsockopt s opt v] sets socket option [opt] to value [v] on socket [s]. + + @raise Invalid_argument if the socket option is not supported by the backend. *) + +val getsockopt : [> `Socket] r -> 'a Sockopt.t -> 'a +(** [getsockopt s opt] gets the value of socket option [opt] on socket [s]. + + @raise Invalid_argument if the socket option is not supported by the backend. *) + (** {2 Out-bound Connections} *) val connect : sw:Switch.t -> [> 'tag ty] t -> Sockaddr.stream -> 'tag stream_socket_ty r @@ -304,11 +343,18 @@ val close : [> `Close] r -> unit (** {2 Provider Interface} *) module Pi : sig + module type SOCKET = sig + type t + val setsockopt : t -> 'a Sockopt.t -> 'a -> unit + val getsockopt : t -> 'a Sockopt.t -> 'a + end + module type STREAM_SOCKET = sig type tag include Flow.Pi.SHUTDOWN include Flow.Pi.SOURCE with type t := t include Flow.Pi.SINK with type t := t + include SOCKET with type t := t val close : t -> unit end @@ -319,6 +365,7 @@ module Pi : sig module type DATAGRAM_SOCKET = sig type tag include Flow.Pi.SHUTDOWN + include SOCKET with type t := t val send : t -> ?dst:Sockaddr.datagram -> Cstruct.t list -> unit val recv : t -> Cstruct.t -> Sockaddr.datagram * int val close : t -> unit @@ -331,7 +378,7 @@ module Pi : sig module type LISTENING_SOCKET = sig type t type tag - + include SOCKET with type t := t val accept : t -> sw:Switch.t -> tag stream_socket_ty r * Sockaddr.stream val close : t -> unit val listening_addr : t -> Sockaddr.stream diff --git a/lib_eio/unix/net.ml b/lib_eio/unix/net.ml index 11f4a173a..4071599cc 100644 --- a/lib_eio/unix/net.ml +++ b/lib_eio/unix/net.ml @@ -91,3 +91,65 @@ let socketpair_datagram ~sw ?(domain=Unix.PF_UNIX) ?(protocol=0) () = let fd socket = Option.get (Resource.fd_opt socket) + +module Sockopt = struct + type _ Eio.Net.Sockopt.t += + | Unix_bool : Unix.socket_bool_option -> bool Eio.Net.Sockopt.t + | Unix_int : Unix.socket_int_option -> int Eio.Net.Sockopt.t + | Unix_optint : Unix.socket_optint_option -> int option Eio.Net.Sockopt.t + | Unix_float : Unix.socket_float_option -> float Eio.Net.Sockopt.t + + let set : type a. Fd.t -> a Eio.Net.Sockopt.t -> a -> unit = fun fd opt v -> + Fd.use_exn "setsockopt" fd @@ fun fd -> + match opt with + | Eio.Net.Sockopt.SO_DEBUG -> Unix.setsockopt fd Unix.SO_DEBUG v + | Eio.Net.Sockopt.SO_BROADCAST -> Unix.setsockopt fd Unix.SO_BROADCAST v + | Eio.Net.Sockopt.SO_REUSEADDR -> Unix.setsockopt fd Unix.SO_REUSEADDR v + | Eio.Net.Sockopt.SO_KEEPALIVE -> Unix.setsockopt fd Unix.SO_KEEPALIVE v + | Eio.Net.Sockopt.SO_DONTROUTE -> Unix.setsockopt fd Unix.SO_DONTROUTE v + | Eio.Net.Sockopt.SO_OOBINLINE -> Unix.setsockopt fd Unix.SO_OOBINLINE v + | Eio.Net.Sockopt.TCP_NODELAY -> Unix.setsockopt fd Unix.TCP_NODELAY v + | Eio.Net.Sockopt.IPV6_ONLY -> Unix.setsockopt fd Unix.IPV6_ONLY v + | Eio.Net.Sockopt.SO_REUSEPORT -> Unix.setsockopt fd Unix.SO_REUSEPORT v + | Eio.Net.Sockopt.SO_SNDBUF -> Unix.setsockopt_int fd Unix.SO_SNDBUF v + | Eio.Net.Sockopt.SO_RCVBUF -> Unix.setsockopt_int fd Unix.SO_RCVBUF v + | Eio.Net.Sockopt.SO_TYPE -> invalid_arg "SO_TYPE is read-only" + | Eio.Net.Sockopt.SO_RCVLOWAT -> Unix.setsockopt_int fd Unix.SO_RCVLOWAT v + | Eio.Net.Sockopt.SO_SNDLOWAT -> Unix.setsockopt_int fd Unix.SO_SNDLOWAT 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 + | Unix_bool bo -> Unix.setsockopt fd bo v + | Unix_int bo -> Unix.setsockopt_int fd bo v + | Unix_optint bo -> Unix.setsockopt_optint fd bo v + | Unix_float bo -> Unix.setsockopt_float fd bo v + | _ -> raise (Invalid_argument "Unsupported socket option") + + let get_descr : type a. Unix.file_descr -> a Eio.Net.Sockopt.t -> a = fun fd opt -> + match opt with + | Eio.Net.Sockopt.SO_DEBUG -> Unix.getsockopt fd Unix.SO_DEBUG + | Eio.Net.Sockopt.SO_BROADCAST -> Unix.getsockopt fd Unix.SO_BROADCAST + | Eio.Net.Sockopt.SO_REUSEADDR -> Unix.getsockopt fd Unix.SO_REUSEADDR + | Eio.Net.Sockopt.SO_KEEPALIVE -> Unix.getsockopt fd Unix.SO_KEEPALIVE + | Eio.Net.Sockopt.SO_DONTROUTE -> Unix.getsockopt fd Unix.SO_DONTROUTE + | Eio.Net.Sockopt.SO_OOBINLINE -> Unix.getsockopt fd Unix.SO_OOBINLINE + | Eio.Net.Sockopt.TCP_NODELAY -> Unix.getsockopt fd Unix.TCP_NODELAY + | Eio.Net.Sockopt.IPV6_ONLY -> Unix.getsockopt fd Unix.IPV6_ONLY + | Eio.Net.Sockopt.SO_REUSEPORT -> Unix.getsockopt fd Unix.SO_REUSEPORT + | Eio.Net.Sockopt.SO_SNDBUF -> Unix.getsockopt_int fd Unix.SO_SNDBUF + | Eio.Net.Sockopt.SO_RCVBUF -> Unix.getsockopt_int fd Unix.SO_RCVBUF + | Eio.Net.Sockopt.SO_TYPE -> Unix.getsockopt_int fd Unix.SO_TYPE + | Eio.Net.Sockopt.SO_RCVLOWAT -> Unix.getsockopt_int fd Unix.SO_RCVLOWAT + | Eio.Net.Sockopt.SO_SNDLOWAT -> Unix.getsockopt_int fd Unix.SO_SNDLOWAT + | 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 + | Unix_bool bo -> Unix.getsockopt fd bo + | Unix_int bo -> Unix.getsockopt_int fd bo + | Unix_optint bo -> Unix.getsockopt_optint fd bo + | Unix_float bo -> Unix.getsockopt_float fd bo + | _ -> raise (Invalid_argument "Unsupported socket option") + + let get : type a. Fd.t -> a Eio.Net.Sockopt.t -> a = fun fd opt -> + Fd.use_exn "getsockopt" fd @@ fun fd -> get_descr fd opt +end diff --git a/lib_eio/unix/net.mli b/lib_eio/unix/net.mli index 7da1a54bd..8863df2d2 100644 --- a/lib_eio/unix/net.mli +++ b/lib_eio/unix/net.mli @@ -99,6 +99,47 @@ val socketpair_datagram : This creates OS-level resources using [socketpair(2)]. Note that, like all FDs created by Eio, they are both marked as close-on-exec by default. *) +(** Socket options *) +module Sockopt : sig + (** Unix-specific socket options. + + This module extends {!Eio.Net.Sockopt} with support for any Unix socket option. *) + + (** Generic wrappers for Unix socket options *) + type _ Eio.Net.Sockopt.t += + | Unix_bool : Unix.socket_bool_option -> bool Eio.Net.Sockopt.t + (** Wrap any Unix boolean socket option *) + | Unix_int : Unix.socket_int_option -> int Eio.Net.Sockopt.t + (** Wrap any Unix integer socket option *) + | Unix_optint : Unix.socket_optint_option -> int option Eio.Net.Sockopt.t + (** Wrap any Unix optional integer socket option *) + | Unix_float : Unix.socket_float_option -> float Eio.Net.Sockopt.t + (** Wrap any Unix float socket option *) + + val set : Fd.t -> 'a Eio.Net.Sockopt.t -> 'a -> unit + (** [set fd opt v] sets socket option [opt] to value [v] on file descriptor [fd]. + + Supports both portable options from {!Eio.Net.Sockopt} and Unix-specific options + wrapped with [Unix_bool], [Unix_int], [Unix_optint], or [Unix_float]. + + Example: + {[ + (* Using portable options *) + Eio.Net.setsockopt sock Eio.Net.Sockopt.SO_KEEPALIVE true; + + (* Using Unix-specific options *) + let fd = Eio_unix.Net.fd sock in + Eio_unix.Net.Sockopt.set fd (Unix_int Unix.SO_SNDBUF) 65536; + Eio_unix.Net.Sockopt.set fd (Unix_optint Unix.SO_LINGER) (Some 10); + ]} *) + + val get : Fd.t -> 'a Eio.Net.Sockopt.t -> 'a + (** [get fd opt] gets the value of socket option [opt] on file descriptor [fd]. + + Supports both portable options from {!Eio.Net.Sockopt} and Unix-specific options + wrapped with [Unix_bool], [Unix_int], [Unix_optint], or [Unix_float]. *) +end + (** {2 Private API for backends} *) val getnameinfo : Eio.Net.Sockaddr.t -> (string * string) diff --git a/lib_eio_linux/eio_linux.ml b/lib_eio_linux/eio_linux.ml index 79678c99e..73c9d613e 100644 --- a/lib_eio_linux/eio_linux.ml +++ b/lib_eio_linux/eio_linux.ml @@ -62,6 +62,9 @@ module Datagram_socket = struct | `Receive -> Unix.SHUTDOWN_RECEIVE | `Send -> Unix.SHUTDOWN_SEND | `All -> Unix.SHUTDOWN_ALL + + let setsockopt t opt v = Low_level.Sockopt.set t opt v + let getsockopt t opt = Low_level.Sockopt.get t opt end let datagram_handler = Eio_unix.Pi.datagram_handler (module Datagram_socket) @@ -91,6 +94,9 @@ module Listening_socket = struct let listening_addr fd = Eio_unix.Fd.use_exn "listening_addr" fd (fun fd -> Eio_unix.Net.sockaddr_of_unix_stream (Unix.getsockname fd)) + + let setsockopt t opt v = Low_level.Sockopt.set t opt v + let getsockopt t opt = Low_level.Sockopt.get t opt end let listening_handler = Eio_unix.Pi.listening_socket_handler (module Listening_socket) diff --git a/lib_eio_linux/eio_stubs.c b/lib_eio_linux/eio_stubs.c index 4e4054104..7299e5150 100644 --- a/lib_eio_linux/eio_stubs.c +++ b/lib_eio_linux/eio_stubs.c @@ -15,6 +15,9 @@ #include #include #include +#include +#include +#include // We need caml_convert_signal_number #define CAML_INTERNALS @@ -236,3 +239,45 @@ CAMLprim value caml_eio_clone3(value v_errors, value v_actions) { CAMLreturn(v_result); } + +/* Socket option stubs for Linux-specific TCP options */ +CAMLprim value caml_eio_sockopt_int_set(value v_fd, value v_level, value v_option, value v_val) { + CAMLparam4(v_fd, v_level, v_option, v_val); + int ret; + int val = Int_val(v_val); + ret = setsockopt(Int_val(v_fd), Int_val(v_level), Int_val(v_option), &val, sizeof(val)); + if (ret == -1) uerror("setsockopt", Nothing); + CAMLreturn(Val_unit); +} + +CAMLprim value caml_eio_sockopt_int_get(value v_fd, value v_level, value v_option) { + CAMLparam3(v_fd, v_level, v_option); + int ret; + int val; + socklen_t len = sizeof(val); + ret = getsockopt(Int_val(v_fd), Int_val(v_level), Int_val(v_option), &val, &len); + if (ret == -1) uerror("getsockopt", Nothing); + CAMLreturn(Val_int(val)); +} + +/* Socket option stubs for string options (e.g. TCP_CONGESTION) */ +CAMLprim value caml_eio_sockopt_string_set(value v_fd, value v_level, value v_option, value v_val) { + CAMLparam4(v_fd, v_level, v_option, v_val); + const char *str = String_val(v_val); + int ret = setsockopt(Int_val(v_fd), Int_val(v_level), Int_val(v_option), + str, caml_string_length(v_val)); + if (ret == -1) uerror("setsockopt", Nothing); + CAMLreturn(Val_unit); +} + +CAMLprim value caml_eio_sockopt_string_get(value v_fd, value v_level, value v_option) { + CAMLparam3(v_fd, v_level, v_option); + CAMLlocal1(v_result); + char buffer[256]; + socklen_t len = sizeof(buffer); + int ret = getsockopt(Int_val(v_fd), Int_val(v_level), Int_val(v_option), + buffer, &len); + if (ret == -1) uerror("getsockopt", Nothing); + v_result = caml_alloc_initialized_string(len, buffer); + CAMLreturn(v_result); +} diff --git a/lib_eio_linux/flow.ml b/lib_eio_linux/flow.ml index a280527ef..b15ce6b8e 100644 --- a/lib_eio_linux/flow.ml +++ b/lib_eio_linux/flow.ml @@ -130,6 +130,9 @@ module Impl = struct let seek = Low_level.lseek let sync = Low_level.fsync let truncate = Low_level.ftruncate + + let setsockopt t opt v = Low_level.Sockopt.set t opt v + let getsockopt t opt = Low_level.Sockopt.get t opt end let flow_handler = Eio_unix.Pi.flow_handler (module Impl) diff --git a/lib_eio_linux/low_level.ml b/lib_eio_linux/low_level.ml index 42e72bfa3..8ec0dcf93 100644 --- a/lib_eio_linux/low_level.ml +++ b/lib_eio_linux/low_level.ml @@ -627,3 +627,231 @@ module Process = struct | "" -> t (* Success! Execing the child closed [errors_w] and we got EOF. *) | err -> failwith err end + +module Sockopt = struct + let tcp_maxseg = 2 (* TCP_MAXSEG from netinet/tcp.h *) + let tcp_cork = 3 (* TCP_CORK from netinet/tcp.h *) + let tcp_keepidle = 4 (* TCP_KEEPIDLE *) + let tcp_keepintvl = 5 (* TCP_KEEPINTVL *) + let tcp_keepcnt = 6 (* TCP_KEEPCNT *) + let tcp_syncnt = 7 (* TCP_SYNCNT *) + let tcp_linger2 = 8 (* TCP_LINGER2 *) + let tcp_defer_accept = 9 (* TCP_DEFER_ACCEPT *) + let tcp_window_clamp = 10 (* TCP_WINDOW_CLAMP *) + let tcp_quickack = 12 (* TCP_QUICKACK *) + let tcp_congestion = 13 (* TCP_CONGESTION *) + let tcp_user_timeout = 18 (* TCP_USER_TIMEOUT *) + let tcp_fastopen = 23 (* TCP_FASTOPEN *) + let ipproto_tcp = 6 (* IPPROTO_TCP *) + let ipproto_ip = 0 (* IPPROTO_IP *) + let ip_freebind = 15 (* IP_FREEBIND *) + let ip_bind_address_no_port = 24 (* IP_BIND_ADDRESS_NO_PORT *) + let ip_local_port_range = 51 (* IP_LOCAL_PORT_RANGE *) + let ip_ttl = 2 (* IP_TTL *) + let ip_mtu = 14 (* IP_MTU *) + let ip_mtu_discover = 10 (* IP_MTU_DISCOVER *) + (* IP_MTU_DISCOVER values *) + let ip_pmtudisc_want = 1 (* IP_PMTUDISC_WANT *) + let ip_pmtudisc_dont = 0 (* IP_PMTUDISC_DONT *) + let ip_pmtudisc_do = 2 (* IP_PMTUDISC_DO *) + let ip_pmtudisc_probe = 3 (* IP_PMTUDISC_PROBE *) + + external setsockopt_int : Unix.file_descr -> int -> int -> int -> unit = "caml_eio_sockopt_int_set" + external getsockopt_int : Unix.file_descr -> int -> int -> int = "caml_eio_sockopt_int_get" + external setsockopt_string : Unix.file_descr -> int -> int -> string -> unit = "caml_eio_sockopt_string_set" + external getsockopt_string : Unix.file_descr -> int -> int -> string = "caml_eio_sockopt_string_get" + + (* Define Linux-specific socket options as extensions of Eio.Net.Sockopt.t *) + type _ Eio.Net.Sockopt.t += + | TCP_CORK : bool Eio.Net.Sockopt.t + | TCP_KEEPIDLE : int Eio.Net.Sockopt.t + | TCP_KEEPINTVL : int Eio.Net.Sockopt.t + | TCP_KEEPCNT : int Eio.Net.Sockopt.t + | TCP_USER_TIMEOUT : int Eio.Net.Sockopt.t + | TCP_MAXSEG : int Eio.Net.Sockopt.t + | TCP_LINGER2 : int option Eio.Net.Sockopt.t + | TCP_DEFER_ACCEPT : int Eio.Net.Sockopt.t + | TCP_CONGESTION : string Eio.Net.Sockopt.t + | TCP_SYNCNT : int Eio.Net.Sockopt.t + | TCP_WINDOW_CLAMP : int Eio.Net.Sockopt.t + | TCP_QUICKACK : bool Eio.Net.Sockopt.t + | TCP_FASTOPEN : int Eio.Net.Sockopt.t + | IP_FREEBIND : bool Eio.Net.Sockopt.t + | IP_BIND_ADDRESS_NO_PORT : bool Eio.Net.Sockopt.t + | IP_LOCAL_PORT_RANGE : (int * int) Eio.Net.Sockopt.t + | IP_TTL : int Eio.Net.Sockopt.t + | IP_MTU : int Eio.Net.Sockopt.t + | IP_MTU_DISCOVER : [`Want | `Dont | `Do | `Probe] Eio.Net.Sockopt.t + + let set : type a. Fd.t -> a Eio.Net.Sockopt.t -> a -> unit = fun fd opt v -> + match opt with + | TCP_CORK -> + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_cork (if v then 1 else 0)) + | TCP_KEEPIDLE -> + if v < 0 then + invalid_arg (Printf.sprintf "TCP_KEEPIDLE must be non-negative, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_keepidle v) + | TCP_KEEPINTVL -> + if v < 0 then + invalid_arg (Printf.sprintf "TCP_KEEPINTVL must be non-negative, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_keepintvl v) + | TCP_KEEPCNT -> + if v < 0 then + invalid_arg (Printf.sprintf "TCP_KEEPCNT must be non-negative, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_keepcnt v) + | TCP_USER_TIMEOUT -> + if v < 0 then + invalid_arg (Printf.sprintf "TCP_USER_TIMEOUT must be non-negative, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_user_timeout v) + | TCP_MAXSEG -> + if v < 0 then + invalid_arg (Printf.sprintf "TCP_MAXSEG must be non-negative, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_maxseg v) + | TCP_LINGER2 -> + let v = match v with + | None -> -1 + | Some n when n < 0 -> + invalid_arg (Printf.sprintf "TCP_LINGER2 must be non-negative, got %d" n); + | Some n -> n + in + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_linger2 v) + | TCP_DEFER_ACCEPT -> + if v < 0 then + invalid_arg (Printf.sprintf "TCP_DEFER_ACCEPT must be non-negative, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_defer_accept v) + | TCP_CONGESTION -> + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_string fd ipproto_tcp tcp_congestion v) + | TCP_SYNCNT -> + if v < 1 || v > 255 then + invalid_arg (Printf.sprintf "TCP_SYNCNT must be between 1 and 255, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_syncnt v) + | TCP_WINDOW_CLAMP -> + if v < 0 then + invalid_arg (Printf.sprintf "TCP_WINDOW_CLAMP must be non-negative, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_window_clamp v) + | TCP_QUICKACK -> + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_quickack (if v then 1 else 0)) + | TCP_FASTOPEN -> + if v < 0 then + invalid_arg (Printf.sprintf "TCP_FASTOPEN queue length must be non-negative, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_tcp tcp_fastopen v) + | IP_FREEBIND -> + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_ip ip_freebind (if v then 1 else 0)) + | IP_BIND_ADDRESS_NO_PORT -> + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_ip ip_bind_address_no_port (if v then 1 else 0)) + | IP_LOCAL_PORT_RANGE -> + let (lower, upper) = v in + if lower < 0 || lower > 65535 then + invalid_arg (Printf.sprintf "IP_LOCAL_PORT_RANGE lower bound must be 0-65535, got %d" lower); + if upper < 0 || upper > 65535 then + invalid_arg (Printf.sprintf "IP_LOCAL_PORT_RANGE upper bound must be 0-65535, got %d" upper); + if lower <> 0 && upper <> 0 && lower > upper then + invalid_arg (Printf.sprintf "IP_LOCAL_PORT_RANGE lower bound (%d) must be <= upper bound (%d)" lower upper); + let combined = (upper lsl 16) lor lower in + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_ip ip_local_port_range combined) + | IP_TTL -> + if v < 1 || v > 255 then + invalid_arg (Printf.sprintf "IP_TTL must be between 1 and 255, got %d" v); + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_ip ip_ttl v) + | IP_MTU -> + invalid_arg "IP_MTU is a read-only socket option" + | IP_MTU_DISCOVER -> + let intval = match v with + | `Want -> ip_pmtudisc_want + | `Dont -> ip_pmtudisc_dont + | `Do -> ip_pmtudisc_do + | `Probe -> ip_pmtudisc_probe + in + Fd.use_exn "setsockopt" fd (fun fd -> + setsockopt_int fd ipproto_ip ip_mtu_discover intval) + | _ -> Eio_unix.Net.Sockopt.set fd opt v + + let get : type a. Fd.t -> a Eio.Net.Sockopt.t -> a = fun fd opt -> + match opt with + | TCP_CORK -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_cork <> 0) + | TCP_KEEPIDLE -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_keepidle) + | TCP_KEEPINTVL -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_keepintvl) + | TCP_KEEPCNT -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_keepcnt) + | TCP_USER_TIMEOUT -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_user_timeout) + | TCP_MAXSEG -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_maxseg) + | TCP_LINGER2 -> + let v = Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_linger2) + in + if v = -1 then None else Some v + | TCP_DEFER_ACCEPT -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_defer_accept) + | TCP_CONGESTION -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_string fd ipproto_tcp tcp_congestion) + | TCP_SYNCNT -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_syncnt) + | TCP_WINDOW_CLAMP -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_window_clamp) + | TCP_QUICKACK -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_quickack <> 0) + | TCP_FASTOPEN -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_tcp tcp_fastopen) + | IP_FREEBIND -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_ip ip_freebind <> 0) + | IP_BIND_ADDRESS_NO_PORT -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_ip ip_bind_address_no_port <> 0) + | IP_LOCAL_PORT_RANGE -> + Fd.use_exn "getsockopt" fd (fun fd -> + let combined = getsockopt_int fd ipproto_ip ip_local_port_range in + let lower = combined land 0xFFFF in + let upper = (combined lsr 16) land 0xFFFF in + (lower, upper)) + | IP_TTL -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_ip ip_ttl) + | IP_MTU -> + Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_ip ip_mtu) + | IP_MTU_DISCOVER -> + let intval = Fd.use_exn "getsockopt" fd (fun fd -> + getsockopt_int fd ipproto_ip ip_mtu_discover) + in + if intval = ip_pmtudisc_want then `Want + else if intval = ip_pmtudisc_dont then `Dont + else if intval = ip_pmtudisc_do then `Do + else if intval = ip_pmtudisc_probe then `Probe + else failwith (Printf.sprintf "Unknown IP_MTU_DISCOVER value: %d" intval) + | _ -> Eio_unix.Net.Sockopt.get fd opt +end diff --git a/lib_eio_linux/low_level.mli b/lib_eio_linux/low_level.mli index 3b8529470..8675240f9 100644 --- a/lib_eio_linux/low_level.mli +++ b/lib_eio_linux/low_level.mli @@ -200,6 +200,79 @@ val recv_msg_with_fds : sw:Switch.t -> max_fds:int -> fd -> Cstruct.t list -> Ur (** [recv_msg_with_fds] is like [recv_msg] but also allows receiving up to [max_fds] file descriptors (sent using SCM_RIGHTS over a Unix domain socket). *) +module Sockopt : sig + (** Linux-specific socket options *) + + type _ Eio.Net.Sockopt.t += + | TCP_CORK : bool Eio.Net.Sockopt.t + (** When enabled, partial frames are not sent out. + Data is only sent when the option is disabled or the buffer becomes full. *) + | TCP_KEEPIDLE : int Eio.Net.Sockopt.t + (** Time (in seconds) the connection needs to remain idle before TCP starts sending keepalive probes. *) + | TCP_KEEPINTVL : int Eio.Net.Sockopt.t + (** Interval (in seconds) between individual keepalive probes. *) + | TCP_KEEPCNT : int Eio.Net.Sockopt.t + (** Maximum number of keepalive probes TCP should send before dropping the connection. *) + | TCP_USER_TIMEOUT : int Eio.Net.Sockopt.t + (** Maximum time (in milliseconds) that transmitted data may remain unacknowledged + before TCP will forcibly close the connection. *) + | TCP_MAXSEG : int Eio.Net.Sockopt.t + (** The maximum segment size for outgoing TCP packets. If set before connection + establishment, it also changes the MSS value announced to the other end. *) + | TCP_LINGER2 : int option Eio.Net.Sockopt.t + (** The lifetime of orphaned FIN_WAIT2 state sockets. + [Some n] sets the timeout to [n] seconds. + [None] uses the system default from /proc/sys/net/ipv4/tcp_fin_timeout. + Not to be confused with SO_LINGER. *) + | TCP_DEFER_ACCEPT : int Eio.Net.Sockopt.t + (** Allow a listener to be awakened only when data arrives on the socket. + Value is the maximum time in seconds to wait for data. *) + | TCP_CONGESTION : string Eio.Net.Sockopt.t + (** Set the TCP congestion control algorithm to be used (e.g., "cubic", "reno"). + Unprivileged processes are restricted to algorithms in tcp_allowed_congestion_control. *) + | TCP_SYNCNT : int Eio.Net.Sockopt.t + (** Set the number of SYN retransmits that TCP should send before aborting + the attempt to connect. Cannot exceed 255. *) + | TCP_WINDOW_CLAMP : int Eio.Net.Sockopt.t + (** Bound the size of the advertised window to this value. + The kernel imposes a minimum size. *) + | TCP_QUICKACK : bool Eio.Net.Sockopt.t + (** Enable quickack mode if set or disable if cleared. In quickack mode, + acks are sent immediately rather than delayed. This flag is not permanent. *) + | TCP_FASTOPEN : int Eio.Net.Sockopt.t + (** Enable Fast Open (RFC 7413) on the listener socket. The value specifies + the maximum length of pending SYNs (similar to backlog in listen). *) + | IP_FREEBIND : bool Eio.Net.Sockopt.t + (** Allow binding to an IP address that is nonlocal or does not (yet) exist. + This permits listening on a socket without requiring the underlying + network interface to be up. *) + | IP_BIND_ADDRESS_NO_PORT : bool Eio.Net.Sockopt.t + (** Inform the kernel to not reserve an ephemeral port when using bind() + with a port number of 0. The port will be chosen at connect() time. *) + | IP_LOCAL_PORT_RANGE : (int * int) Eio.Net.Sockopt.t + (** Set the per-socket local port range as (lower_bound, upper_bound). + Both bounds are inclusive and must be in range 0-65535. + Use (0, 0) to reset to system defaults. *) + | IP_TTL : int Eio.Net.Sockopt.t + (** Set or retrieve the time-to-live field used in every packet sent from this socket. + Valid range is 1-255. *) + | IP_MTU : int Eio.Net.Sockopt.t + (** Retrieve the current known path MTU of the current socket. + Only valid for connected sockets. This is a read-only option. *) + | IP_MTU_DISCOVER : [`Want | `Dont | `Do | `Probe] Eio.Net.Sockopt.t + (** Set or receive the Path MTU Discovery setting for a socket. + - [`Want]: Use per-route settings (fragment if needed) + - [`Dont]: Never do Path MTU Discovery + - [`Do]: Always do Path MTU Discovery (reject large datagrams with EMSGSIZE) + - [`Probe]: Set DF but ignore Path MTU (for diagnostic tools) *) + + val set : fd -> 'a Eio.Net.Sockopt.t -> 'a -> unit + (** [set fd opt v] sets socket option [opt] to value [v] on file descriptor [fd]. *) + + val get : fd -> 'a Eio.Net.Sockopt.t -> 'a + (** [get fd opt] gets the value of socket option [opt] on file descriptor [fd]. *) +end + (** {1 Randomness} *) val getrandom : Cstruct.t -> unit diff --git a/lib_eio_linux/tests/network.md b/lib_eio_linux/tests/network.md new file mode 100644 index 0000000000000000000000000000000000000000..ff4edc6822a58a2e1c04244914a4f5a337894e1e GIT binary patch literal 11041 zcmd5?dru-u7T>@96cx-SIHLp^aW+oITo-X;hAS*EPBwctZ36}NwdrR2q3dQdpM8I) zUR~W3;C1fYj8TEEI;YP2RqV4~5as_lN>_Xu%!4V5c=i-04?(nG8BeoxZ}0BzE}r_! zaBrXOC;Z=ekZ@MxLF|PDS^Myzy3oj@Ks}FFJYwA-Zj7>-*ckGR`LkKVKC-*C^@<)hZciFv9Iqz+^x=>-4*>J%hZ5q9{qtM`#dGoY_JsXQAh+N%_J##fhJ}xN zOdV1C<+%0!mu9o6{*G&en)uq=+uyGWVB8t7G@d?y(0G*vaRd>JA&K4l&PuWZV^Ttm zB#+onKe0Jpc=X7Q&OzDeDafYx_EP#JS4cuo0tAH3`}8h|06>q!AkBE>5p`JBl9Nvb z%vT`!n(#d39!c{oOLES>k}$(~an_b{tfHIGBr=cGCUk)(_E8l8n1;ZXy@$qV@-4;v$}1&K>`>u;D4I<(6VN zARr)aq=k^c13g)TZ+}q2obfp)Go)RM-Ecw(S>jK57_r(KS_fHY?9XY9)q^>cN1d}K z%kJS1H6Hnskk4w2hbeq%7Nqj?!G}E%2i7|Y_cP9XM#eaeqliz*64^XXSPUGA^i3ui zhX-8+6P`3CSOWr}AX}>+NQ0sWWIfX`;P8yXa1>%jRzr3s)n>FPIM%>UBT*Q!QJgAB zH(KlTho2;YghOk`Qj6F?7D^hSA3-EykEN9Ac0*H169SVGDx^NCL1xK=M!V_gxew{< zP2YC5)}Vd3LnNQN-NE%`uX{*(^~9%}@olg8*tr>R6`4lBPMbF251g-p8Jw%IW=n7e z$Spj*4BBTbu+NYOCBj@QYFvd3@>J;b;4bV6Rzra|kVh_LP=iG(P; zoG_DKiI=IgeC6vE=@7(b;b2uzvP$9!SE2zrLxvryde=99>keC6m8kdBNAZ%g<6~qw z%K;D-7d&aXMW;dC#Hv*gOL1rEBf-F@B|4;=dv+5?95I2_(q|-+CB-E_53?Hk9}~1h zv^YqRKj)2fC0<$0wu(qbC=#sAb*B%mN8{`MO~JTyC>)-O$mO(53vQjGPM#zbugF!b zjefX@6EL%sY{FdC5hZ;j&n$~!&4_yW1XT@!u>a@>A;npC#FqXuo8u#!_$i-JPEis8 zx_PiDxTt5zvr>-J1uVj9;-s3^r8K>WKY0a-Zlzi{j1(-F80FI`Pt$oGhR=edia@eh zN}_y}B3h{3EAoJaw-e{#j72d-bniomRYBLII9a0hqMVaQu!hGV*weTTWV9*JSJIbF?wWC;&H&a#2K>goFAhT?QE(SR!=N_~rWMvj4^F z^e%oLY?W$huimn*k;OYm;;?Ja_d$us(f8nclbCa7e+3gf57 zG>lRC$ofHAg}Y=y>2t`c)us=JK%Gcs%UY!=%&T$=kWeG>mejkemOMk%Es8O@y>aT)1eAa((YorwMA3+jC7@h^nA4-qQdjq? z3;XWf)$1FStBcXNKj_|UZcZpd*tS{};qvJZ-M#5>tr)P1C&Reus^)&0iKf3u_*=k4 zNGU~ZgVEhkp=Z)3P$Z)wq<`5*ZckAU1j|*(msB&T#w5*Gt2oK16hKVEE9E6P7;+MF zsYpk^yGTr zT@Ab4zamwjye>Cc^MvyWg1;5?Hv^kd z^oNcXXYF(+Se1<^_Jn#1Q+pX6Cr7RmC3or=&73ob35EZmiEO*0wD;bYv?OCT9=X{R z%Z|8==@?CA5WHj%W*Ei=GhbBn(_O(#&Ruu)r#Ihx#OnToW+RK`Rd^}^tRvv5Co30PnUjv(h-vGRJ^h?R1uyI02$U3j@ea6ckb|h}mWv>bxzHTJ11)fD>>j_{u1)kZq69 zTe75r-SyWrDP2K}8HVMXY7bA}& z?~y|!6lPhz=0lZP?!HcP@IOxAuk?xQk&=oCOOE@NwUM(;p1`<9;7^=V=g4 zv5=+g{Iu~-P1#6!B%eyD;=)=`vq7M!b8w%J>*-0HqXIf-7{HiMMh9yb0Isv@Eqr0) z5R=lason)?A{}Wc(L|JWVY$s(m*BydKGRnr=%2@vBu?t$vn5IlrSWTBuuHc$$;d@l z{NV7TI7e?iXBhkA21ZOXM0`#+2zWgPt*O3#0+B&-@9AYrk>DcHh)z&)&Q9CyckLff za<`%Z5Hw1`IV=AiX>+6C;Ql4SQM9THTRN2XeBcaRYxqo5XUtDijya^n0%)NkOE-F5 zy30paC1I;w39nQZ1RK+)En?12JN6ER6&E+~F0*i-0Q!rVG2|4k=+3otwfqfc3=?*m zuZzHhPX8X9OT-1I&f(u5I`>nZsZfb%9!ryvWsWg7a?k|d;^X+L(Xr@6TkZBCTOb>v zh?2K63XACoRkv+*w>vN$9hVT<1>wt)G)p*i(JrkG|7nV7_tSE>v->PH)|&Jvj*c{k zl7CJ0#{P})loq$)YAX75*HP7pe!c}qOY)?5Y7vMpYOMDyVyG*+h|?4Op4p;@Z%`Yf z58Pk{AX{y$7R4`v7gmI=Ho*!{cic_>A4}K01^@s6 literal 0 HcmV?d00001 diff --git a/lib_eio_posix/flow.ml b/lib_eio_posix/flow.ml index 89f663375..0e1e3bcef 100644 --- a/lib_eio_posix/flow.ml +++ b/lib_eio_posix/flow.ml @@ -120,6 +120,9 @@ module Impl = struct let fd t = t let close = Eio_unix.Fd.close + + let setsockopt t opt v = Eio_unix.Net.Sockopt.set t opt v + let getsockopt t opt = Eio_unix.Net.Sockopt.get t opt end let handler = Eio_unix.Pi.flow_handler (module Impl) diff --git a/lib_eio_posix/net.ml b/lib_eio_posix/net.ml index 7f9d25fc2..e87ad11b2 100644 --- a/lib_eio_posix/net.ml +++ b/lib_eio_posix/net.ml @@ -40,6 +40,9 @@ module Listening_socket = struct let listening_addr { fd; _ } = Eio_unix.Fd.use_exn "listening_addr" fd (fun fd -> Eio_unix.Net.sockaddr_of_unix_stream (Unix.getsockname fd)) + + let setsockopt t opt v = Eio_unix.Net.Sockopt.set t.fd opt v + let getsockopt t opt = Eio_unix.Net.Sockopt.get t.fd opt end let listening_handler = Eio_unix.Pi.listening_socket_handler (module Listening_socket) @@ -74,6 +77,9 @@ module Datagram_socket = struct with | Unix.Unix_error (Unix.ENOTCONN, _, _) -> () | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg) + + let setsockopt t opt v = Eio_unix.Net.Sockopt.set t opt v + let getsockopt t opt = Eio_unix.Net.Sockopt.get t opt end let datagram_handler = Eio_unix.Pi.datagram_handler (module Datagram_socket) diff --git a/lib_eio_windows/flow.ml b/lib_eio_windows/flow.ml index 5eacd68da..eab1136e5 100755 --- a/lib_eio_windows/flow.ml +++ b/lib_eio_windows/flow.ml @@ -83,6 +83,9 @@ module Impl = struct let fd t = t let close = Eio_unix.Fd.close + + let setsockopt t opt v = Eio_unix.Net.Sockopt.set t opt v + let getsockopt t opt = Eio_unix.Net.Sockopt.get t opt end let handler = Eio_unix.Pi.flow_handler (module Impl) diff --git a/lib_eio_windows/net.ml b/lib_eio_windows/net.ml index 198e75e0c..354b99117 100755 --- a/lib_eio_windows/net.ml +++ b/lib_eio_windows/net.ml @@ -40,6 +40,9 @@ module Listening_socket = struct let listening_addr { fd; _ } = Eio_unix.Fd.use_exn "listening_addr" fd (fun fd -> Eio_unix.Net.sockaddr_of_unix_stream (Unix.getsockname fd)) + + let setsockopt t opt v = Eio_unix.Net.Sockopt.set t.fd opt v + let getsockopt t opt = Eio_unix.Net.Sockopt.get t.fd opt end let listening_handler = Eio_unix.Pi.listening_socket_handler (module Listening_socket) @@ -76,6 +79,9 @@ module Datagram_socket = struct with | Unix.Unix_error (Unix.ENOTCONN, _, _) -> () | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg) + + let setsockopt t opt v = Eio_unix.Net.Sockopt.set t opt v + let getsockopt t opt = Eio_unix.Net.Sockopt.get t opt end let datagram_handler = Eio_unix.Pi.datagram_handler (module Datagram_socket) diff --git a/tests/network.md b/tests/network.md index 87596a680..69405fa9b 100644 --- a/tests/network.md +++ b/tests/network.md @@ -563,6 +563,96 @@ Exception: Eio.Io Fs Not_found _, - : unit = () ``` +## Socket Options + +Test portable socket options on a TCP socket: + +```ocaml +# 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 + 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; + assert (Eio.Net.getsockopt client Eio.Net.Sockopt.SO_KEEPALIVE); + Eio.Net.setsockopt client Eio.Net.Sockopt.SO_SNDBUF 32768; + let sndbuf = Eio.Net.getsockopt client Eio.Net.Sockopt.SO_SNDBUF in + traceln "SO_SNDBUF: %s" (if sndbuf > 0 then "positive" else "error"); + assert (sndbuf > 0); + let sock_type = Eio.Net.getsockopt client Eio.Net.Sockopt.SO_TYPE in + traceln "SO_TYPE: %d" sock_type; + Eio.Net.setsockopt client Eio.Net.Sockopt.SO_LINGER (Some 10); + (match Eio.Net.getsockopt client Eio.Net.Sockopt.SO_LINGER with + | None -> traceln "SO_LINGER: disabled" + | Some n -> traceln "SO_LINGER: %d seconds" n); + 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_SNDBUF: positive ++SO_TYPE: 1 ++SO_LINGER: 10 seconds ++SO_RCVTIMEO: 5.0 seconds +- : unit = () +``` + +Test socket options on listening socket: + +```ocaml +# run @@ fun ~net sw -> + let server = Eio.Net.listen net ~sw ~reuse_addr:true ~backlog:5 addr in + Eio.Net.setsockopt server Eio.Net.Sockopt.SO_REUSEADDR true; + assert (Eio.Net.getsockopt server Eio.Net.Sockopt.SO_REUSEADDR); + traceln "SO_REUSEADDR is set on listening socket";; ++SO_REUSEADDR is set on listening socket +- : unit = () +``` + +Test socket options on datagram socket: + +```ocaml +# run @@ fun ~net sw -> + let udp = Eio.Net.datagram_socket net ~sw `UdpV4 in + Eio.Net.setsockopt udp Eio.Net.Sockopt.SO_BROADCAST true; + assert (Eio.Net.getsockopt udp Eio.Net.Sockopt.SO_BROADCAST); + traceln "UDP socket broadcast enabled";; ++UDP socket broadcast enabled +- : unit = () +``` + +Test Unix-specific socket option wrappers: + +```ocaml +# Eio_main.run @@ fun _ -> + Switch.run @@ fun sw -> + let a, b = Eio_unix.Net.socketpair_stream ~sw () in + let fd = Eio_unix.Net.fd a in + Eio_unix.Net.Sockopt.set fd (Eio_unix.Net.Sockopt.Unix_int Unix.SO_SNDBUF) 32768; + let sndbuf = Eio_unix.Net.Sockopt.get fd (Eio_unix.Net.Sockopt.Unix_int Unix.SO_SNDBUF) in + traceln "Unix SO_SNDBUF: %s" (if sndbuf > 0 then "positive" else "zero"); + assert (sndbuf > 0); + Eio_unix.Net.Sockopt.set fd (Eio_unix.Net.Sockopt.Unix_optint Unix.SO_LINGER) (Some 5); + (match Eio_unix.Net.Sockopt.get fd (Eio_unix.Net.Sockopt.Unix_optint Unix.SO_LINGER) with + | None -> traceln "Unix SO_LINGER: disabled" + | Some n -> traceln "Unix SO_LINGER: %d seconds" n);; ++Unix SO_SNDBUF: positive ++Unix SO_LINGER: 5 seconds +- : unit = () +``` + +Error handling for read-only options: + +```ocaml +# run @@ fun ~net sw -> + let a, _b = Eio_unix.Net.socketpair_stream ~sw () in + match Eio.Net.setsockopt a Eio.Net.Sockopt.SO_TYPE 2 with + | () -> failwith "Should have failed!" + | exception Invalid_argument msg -> + traceln "Expected error: %s" msg;; ++Expected error: SO_TYPE is read-only +- : unit = () +``` + + ## Getaddrinfo ```ocaml @@ -610,7 +700,7 @@ Exception: Eio.Io Fs Not_found _, # Eio_main.run @@ fun env -> Eio.Net.getaddrinfo ~service:"https" env#net "google.com";; - : Eio.Net.Sockaddr.t list = -[`Tcp ("Ø:ÔÎ", 443); `Udp ("Ø:ÔÎ", 443); +[`Tcp ("�:��", 443); `Udp ("�:��", 443); `Tcp ("*\000\020P@\t\b \000\000\000\000\000\000 \014", 443); `Udp ("*\000\020P@\t\b \000\000\000\000\000\000 \014", 443)] ``` From ac4d94964142dbb74f19a4cf08f6a206360bfd0b Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Tue, 30 Sep 2025 21:06:53 +0000 Subject: [PATCH 2/4] Changes for #575 --- CHANGES.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 36fc0294c..d26f2598b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,11 @@ +## v1.4 + +Changes: + +- Add support for setting/getting socket options (@avsm #575) + This adds a Eio.Net.Sockopt.t extensible variant where portable + options are exposed, and backend-specific sockopts for Unix/Linux. + ## v1.3 Bug fixes: From a44bdb54bd832008721aba1681cc4ea57d69ede2 Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Mon, 20 Oct 2025 10:22:39 +0100 Subject: [PATCH 3/4] Add pretty printer functions for sockopts and use them in the mocks Co-authored-by: Thomas Leonard --- lib_eio/mock/sockopt.ml | 68 ++++++-------- lib_eio/mock/sockopt.mli | 4 - lib_eio/net.ml | 21 +++++ lib_eio/net.mli | 2 + lib_eio_linux/low_level.ml | 180 ++++++++++++++++++------------------ lib_eio_linux/low_level.mli | 4 + 6 files changed, 141 insertions(+), 138 deletions(-) diff --git a/lib_eio/mock/sockopt.ml b/lib_eio/mock/sockopt.ml index 86777af5c..86068583e 100644 --- a/lib_eio/mock/sockopt.ml +++ b/lib_eio/mock/sockopt.ml @@ -1,47 +1,31 @@ open Eio.Std -let pp_sockopt_value : type a. a Eio.Net.Sockopt.t -> a -> string = fun opt v -> - match opt with - | Eio.Net.Sockopt.SO_DEBUG -> Fmt.str "SO_DEBUG = %b" v - | Eio.Net.Sockopt.SO_BROADCAST -> Fmt.str "SO_BROADCAST = %b" v - | Eio.Net.Sockopt.SO_REUSEADDR -> Fmt.str "SO_REUSEADDR = %b" v - | Eio.Net.Sockopt.SO_KEEPALIVE -> Fmt.str "SO_KEEPALIVE = %b" v - | Eio.Net.Sockopt.SO_DONTROUTE -> Fmt.str "SO_DONTROUTE = %b" v - | Eio.Net.Sockopt.SO_OOBINLINE -> Fmt.str "SO_OOBINLINE = %b" v - | Eio.Net.Sockopt.TCP_NODELAY -> Fmt.str "TCP_NODELAY = %b" v - | Eio.Net.Sockopt.IPV6_ONLY -> Fmt.str "IPV6_ONLY = %b" v - | Eio.Net.Sockopt.SO_REUSEPORT -> Fmt.str "SO_REUSEPORT = %b" v - | Eio.Net.Sockopt.SO_SNDBUF -> Fmt.str "SO_SNDBUF = %d" v - | Eio.Net.Sockopt.SO_RCVBUF -> Fmt.str "SO_RCVBUF = %d" v - | Eio.Net.Sockopt.SO_TYPE -> Fmt.str "SO_TYPE = %d" v - | Eio.Net.Sockopt.SO_RCVLOWAT -> Fmt.str "SO_RCVLOWAT = %d" v - | Eio.Net.Sockopt.SO_SNDLOWAT -> Fmt.str "SO_SNDLOWAT = %d" v - | Eio.Net.Sockopt.SO_LINGER -> Fmt.str "SO_LINGER = %s" (match v with None -> "None" | Some n -> string_of_int n) - | Eio.Net.Sockopt.SO_RCVTIMEO -> Fmt.str "SO_RCVTIMEO = %f" v - | Eio.Net.Sockopt.SO_SNDTIMEO -> Fmt.str "SO_SNDTIMEO = %f" v - | _ -> "unknown" - let setsockopt : type a. string -> a Eio.Net.Sockopt.t -> a -> unit = fun label opt v -> - let opt_desc = pp_sockopt_value opt v in - traceln "%s: setsockopt %s" label opt_desc + traceln "%s: setsockopt %a" label (Eio.Net.Sockopt.pp opt) v -let getsockopt : type a. string -> a Eio.Net.Sockopt.t -> a = fun label opt -> +let default (type a) (opt : a Eio.Net.Sockopt.t) : a = + let open Eio.Net.Sockopt in match opt with - | Eio.Net.Sockopt.SO_DEBUG -> traceln "%s: getsockopt SO_DEBUG = false" label; false - | Eio.Net.Sockopt.SO_BROADCAST -> traceln "%s: getsockopt SO_BROADCAST = false" label; false - | Eio.Net.Sockopt.SO_REUSEADDR -> traceln "%s: getsockopt SO_REUSEADDR = false" label; false - | Eio.Net.Sockopt.SO_KEEPALIVE -> traceln "%s: getsockopt SO_KEEPALIVE = false" label; false - | Eio.Net.Sockopt.SO_DONTROUTE -> traceln "%s: getsockopt SO_DONTROUTE = false" label; false - | Eio.Net.Sockopt.SO_OOBINLINE -> traceln "%s: getsockopt SO_OOBINLINE = false" label; false - | Eio.Net.Sockopt.TCP_NODELAY -> traceln "%s: getsockopt TCP_NODELAY = false" label; false - | Eio.Net.Sockopt.IPV6_ONLY -> traceln "%s: getsockopt IPV6_ONLY = false" label; false - | Eio.Net.Sockopt.SO_REUSEPORT -> traceln "%s: getsockopt SO_REUSEPORT = false" label; false - | Eio.Net.Sockopt.SO_SNDBUF -> traceln "%s: getsockopt SO_SNDBUF = 0" label; 0 - | Eio.Net.Sockopt.SO_RCVBUF -> traceln "%s: getsockopt SO_RCVBUF = 0" label; 0 - | Eio.Net.Sockopt.SO_TYPE -> traceln "%s: getsockopt SO_TYPE = 0" label; 0 - | Eio.Net.Sockopt.SO_RCVLOWAT -> traceln "%s: getsockopt SO_RCVLOWAT = 0" label; 0 - | Eio.Net.Sockopt.SO_SNDLOWAT -> traceln "%s: getsockopt SO_SNDLOWAT = 0" label; 0 - | Eio.Net.Sockopt.SO_LINGER -> traceln "%s: getsockopt SO_LINGER = None" label; None - | Eio.Net.Sockopt.SO_RCVTIMEO -> traceln "%s: getsockopt SO_RCVTIMEO = 0.0" label; 0.0 - | Eio.Net.Sockopt.SO_SNDTIMEO -> traceln "%s: getsockopt SO_SNDTIMEO = 0.0" label; 0.0 - | _ -> raise (Failure "Mock getsockopt not implemented") \ No newline at end of file + | SO_DEBUG -> false + | SO_BROADCAST -> false + | SO_REUSEADDR -> false + | SO_KEEPALIVE -> false + | SO_DONTROUTE -> false + | SO_OOBINLINE -> false + | TCP_NODELAY -> false + | IPV6_ONLY -> false + | SO_REUSEPORT -> false + | SO_SNDBUF -> 0 + | SO_RCVBUF -> 0 + | SO_TYPE -> 0 + | SO_RCVLOWAT -> 0 + | SO_SNDLOWAT -> 0 + | SO_LINGER -> None + | SO_RCVTIMEO -> 0.0 + | SO_SNDTIMEO -> 0.0 + | _ -> raise (Failure "Mock getsockopt not implemented") + +let getsockopt : type a. string -> a Eio.Net.Sockopt.t -> a = fun label opt -> + let v = default opt in + traceln "%s: getsockopt %a" label (Eio.Net.Sockopt.pp opt) v; + v diff --git a/lib_eio/mock/sockopt.mli b/lib_eio/mock/sockopt.mli index b52d9fbac..6e6cd205f 100644 --- a/lib_eio/mock/sockopt.mli +++ b/lib_eio/mock/sockopt.mli @@ -1,9 +1,5 @@ (** Mock socket option helpers *) -val pp_sockopt_value : 'a Eio.Net.Sockopt.t -> 'a -> string -(** [pp_sockopt_value opt v] formats socket option [opt] with value [v] as a string - for trace output. Returns [unknown] for unrecognised options. *) - val setsockopt : string -> 'a Eio.Net.Sockopt.t -> 'a -> unit (** [setsockopt label opt v] simulates setting socket option [opt] to value [v]. Outputs a trace message using [label] to identify the socket. *) diff --git a/lib_eio/net.ml b/lib_eio/net.ml index a23e611b6..585164af7 100644 --- a/lib_eio/net.ml +++ b/lib_eio/net.ml @@ -180,6 +180,27 @@ module Sockopt = struct | SO_LINGER : int option t | SO_RCVTIMEO : float t | SO_SNDTIMEO : float t + + let pp (type a) (opt : a t) f (v:a) = + match opt with + | SO_DEBUG -> Fmt.pf f "SO_DEBUG = %b" v + | SO_BROADCAST -> Fmt.pf f "SO_BROADCAST = %b" v + | SO_REUSEADDR -> Fmt.pf f "SO_REUSEADDR = %b" v + | SO_KEEPALIVE -> Fmt.pf f "SO_KEEPALIVE = %b" v + | SO_DONTROUTE -> Fmt.pf f "SO_DONTROUTE = %b" v + | SO_OOBINLINE -> Fmt.pf f "SO_OOBINLINE = %b" v + | TCP_NODELAY -> Fmt.pf f "TCP_NODELAY = %b" v + | IPV6_ONLY -> Fmt.pf f "IPV6_ONLY = %b" v + | SO_REUSEPORT -> Fmt.pf f "SO_REUSEPORT = %b" v + | SO_SNDBUF -> Fmt.pf f "SO_SNDBUF = %d" v + | SO_RCVBUF -> Fmt.pf f "SO_RCVBUF = %d" v + | SO_TYPE -> Fmt.pf f "SO_TYPE = %d" v + | SO_RCVLOWAT -> Fmt.pf f "SO_RCVLOWAT = %d" v + | SO_SNDLOWAT -> Fmt.pf f "SO_SNDLOWAT = %d" v + | SO_LINGER -> Fmt.(pf f "SO_LINGER = %a" (option ~none:(any "") int) v) + | SO_RCVTIMEO -> Fmt.pf f "SO_RCVTIMEO = %f" v + | SO_SNDTIMEO -> Fmt.pf f "SO_SNDTIMEO = %f" v + | _ -> Fmt.pf f "" end type socket_ty = [`Socket | `Close] diff --git a/lib_eio/net.mli b/lib_eio/net.mli index 80d157c99..925732d5d 100644 --- a/lib_eio/net.mli +++ b/lib_eio/net.mli @@ -127,6 +127,8 @@ 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 *) + + val pp : 'a t -> Format.formatter -> 'a -> unit end (** {2 Types} *) diff --git a/lib_eio_linux/low_level.ml b/lib_eio_linux/low_level.ml index 8ec0dcf93..b1d1bc2ef 100644 --- a/lib_eio_linux/low_level.ml +++ b/lib_eio_linux/low_level.ml @@ -650,11 +650,6 @@ module Sockopt = struct let ip_ttl = 2 (* IP_TTL *) let ip_mtu = 14 (* IP_MTU *) let ip_mtu_discover = 10 (* IP_MTU_DISCOVER *) - (* IP_MTU_DISCOVER values *) - let ip_pmtudisc_want = 1 (* IP_PMTUDISC_WANT *) - let ip_pmtudisc_dont = 0 (* IP_PMTUDISC_DONT *) - let ip_pmtudisc_do = 2 (* IP_PMTUDISC_DO *) - let ip_pmtudisc_probe = 3 (* IP_PMTUDISC_PROBE *) external setsockopt_int : Unix.file_descr -> int -> int -> int -> unit = "caml_eio_sockopt_int_set" external getsockopt_int : Unix.file_descr -> int -> int -> int = "caml_eio_sockopt_int_get" @@ -683,36 +678,68 @@ module Sockopt = struct | IP_MTU : int Eio.Net.Sockopt.t | IP_MTU_DISCOVER : [`Want | `Dont | `Do | `Probe] Eio.Net.Sockopt.t + let pp : type a. a Eio.Net.Sockopt.t -> Format.formatter -> a -> unit = fun opt f v -> + match opt with + | TCP_CORK -> Fmt.pf f "TCP_CORK = %b" v + | TCP_KEEPIDLE -> Fmt.pf f "TCP_KEEPIDLE = %d" v + | TCP_KEEPINTVL -> Fmt.pf f "TCP_KEEPINTVL = %d" v + | TCP_KEEPCNT -> Fmt.pf f "TCP_KEEPCNT = %d" v + | TCP_USER_TIMEOUT -> Fmt.pf f "TCP_USER_TIMEOUT = %d" v + | TCP_MAXSEG -> Fmt.pf f "TCP_MAXSEG = %d" v + | TCP_LINGER2 -> Fmt.(pf f "TCP_LINGER2 = %a" (option ~none:(any "") int) v) + | TCP_DEFER_ACCEPT -> Fmt.pf f "TCP_DEFER_ACCEPT = %d" v + | TCP_CONGESTION -> Fmt.pf f "TCP_CONGESTION = %s" v + | TCP_SYNCNT -> Fmt.pf f "TCP_SYNCNT = %d" v + | TCP_WINDOW_CLAMP -> Fmt.pf f "TCP_WINDOW_CLAMP = %d" v + | TCP_QUICKACK -> Fmt.pf f "TCP_QUICKACK = %b" v + | TCP_FASTOPEN -> Fmt.pf f "TCP_FASTOPEN = %d" v + | IP_FREEBIND -> Fmt.pf f "IP_FREEBIND = %b" v + | IP_BIND_ADDRESS_NO_PORT -> Fmt.pf f "IP_BIND_ADDRESS_NO_PORT = %b" v + | IP_LOCAL_PORT_RANGE -> + let (lower, upper) = v in + Fmt.pf f "IP_LOCAL_PORT_RANGE = (%d, %d)" lower upper + | IP_TTL -> Fmt.pf f "IP_TTL = %d" v + | IP_MTU -> Fmt.pf f "IP_MTU = %d" v + | IP_MTU_DISCOVER -> + let s = match v with + | `Want -> "Want" + | `Dont -> "Dont" + | `Do -> "Do" + | `Probe -> "Probe" + in + Fmt.pf f "IP_MTU_DISCOVER = %s" s + | _ -> Eio.Net.Sockopt.pp opt f v + + let with_fd_set fd fn = + Fd.use_exn "setsockopt" fd fn + + let with_fd_get fd fn = + Fd.use_exn "getsockopt" fd fn + let set : type a. Fd.t -> a Eio.Net.Sockopt.t -> a -> unit = fun fd opt v -> match opt with | TCP_CORK -> - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_cork (if v then 1 else 0)) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_cork (if v then 1 else 0)) | TCP_KEEPIDLE -> if v < 0 then invalid_arg (Printf.sprintf "TCP_KEEPIDLE must be non-negative, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_keepidle v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_keepidle v) | TCP_KEEPINTVL -> if v < 0 then invalid_arg (Printf.sprintf "TCP_KEEPINTVL must be non-negative, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_keepintvl v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_keepintvl v) | TCP_KEEPCNT -> if v < 0 then invalid_arg (Printf.sprintf "TCP_KEEPCNT must be non-negative, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_keepcnt v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_keepcnt v) | TCP_USER_TIMEOUT -> if v < 0 then invalid_arg (Printf.sprintf "TCP_USER_TIMEOUT must be non-negative, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_user_timeout v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_user_timeout v) | TCP_MAXSEG -> if v < 0 then invalid_arg (Printf.sprintf "TCP_MAXSEG must be non-negative, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_maxseg v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_maxseg v) | TCP_LINGER2 -> let v = match v with | None -> -1 @@ -720,40 +747,31 @@ module Sockopt = struct invalid_arg (Printf.sprintf "TCP_LINGER2 must be non-negative, got %d" n); | Some n -> n in - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_linger2 v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_linger2 v) | TCP_DEFER_ACCEPT -> if v < 0 then invalid_arg (Printf.sprintf "TCP_DEFER_ACCEPT must be non-negative, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_defer_accept v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_defer_accept v) | TCP_CONGESTION -> - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_string fd ipproto_tcp tcp_congestion v) + with_fd_set fd (fun fd -> setsockopt_string fd ipproto_tcp tcp_congestion v) | TCP_SYNCNT -> if v < 1 || v > 255 then invalid_arg (Printf.sprintf "TCP_SYNCNT must be between 1 and 255, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_syncnt v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_syncnt v) | TCP_WINDOW_CLAMP -> if v < 0 then invalid_arg (Printf.sprintf "TCP_WINDOW_CLAMP must be non-negative, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_window_clamp v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_window_clamp v) | TCP_QUICKACK -> - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_quickack (if v then 1 else 0)) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_quickack (if v then 1 else 0)) | TCP_FASTOPEN -> if v < 0 then invalid_arg (Printf.sprintf "TCP_FASTOPEN queue length must be non-negative, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_tcp tcp_fastopen v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_tcp tcp_fastopen v) | IP_FREEBIND -> - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_ip ip_freebind (if v then 1 else 0)) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_ip ip_freebind (if v then 1 else 0)) | IP_BIND_ADDRESS_NO_PORT -> - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_ip ip_bind_address_no_port (if v then 1 else 0)) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_ip ip_bind_address_no_port (if v then 1 else 0)) | IP_LOCAL_PORT_RANGE -> let (lower, upper) = v in if lower < 0 || lower > 65535 then @@ -763,95 +781,73 @@ module Sockopt = struct if lower <> 0 && upper <> 0 && lower > upper then invalid_arg (Printf.sprintf "IP_LOCAL_PORT_RANGE lower bound (%d) must be <= upper bound (%d)" lower upper); let combined = (upper lsl 16) lor lower in - Fd.use_exn "setsockopt" fd (fun fd -> + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_ip ip_local_port_range combined) | IP_TTL -> if v < 1 || v > 255 then invalid_arg (Printf.sprintf "IP_TTL must be between 1 and 255, got %d" v); - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_ip ip_ttl v) + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_ip ip_ttl v) | IP_MTU -> invalid_arg "IP_MTU is a read-only socket option" | IP_MTU_DISCOVER -> - let intval = match v with - | `Want -> ip_pmtudisc_want - | `Dont -> ip_pmtudisc_dont - | `Do -> ip_pmtudisc_do - | `Probe -> ip_pmtudisc_probe - in - Fd.use_exn "setsockopt" fd (fun fd -> - setsockopt_int fd ipproto_ip ip_mtu_discover intval) + let i = match v with + | `Dont -> 0 + | `Want -> 1 + | `Do -> 2 + | `Probe -> 3 in + with_fd_set fd (fun fd -> setsockopt_int fd ipproto_ip ip_mtu_discover i) | _ -> Eio_unix.Net.Sockopt.set fd opt v let get : type a. Fd.t -> a Eio.Net.Sockopt.t -> a = fun fd opt -> match opt with | TCP_CORK -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_cork <> 0) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_cork <> 0) | TCP_KEEPIDLE -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_keepidle) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_keepidle) | TCP_KEEPINTVL -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_keepintvl) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_keepintvl) | TCP_KEEPCNT -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_keepcnt) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_keepcnt) | TCP_USER_TIMEOUT -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_user_timeout) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_user_timeout) | TCP_MAXSEG -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_maxseg) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_maxseg) | TCP_LINGER2 -> - let v = Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_linger2) - in + let v = with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_linger2) in if v = -1 then None else Some v | TCP_DEFER_ACCEPT -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_defer_accept) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_defer_accept) | TCP_CONGESTION -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_string fd ipproto_tcp tcp_congestion) + with_fd_get fd (fun fd -> getsockopt_string fd ipproto_tcp tcp_congestion) | TCP_SYNCNT -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_syncnt) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_syncnt) | TCP_WINDOW_CLAMP -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_window_clamp) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_window_clamp) | TCP_QUICKACK -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_quickack <> 0) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_quickack <> 0) | TCP_FASTOPEN -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_tcp tcp_fastopen) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_tcp tcp_fastopen) | IP_FREEBIND -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_ip ip_freebind <> 0) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_ip ip_freebind <> 0) | IP_BIND_ADDRESS_NO_PORT -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_ip ip_bind_address_no_port <> 0) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_ip ip_bind_address_no_port <> 0) | IP_LOCAL_PORT_RANGE -> - Fd.use_exn "getsockopt" fd (fun fd -> + with_fd_get fd (fun fd -> let combined = getsockopt_int fd ipproto_ip ip_local_port_range in let lower = combined land 0xFFFF in let upper = (combined lsr 16) land 0xFFFF in - (lower, upper)) + lower, upper) | IP_TTL -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_ip ip_ttl) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_ip ip_ttl) | IP_MTU -> - Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_ip ip_mtu) - | IP_MTU_DISCOVER -> - let intval = Fd.use_exn "getsockopt" fd (fun fd -> - getsockopt_int fd ipproto_ip ip_mtu_discover) - in - if intval = ip_pmtudisc_want then `Want - else if intval = ip_pmtudisc_dont then `Dont - else if intval = ip_pmtudisc_do then `Do - else if intval = ip_pmtudisc_probe then `Probe - else failwith (Printf.sprintf "Unknown IP_MTU_DISCOVER value: %d" intval) + with_fd_get fd (fun fd -> getsockopt_int fd ipproto_ip ip_mtu) + | IP_MTU_DISCOVER -> begin + let i = with_fd_get fd (fun fd -> getsockopt_int fd ipproto_ip ip_mtu_discover) in + match i with + | 0 (* IP_PMTUDISC_DONT *) -> `Dont + | 1 (* IP_PMTUDISC_WANT *) -> `Want + | 2 (* IP_PMTUDISC_DO *) -> `Do + | 3 (* IP_PMTUDISC_PROBE *) -> `Probe + | i -> failwith (Printf.sprintf "Unknown IP_MTU_DISCOVER value: %d" i) end | _ -> Eio_unix.Net.Sockopt.get fd opt end diff --git a/lib_eio_linux/low_level.mli b/lib_eio_linux/low_level.mli index 8675240f9..32cd9a23b 100644 --- a/lib_eio_linux/low_level.mli +++ b/lib_eio_linux/low_level.mli @@ -266,6 +266,10 @@ module Sockopt : sig - [`Do]: Always do Path MTU Discovery (reject large datagrams with EMSGSIZE) - [`Probe]: Set DF but ignore Path MTU (for diagnostic tools) *) + val pp : 'a Eio.Net.Sockopt.t -> Format.formatter -> 'a -> unit + (** [pp opt f v] formats socket option [opt] with value [v] to formatter [f]. + Handles both Linux-specific and standard socket options. *) + val set : fd -> 'a Eio.Net.Sockopt.t -> 'a -> unit (** [set fd opt v] sets socket option [opt] to value [v] on file descriptor [fd]. *) From b98d61130cae3871d3e4b891311e93ae4051463f Mon Sep 17 00:00:00 2001 From: Anil Madhavapeddy Date: Mon, 20 Oct 2025 14:58:51 +0000 Subject: [PATCH 4/4] add a Eio_unix.Net.Sockopt.pp as well --- lib_eio/unix/net.ml | 23 +++++++++++++++++++++++ lib_eio/unix/net.mli | 4 ++++ lib_eio_linux/low_level.ml | 2 +- 3 files changed, 28 insertions(+), 1 deletion(-) diff --git a/lib_eio/unix/net.ml b/lib_eio/unix/net.ml index 4071599cc..69b1e1d98 100644 --- a/lib_eio/unix/net.ml +++ b/lib_eio/unix/net.ml @@ -99,6 +99,29 @@ module Sockopt = struct | Unix_optint : Unix.socket_optint_option -> int option Eio.Net.Sockopt.t | Unix_float : Unix.socket_float_option -> float Eio.Net.Sockopt.t + let pp : type a. a Eio.Net.Sockopt.t -> Format.formatter -> a -> unit = fun opt f v -> + (match opt with + | Unix_bool Unix.SO_DEBUG -> Fmt.pf f "Unix.SO_DEBUG = %b" v + | Unix_bool Unix.SO_BROADCAST -> Fmt.pf f "Unix.SO_BROADCAST = %b" v + | Unix_bool Unix.SO_REUSEADDR -> Fmt.pf f "Unix.SO_REUSEADDR = %b" v + | Unix_bool Unix.SO_KEEPALIVE -> Fmt.pf f "Unix.SO_KEEPALIVE = %b" v + | Unix_bool Unix.SO_DONTROUTE -> Fmt.pf f "Unix.SO_DONTROUTE = %b" v + | Unix_bool Unix.SO_OOBINLINE -> Fmt.pf f "Unix.SO_OOBINLINE = %b" v + | Unix_bool Unix.SO_ACCEPTCONN -> Fmt.pf f "Unix.SO_ACCEPTCONN = %b" v + | Unix_bool Unix.TCP_NODELAY -> Fmt.pf f "Unix.TCP_NODELAY = %b" v + | Unix_bool Unix.IPV6_ONLY -> Fmt.pf f "Unix.IPV6_ONLY = %b" v + | Unix_bool Unix.SO_REUSEPORT -> Fmt.pf f "Unix.SO_REUSEPORT = %b" v + | Unix_int Unix.SO_SNDBUF -> Fmt.pf f "Unix.SO_SNDBUF = %d" v + | Unix_int Unix.SO_RCVBUF -> Fmt.pf f "Unix.SO_RCVBUF = %d" v + | Unix_int Unix.SO_ERROR -> Fmt.pf f "Unix.SO_ERROR = %d" v + | Unix_int Unix.SO_TYPE -> Fmt.pf f "Unix.SO_TYPE = %d" v + | Unix_int Unix.SO_RCVLOWAT -> Fmt.pf f "Unix.SO_RCVLOWAT = %d" v + | Unix_int Unix.SO_SNDLOWAT -> Fmt.pf f "Unix.SO_SNDLOWAT = %d" v + | Unix_optint Unix.SO_LINGER -> Fmt.(pf f "Unix.SO_LINGER = %a" (option ~none:(any "") int) v) + | Unix_float Unix.SO_RCVTIMEO -> Fmt.pf f "Unix.SO_RCVTIMEO = %f" v + | Unix_float Unix.SO_SNDTIMEO -> Fmt.pf f "Unix.SO_SNDTIMEO = %f" v + | _ -> Eio.Net.Sockopt.pp opt f v) [@alert "-deprecated"] + let set : type a. Fd.t -> a Eio.Net.Sockopt.t -> a -> unit = fun fd opt v -> Fd.use_exn "setsockopt" fd @@ fun fd -> match opt with diff --git a/lib_eio/unix/net.mli b/lib_eio/unix/net.mli index 8863df2d2..ab8bcea50 100644 --- a/lib_eio/unix/net.mli +++ b/lib_eio/unix/net.mli @@ -116,6 +116,10 @@ module Sockopt : sig | Unix_float : Unix.socket_float_option -> float Eio.Net.Sockopt.t (** Wrap any Unix float socket option *) + val pp : 'a Eio.Net.Sockopt.t -> Format.formatter -> 'a -> unit + (** [pp opt f v] formats socket option [opt] with value [v] to formatter [f]. + Handles Unix-specific socket options with a [Unix] prefix to distinguish them from native Eio options. *) + val set : Fd.t -> 'a Eio.Net.Sockopt.t -> 'a -> unit (** [set fd opt v] sets socket option [opt] to value [v] on file descriptor [fd]. diff --git a/lib_eio_linux/low_level.ml b/lib_eio_linux/low_level.ml index b1d1bc2ef..7e772dd07 100644 --- a/lib_eio_linux/low_level.ml +++ b/lib_eio_linux/low_level.ml @@ -708,7 +708,7 @@ module Sockopt = struct | `Probe -> "Probe" in Fmt.pf f "IP_MTU_DISCOVER = %s" s - | _ -> Eio.Net.Sockopt.pp opt f v + | _ -> Eio_unix.Net.Sockopt.pp opt f v let with_fd_set fd fn = Fd.use_exn "setsockopt" fd fn