sockopt: add setsockopt() to Eio.Net.socket

lib_eio/mock/eio_mock.mli

@@ -125,9 +125,16 @@ module Net : sig
     on_getnameinfo : (string * string) Handler.t;
   >
 
+  type stream_socket = <
+    Flow.t;
+    Eio.Net.stream_socket; 
+    on_setsockopt: unit Handler.t;
+  >
+
   type listening_socket = <
     Eio.Net.listening_socket;
-    on_accept : (Flow.t * Eio.Net.Sockaddr.stream) Handler.t;
+    on_accept : (stream_socket * Eio.Net.Sockaddr.stream) Handler.t;
+    on_setsockopt: unit Handler.t;
   >
 
   val make : string -> t
@@ -149,9 +156,12 @@ module Net : sig
   val listening_socket : string -> listening_socket
   (** [listening_socket label] can be configured to provide mock connections. *)
 
+  val stream_socket : string -> stream_socket
+  (** [stream_socket label] is a mock [stream_socket]. *)
+
   val on_accept :
     listening_socket ->
-    (Flow.t * Eio.Net.Sockaddr.stream) Handler.actions ->
+    (stream_socket * Eio.Net.Sockaddr.stream) Handler.actions ->
     unit
   (** [on_accept socket actions] configures how to respond when the server calls "accept". *)
 end

lib_eio/mock/flow.ml

