add Eio_unix.Sockopt for setting/getting socket options

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:

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;

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

lib_eio/mock/sockopt.ml

@@ -0,0 +1,31 @@
+open Eio.Std
+
+let setsockopt : type a. string -> a Eio.Net.Sockopt.t -> a -> unit = fun label opt v ->
+  traceln "%s: setsockopt %a" label (Eio.Net.Sockopt.pp opt) v
+
+let default (type a) (opt : a Eio.Net.Sockopt.t) : a =
+  let open Eio.Net.Sockopt in
+  match opt with
+  | 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

lib_eio/mock/sockopt.mli

@@ -0,0 +1,17 @@
+(** Mock socket option helpers *)
+
+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. *)

lib_eio/net.ml

@@ -159,6 +159,50 @@ 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
+
+  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 "<none>") int) v)
+    | SO_RCVTIMEO -> Fmt.pf f "SO_RCVTIMEO = %f" v
+    | SO_SNDTIMEO -> Fmt.pf f "SO_SNDTIMEO = %f" v
+    | _ -> Fmt.pf f "<unknown>"
+end
+
 type socket_ty = [`Socket | `Close]
 type 'a socket = ([> socket_ty] as 'a) r
 
@@ -181,22 +225,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,14 +264,15 @@ 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)
     ]
 
   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 +284,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 +336,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

lib_eio/net.mli

@@ -102,6 +102,35 @@ 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 *)
+
+  val pp : 'a t -> Format.formatter -> 'a -> unit
+end
+
 (** {2 Types} *)
 
 type socket_ty = [`Socket | `Close]
@@ -127,6 +156,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 +345,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 +367,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 +380,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

lib_eio/unix/net.ml

@@ -91,3 +91,88 @@ 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 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 "<none>") 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
+    | 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