@@ -5,15 +5,6 @@ type copy_method = [
   | `Read_source_buffer
 ]
 
-type t = <
-  Eio.Flow.two_way;
-  Eio.Flow.close;
-  on_read : string Handler.t;
-  on_copy_bytes : int Handler.t;
-  set_copy_method : copy_method -> unit;
-  attach_to_switch : Switch.t -> unit;
->
-
 let pp_default f s =
   let rec aux i =
     let nl =
@@ -34,7 +25,7 @@ let rec takev len = function
   | x :: _ when Cstruct.length x >= len -> [Cstruct.sub x 0 len]
   | x :: xs -> x :: takev (len - Cstruct.length x) xs
 
-let make ?(pp=pp_default) label =
+class t ?(pp=pp_default) label =
   let on_read = Handler.make (`Raise End_of_file) in
   let on_copy_bytes = Handler.make (`Return 4096) in
   let copy_method = ref `Read_into in
@@ -89,7 +80,7 @@ let make ?(pp=pp_default) label =
         if not (List.exists try_rsb (Eio.Flow.read_methods src)) then
           Fmt.failwith "Source does not offer Read_source_buffer optimisation"
 
-    method set_copy_method m =
+    method set_copy_method (m: copy_method) =
       copy_method := m
 
     method shutdown cmd =
@@ -110,7 +101,9 @@ let make ?(pp=pp_default) label =
       traceln "%s: closed" label
   end
 
-let on_read (t:t) = Handler.seq t#on_read
-let on_copy_bytes (t:t) = Handler.seq t#on_copy_bytes
-let set_copy_method (t:t) = t#set_copy_method
-let attach_to_switch (t:t) = t#attach_to_switch
+let make ?(pp=pp_default) label = new t ~pp label
+
+let on_read (t:#t) = Handler.seq t#on_read
+let on_copy_bytes (t:#t) = Handler.seq t#on_copy_bytes
+let set_copy_method (t:#t) = t#set_copy_method
+let attach_to_switch (t:#t) = t#attach_to_switch

lib_eio/mock/net.ml

@@ -71,17 +71,51 @@ let on_getaddrinfo (t:t) actions = Handler.seq t#on_getaddrinfo actions
 
 let on_getnameinfo (t:t) actions = Handler.seq t#on_getnameinfo actions
 
+type stream_socket = <
+  Flow.t;
+  Eio.Net.stream_socket; 
+  on_setsockopt: unit Handler.t;
+>
+
 type listening_socket = <
   Eio.Net.listening_socket;
-  on_accept : (Flow.t * Eio.Net.Sockaddr.stream) Handler.t;
+  on_accept : (stream_socket * Eio.Net.Sockaddr.stream) Handler.t;
+  on_setsockopt: unit Handler.t;
 >
 
+let setsockopt (type a) label handler (opt: a Eio.Net.sockopt) (x : a) : unit =
+  let traceln (pp : a Fmt.t) (x: a) s = 
+    traceln "%s: setsockopt %s %a" label s pp x 
+  in
+  match opt with
+  | IPV6_ONLY     -> traceln Fmt.bool x "IPV6_ONLY"
+  | SO_ACCEPTCONN -> traceln Fmt.bool x "SO_ACCEPTCONN"
+  | SO_BROADCAST  -> traceln Fmt.bool x "SO_BROADCAST"
+  | SO_DEBUG      -> traceln Fmt.bool x "SO_DEBUG"
+  | SO_DONTROUTE  -> traceln Fmt.bool x "SO_DONTROUTE"
+  | SO_KEEPALIVE  -> traceln Fmt.bool x "SO_KEEPALIVE"
+  | SO_LINGER     -> traceln Fmt.(option int) x "SO_LINGER"
+  | SO_OOBINLINE  -> traceln Fmt.bool x "SO_OOBINLINE"
+  | SO_RCVBUF     -> traceln Fmt.int x "SO_RCVBUF"
+  | SO_RCVLOWAT   -> traceln Fmt.int x "SO_RCVLOWAT"
+  | SO_REUSEADDR  -> traceln Fmt.bool x "SO_REUSEADDR"
+  | SO_REUSEPORT  -> traceln Fmt.bool x "SO_REUSEPORT"
+  | SO_SNDBUF     -> traceln Fmt.int x "SO_SNDBUF"
+  | SO_SNDLOWAT   -> traceln Fmt.int x "SO_SNDLOWAT"
+  | SO_RCVTIMEO   -> traceln Fmt.float x "SO_RCVTIMEO"
+  | SO_SNDTIMEO   -> traceln Fmt.float x "SO_SNDTIMEO"
+  | SO_TYPE       -> traceln Fmt.int x "SO_TYPE"
+  | TCP_NODELAY   -> traceln Fmt.bool x "TCP_NODELAY"
+  ;
+  Handler.run handler
+
 let listening_socket label =
   let on_accept = Handler.make (`Raise (Failure "Mock accept handler not configured")) in
-  object
+  object (self)
     inherit Eio.Net.listening_socket
 
     method on_accept = on_accept
+    method on_setsockopt = Handler.make (`Raise (Failure "Mock setsockopt handler not configured")) 
 
     method accept ~sw =
       let socket, addr = Handler.run on_accept in
@@ -91,8 +125,20 @@ let listening_socket label =
 
     method close =
       traceln "%s: closed" label
+
+    method setsockopt = (setsockopt label self#on_setsockopt)
+  end
+
+let stream_socket label : stream_socket = object (self)
+  inherit Flow.t label
+
+  method on_setsockopt = Handler.make (`Raise (Failure "Mock setsockopt handler not configured"))
+  method setsockopt: type a. a Eio.Net.sockopt -> a -> unit =
+    fun opt x -> setsockopt label self#on_setsockopt opt x
   end
 
 let on_accept (l:listening_socket) actions =
-  let as_accept_pair x = (x :> Flow.t * Eio.Net.Sockaddr.stream) in
+  let as_accept_pair x = (x :> stream_socket * Eio.Net.Sockaddr.stream) in
   Handler.seq l#on_accept (List.map (Action.map as_accept_pair) actions)
+
+let on_setsockopt (l:listening_socket) actions = Handler.seq l#on_setsockopt actions

lib_eio/net.ml

@@ -135,12 +135,34 @@ module Sockaddr = struct
       Format.fprintf f "udp:%a:%d" Ipaddr.pp_for_uri addr port
 end
 
+type 'a sockopt =
+  | IPV6_ONLY     : bool sockopt
+  | SO_ACCEPTCONN : bool sockopt
+  | SO_BROADCAST  : bool sockopt
+  | SO_DEBUG      : bool sockopt
+  | SO_DONTROUTE  : bool sockopt
+  | SO_KEEPALIVE  : bool sockopt
+  | SO_LINGER     : int option sockopt
+  | SO_OOBINLINE  : bool sockopt
+  | SO_RCVBUF     : int sockopt
+  | SO_RCVLOWAT   : int sockopt
+  | SO_RCVTIMEO   : float sockopt
+  | SO_REUSEADDR  : bool sockopt
+  | SO_REUSEPORT  : bool sockopt
+  | SO_SNDBUF     : int sockopt
+  | SO_SNDLOWAT   : int sockopt
+  | SO_SNDTIMEO   : float sockopt
+  | SO_TYPE       : int sockopt
+  | TCP_NODELAY   : bool sockopt
+
 class virtual socket = object (_ : #Generic.t)
   method probe _ = None
+  method virtual setsockopt : 'a. 'a sockopt -> 'a -> unit
 end
 
 class virtual stream_socket = object
   inherit Flow.two_way
+  method virtual setsockopt : 'a. 'a sockopt -> 'a -> unit
 end
 
 class virtual listening_socket = object

lib_eio/net.mli

@@ -78,10 +78,35 @@ module Sockaddr : sig
   val pp : Format.formatter -> [< t] -> unit
 end
 
+(** {2 Socket Options} *)
+
+type 'a sockopt =
+  | IPV6_ONLY     : bool sockopt  (** Forbid binding an IPv6 socket to an IPv4 address *)
+  | SO_ACCEPTCONN : bool sockopt  (** Report whether socket listening is enabled *)
+  | SO_BROADCAST  : bool sockopt  (** Permit sending of broadcast messages *)
+  | SO_DEBUG      : bool sockopt  (** Record debugging information *)
+  | SO_DONTROUTE  : bool sockopt  (** Bypass the standard routing algorithms *)
+  | SO_KEEPALIVE  : bool sockopt  (** Keep connection active *)
+  | SO_LINGER     : int option sockopt (** Whether to linger on closed connections
+                                            that have data present, and for how long
+                                            (in seconds) *)
+  | SO_OOBINLINE  : bool sockopt  (** Leave out-of-band data in line *)
+  | SO_RCVBUF     : int sockopt   (** Size of received buffer *)
+  | SO_RCVLOWAT   : int sockopt   (** Minimum number of bytes to process for input operations *)
+  | SO_RCVTIMEO   : float sockopt (** Timeout for input operations *)
+  | SO_REUSEADDR  : bool sockopt  (** Allow reuse of local addresses for bind *)
+  | SO_REUSEPORT  : bool sockopt  (** Allow reuse of address and port bindings *)
+  | SO_SNDBUF     : int sockopt   (** Size of send buffer *)
+  | SO_SNDLOWAT   : int sockopt   (** Minimum number of bytes to process for output operations *)
+  | SO_SNDTIMEO   : float sockopt (** Timeout for output operations *)
+  | SO_TYPE       : int sockopt   (** Report the socket type *)
+  | TCP_NODELAY   : bool sockopt  (** Control the Nagle algorithm for TCP sockets *)
+
 (** {2 Provider Interfaces} *)
 
 class virtual socket : object
   inherit Generic.t
+   method virtual setsockopt : 'a sockopt -> 'a -> unit
 end
 
 class virtual stream_socket : object

lib_eio/unix/eio_unix.ml

@@ -11,7 +11,7 @@ type socket = <
 module Private = struct
   type _ Eio.Generic.ty += Unix_file_descr : [`Peek | `Take] -> Unix.file_descr Eio.Generic.ty
 
-  type _ Effect.t += 
+  type _ Effect.t +=
     | Await_readable : Unix.file_descr -> unit Effect.t
     | Await_writable : Unix.file_descr -> unit Effect.t
     | Get_system_clock : Eio.Time.clock Effect.t
@@ -68,3 +68,24 @@ let getnameinfo (sockaddr : Eio.Net.Sockaddr.t) =
   run_in_systhread (fun () ->
     let Unix.{ni_hostname; ni_service} = Unix.getnameinfo sockaddr options in
     (ni_hostname, ni_service))
+
+let setsockopt (type a) fd (opt: a Eio.Net.sockopt) (v: a) =
+  match opt with
+  | IPV6_ONLY     -> Unix.(setsockopt fd IPV6_ONLY v)
+  | SO_ACCEPTCONN -> Unix.(setsockopt fd SO_ACCEPTCONN v)
+  | SO_BROADCAST  -> Unix.(setsockopt fd SO_BROADCAST v)
+  | SO_DEBUG      -> Unix.(setsockopt fd SO_DEBUG v)
+  | SO_DONTROUTE  -> Unix.(setsockopt fd SO_DONTROUTE v)
+  | SO_KEEPALIVE  -> Unix.(setsockopt fd SO_KEEPALIVE v)
+  | SO_LINGER     -> Unix.(setsockopt_optint fd SO_LINGER v)
+  | SO_OOBINLINE  -> Unix.(setsockopt fd SO_OOBINLINE v)
+  | SO_RCVBUF     -> Unix.(setsockopt_int fd SO_RCVBUF v)
+  | SO_RCVLOWAT   -> Unix.(setsockopt_int fd SO_RCVLOWAT v)
+  | SO_RCVTIMEO   -> Unix.(setsockopt_float fd SO_RCVTIMEO v)
+  | SO_REUSEADDR  -> Unix.(setsockopt fd SO_REUSEADDR v)
+  | SO_REUSEPORT  -> Unix.(setsockopt fd SO_REUSEPORT v)
+  | SO_SNDBUF     -> Unix.(setsockopt_int fd SO_SNDBUF v)
+  | SO_SNDLOWAT   -> Unix.(setsockopt_int fd SO_SNDLOWAT v)
+  | SO_SNDTIMEO   -> Unix.(setsockopt_float fd SO_SNDTIMEO v)
+  | SO_TYPE       -> Unix.(setsockopt_int fd SO_TYPE v)
+  | TCP_NODELAY   -> Unix.(setsockopt fd TCP_NODELAY v)