add Eio_unix.Sockopt for setting/getting socket options

lib_eio/mock/eio_mock.mli

@@ -96,6 +96,8 @@ module Flow : sig
     on_copy_bytes : int Handler.t;
     set_copy_method : copy_method -> unit;
     attach_to_switch : Eio.Switch.t -> unit;
+    getsockopt : 'a . 'a Eio.Net.Sockopt.t -> 'a;
+    setsockopt : 'a . 'a Eio.Net.Sockopt.t -> 'a -> unit;
   >
 
   val make : ?pp:string Fmt.t -> string -> t

lib_eio/mock/flow.ml

@@ -12,6 +12,8 @@ type t = <
   on_copy_bytes : int Handler.t;
   set_copy_method : copy_method -> unit;
   attach_to_switch : Switch.t -> unit;
+  getsockopt : 'a . 'a Eio.Net.Sockopt.t -> 'a;
+  setsockopt : 'a . 'a Eio.Net.Sockopt.t -> 'a -> unit;
 >
 
 let pp_default f s =
@@ -34,6 +36,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 =
   let on_read = Handler.make (`Raise End_of_file) in
   let on_copy_bytes = Handler.make (`Return 4096) in
@@ -108,6 +111,12 @@ let make ?(pp=pp_default) label =
         Queue.take on_close ()
       done;
       traceln "%s: closed" label
+
+    method getsockopt : 'a . 'a Eio.Net.Sockopt.t -> 'a = fun _ ->
+      failwith label
+
+    method setsockopt : 'a . 'a Eio.Net.Sockopt.t -> 'a -> unit = fun _ ->
+      failwith "TODO"
   end
 
 let on_read (t:t) = Handler.seq t#on_read

lib_eio/mock/net.ml

@@ -91,6 +91,13 @@ let listening_socket label =
 
     method close =
       traceln "%s: closed" label
+
+    method getsockopt _opt =
+      traceln "%s: getsockopt" label;
+      failwith "TODO"
+
+    method setsockopt (_: _ Eio.Net.Sockopt.t) _ =
+      traceln "%s: setsockopt TODO" label
   end
 
 let on_accept (l:listening_socket) actions =

lib_eio/net.ml

@@ -157,10 +157,19 @@ module Sockaddr = struct
       Format.fprintf f "udp:%a:%d" Ipaddr.pp_for_uri addr port
 end
 
+module Sockopt = struct
+  type _ t = ..
+end
+
 class virtual socket = object (_ : <Generic.t; Generic.close; ..>)
   method probe _ = None
+  method virtual setsockopt : 'a . 'a Sockopt.t -> 'a -> unit
+  method virtual getsockopt : 'a . 'a Sockopt.t -> 'a
 end
 
+let setsockopt (s: #socket) opt v = s#setsockopt opt v
+let getsockopt (s: #socket) opt = s#getsockopt opt
+
 class virtual stream_socket = object (_ : #socket)
   inherit Flow.two_way
 end

lib_eio/net.mli

@@ -100,10 +100,17 @@ module Sockaddr : sig
   val pp : Format.formatter -> [< t] -> unit
 end
 
+(* Socket options. *)
+module Sockopt : sig
+  type _ t = ..
+end
+
 (** {2 Provider Interfaces} *)
 
 class virtual socket : object (<Generic.close; ..>)
   inherit Generic.t
+  method virtual setsockopt : 'a . 'a Sockopt.t -> 'a -> unit
+  method virtual getsockopt : 'a . 'a Sockopt.t -> 'a
 end
 
 class virtual stream_socket : object
@@ -136,6 +143,16 @@ class virtual t : object
   method virtual getnameinfo : Sockaddr.t -> (string * string)
 end
 
+(** {2 Socket options} *)
+
+val setsockopt : #socket -> 'a Sockopt.t -> 'a -> unit
+(** [setsockopt s opt v] sets the [opt] option to value [v] on socket [s].
+    See {!Eio_unix.Net.Sockopt} for common Unix socket options. *)
+
+val getsockopt : #socket -> 'a Sockopt.t -> 'a
+(** [getsockopt s opt] retrieves the [opt] option on socket [fd].
+    See {!Eio_unix.Net.Sockopt} for common Unix socket options. *)
+
 (** {2 Out-bound Connections} *)
 
 val connect : sw:Switch.t -> #t -> Sockaddr.stream -> stream_socket

lib_eio/unix/dune

@@ -4,5 +4,5 @@
  (foreign_stubs
   (language c)
   (include_dirs include)
-  (names fork_action stubs))
+  (names sockopt fork_action stubs))
  (libraries eio unix threads mtime.clock.os))

lib_eio/unix/net.ml

@@ -48,6 +48,62 @@ class virtual t = object
   method getnameinfo = getnameinfo
 end
 
+type socket_int_option =
+    EIO_TCP_CORK
+  | EIO_TCP_KEEPCNT
+  | EIO_TCP_KEEPIDLE
+  | EIO_TCP_KEEPINTVL
+  | EIO_TCP_DEFER_ACCEPT
+  | EIO_TCP_NODELAY
+
+external setsockopt_int : Unix.file_descr -> socket_int_option -> int -> unit =
+  "eio_unix_setsockopt_int"
+external getsockopt_int : Unix.file_descr -> socket_int_option -> int =
+  "eio_unix_getsockopt_int"
+
+module Sockopt = struct
+  type _ Eio.Net.Sockopt.t +=
+  | SO_KEEPALIVE : bool Eio.Net.Sockopt.t
+  | SO_REUSEADDR : bool Eio.Net.Sockopt.t
+  | SO_REUSEPORT : bool Eio.Net.Sockopt.t
+  | TCP_NODELAY : bool Eio.Net.Sockopt.t
+  | TCP_CORK : int Eio.Net.Sockopt.t
+  | TCP_KEEPCNT : int Eio.Net.Sockopt.t
+  | TCP_KEEPIDLE : int Eio.Net.Sockopt.t
+  | TCP_KEEPINTVL : int Eio.Net.Sockopt.t
+  | TCP_DEFER_ACCEPT : int Eio.Net.Sockopt.t
+
+  let set : type a . Fd.t -> a Eio.Net.Sockopt.t -> a -> unit = fun sock k v ->
+    Fd.use_exn "Sockopt.set" sock @@ fun fd ->
+    match k with
+    | TCP_CORK -> setsockopt_int fd EIO_TCP_CORK v
+    | TCP_KEEPCNT -> setsockopt_int fd EIO_TCP_KEEPCNT v
+    | TCP_KEEPIDLE -> setsockopt_int fd EIO_TCP_KEEPIDLE v
+    | TCP_KEEPINTVL -> setsockopt_int fd EIO_TCP_KEEPINTVL v
+    | TCP_DEFER_ACCEPT -> setsockopt_int fd EIO_TCP_DEFER_ACCEPT v
+    | TCP_NODELAY -> setsockopt_int fd EIO_TCP_DEFER_ACCEPT (if v then 1 else 0)
+    | SO_KEEPALIVE -> Unix.(setsockopt fd SO_KEEPALIVE v)
+    | SO_REUSEADDR -> Unix.(setsockopt fd SO_REUSEADDR v)
+    | SO_REUSEPORT -> Unix.(setsockopt fd SO_REUSEPORT v)
+    | _ -> raise (Invalid_argument "TODO pp value")
+
+  let get_descr : type a . Unix.file_descr -> a Eio.Net.Sockopt.t -> a = fun fd k ->
+    match k with
+    | TCP_CORK -> getsockopt_int fd EIO_TCP_CORK
+    | TCP_KEEPCNT -> getsockopt_int fd EIO_TCP_KEEPCNT
+    | TCP_KEEPIDLE -> getsockopt_int fd EIO_TCP_KEEPIDLE
+    | TCP_KEEPINTVL -> getsockopt_int fd EIO_TCP_KEEPINTVL
+    | TCP_DEFER_ACCEPT -> getsockopt_int fd EIO_TCP_DEFER_ACCEPT
+    | TCP_NODELAY -> getsockopt_int fd EIO_TCP_NODELAY = 1
+    | SO_KEEPALIVE -> Unix.(getsockopt fd SO_KEEPALIVE)
+    | SO_REUSEADDR -> Unix.(getsockopt fd SO_REUSEADDR)
+    | SO_REUSEPORT -> Unix.(getsockopt fd SO_REUSEPORT)
+    | _ -> raise (Invalid_argument "TODO pp value")
+
+  let get : type a . Fd.t -> a Eio.Net.Sockopt.t -> a = fun sock k ->
+    Fd.use_exn "Sockopt.get" sock (fun fd -> get_descr fd k)
+end
+
 [@@@alert "-unstable"]
 
 type _ Effect.t +=

lib_eio/unix/net.mli

@@ -76,6 +76,27 @@ 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. *)
 
+module Sockopt : sig
+  (** Socket options *)
+
+  type _ Eio.Net.Sockopt.t +=
+    SO_KEEPALIVE : bool Eio.Net.Sockopt.t
+  | SO_REUSEADDR : bool Eio.Net.Sockopt.t
+  | SO_REUSEPORT : bool Eio.Net.Sockopt.t
+  | TCP_CORK : int Eio.Net.Sockopt.t        (* TODO These are Linux-only; move to Eio_linux.Net? *)
+  | TCP_KEEPCNT : int Eio.Net.Sockopt.t
+  | TCP_KEEPIDLE : int Eio.Net.Sockopt.t
+  | TCP_KEEPINTVL : int Eio.Net.Sockopt.t
+  | TCP_DEFER_ACCEPT : int Eio.Net.Sockopt.t
+  | TCP_NODELAY : bool Eio.Net.Sockopt.t
+
+  val set : Fd.t -> 'a Eio.Net.Sockopt.t -> 'a -> unit
+  (** [set fd opt v] sets the [opt] option to value [v] on socket [fd]. *)
+
+  val get : Fd.t -> 'a Eio.Net.Sockopt.t -> 'a
+  (** [get fd opt v] retrieves the [opt] option on socket [fd]. *)
+end
+
 (** {2 Private API for backends} *)
 
 val getnameinfo : Eio.Net.Sockaddr.t -> (string * string)

lib_eio/unix/sockopt.c

@@ -0,0 +1,78 @@
+#include <stdlib.h>
+#include <unistd.h>
+
+#ifndef _WIN32
+#include <sys/socket.h>
+#endif
+
+#ifdef __linux__
+#include <netinet/in.h>
+#include <netinet/tcp.h>
+#endif
+
+#include <caml/mlvalues.h>
+#include <caml/unixsupport.h>
+#include <caml/socketaddr.h>
+
+#ifndef TCP_CORK
+#define TCP_CORK (-1)
+#endif
+
+#ifndef TCP_KEEPCNT
+#define TCP_KEEPCNT (-1)
+#endif
+
+#ifndef TCP_KEEPIDLE
+#define TCP_KEEPIDLE (-1)
+#endif
+
+#ifndef TCP_KEEPINTVL
+#define TCP_KEEPINTVL (-1)
+#endif
+
+#ifndef TCP_DEFER_ACCEPT
+#define TCP_DEFER_ACCEPT (-1)
+#endif
+
+#ifndef TCP_NODELAY
+#define TCP_NODELAY (-1)
+#endif
+
+struct socket_option {
+  int level;
+  int option;
+};
+
+/* Not exported by caml/sockaddr.h */
+CAMLexport value caml_unix_getsockopt_aux(char *, int, int, int, value);
+CAMLexport value caml_unix_setsockopt_aux(char *, int, int, int, value, value);
+
+static struct socket_option sockopt_int[] = {
+  { IPPROTO_TCP, TCP_CORK },
+  { IPPROTO_TCP, TCP_KEEPCNT },
+  { IPPROTO_TCP, TCP_KEEPIDLE },
+  { IPPROTO_TCP, TCP_KEEPINTVL },
+  { IPPROTO_TCP, TCP_DEFER_ACCEPT },
+  { IPPROTO_TCP, TCP_NODELAY },
+};
+
+CAMLprim value eio_unix_getsockopt_int(value vsocket, value voption)
+{
+  struct socket_option *opt = &(sockopt_int[Int_val(voption)]);
+  return caml_unix_getsockopt_aux("eio_unix_getsockopt_int",
+                             1, /* TYPE_INT */
+                             opt->level,
+                             opt->option,
+                             vsocket);
+}
+
+CAMLprim value eio_unix_setsockopt_int(value vsocket, value voption, value val)
+{
+  struct socket_option *opt = &(sockopt_int[Int_val(voption)]);
+  return caml_unix_setsockopt_aux("eio_unix_setsockopt_int",
+                             1, /* TYPE_INT */
+                             opt->level,
+                             opt->option,
+                             vsocket,
+                             val);
+}

lib_eio_linux/eio_linux.ml

@@ -118,6 +118,14 @@ let datagram_socket sock = object
   method recv buf =
     let addr, recv = Low_level.recv_msg sock [buf] in
     Eio_unix.Net.sockaddr_of_unix_datagram (Uring.Sockaddr.get addr), recv
+
+  method setsockopt opt v =
+    (* No uring support for sockopt yet, but will be in the future.
+       https://github.com/axboe/liburing/issues/234#issuecomment-1080605124 *)
+    Eio_unix.Net.Sockopt.set sock opt v
+
+  method getsockopt opt =
+    Eio_unix.Net.Sockopt.get sock opt
 end
 
 let flow fd =
@@ -166,6 +174,12 @@ let flow fd =
       | `Receive -> Unix.SHUTDOWN_RECEIVE
       | `Send -> Unix.SHUTDOWN_SEND
       | `All -> Unix.SHUTDOWN_ALL
+
+    method setsockopt : 'a . 'a Eio.Net.Sockopt.t -> 'a -> unit = fun opt v ->
+      Eio_unix.Net.Sockopt.set fd opt v
+
+    method getsockopt : 'a . 'a Eio.Net.Sockopt.t -> 'a = fun opt ->
+      Eio_unix.Net.Sockopt.get fd opt
   end
 
 let source fd = (flow fd :> source)
@@ -189,6 +203,9 @@ let listening_socket fd = object
   method! probe : type a. a Eio.Generic.ty -> a option = function
     | Eio_unix.Resource.FD -> Some fd
     | _ -> None
+
+  method setsockopt opt v = Eio_unix.Net.Sockopt.set fd opt v
+  method getsockopt opt = Eio_unix.Net.Sockopt.get fd opt
 end
 
 let socket_domain_of = function

lib_eio_posix/flow.ml

@@ -65,6 +65,9 @@ let shutdown fd cmd =
   | Unix.Unix_error (Unix.ENOTCONN, _, _) -> ()
   | Unix.Unix_error (code, name, arg) -> raise (Err.wrap code name arg)
 
+let setsockopt fd opt v = Eio_unix.Net.Sockopt.set fd opt v
+let getsockopt fd opt = Eio_unix.Net.Sockopt.get fd opt
+
 let of_fd fd = object (_ : <Eio_unix.Net.stream_socket; Eio.File.rw>)
   method fd = fd
 
@@ -83,6 +86,8 @@ let of_fd fd = object (_ : <Eio_unix.Net.stream_socket; Eio.File.rw>)
   method write bufs = write_bufs fd bufs
   method shutdown cmd = shutdown fd cmd
   method close = Fd.close fd
+  method setsockopt opt v = setsockopt fd opt v
+  method getsockopt opt = getsockopt fd opt
 
   method probe : type a. a Eio.Generic.ty -> a option = function
     | Eio_unix.Resource.FD -> Some fd

lib_eio_posix/net.ml

@@ -31,6 +31,9 @@ let listening_socket ~hook fd = object
   method! probe : type a. a Eio.Generic.ty -> a option = function
     | Eio_unix.Resource.FD -> Some fd
     | _ -> None
+
+  method getsockopt opt = Eio_unix.Net.Sockopt.get fd opt
+  method setsockopt opt v = Eio_unix.Net.Sockopt.set fd opt v
 end
 
 let datagram_socket sock = object
@@ -48,6 +51,9 @@ let datagram_socket sock = object
   method recv buf =
     let addr, recv = Err.run (Low_level.recv_msg sock) [| buf |] in
     Eio_unix.Net.sockaddr_of_unix_datagram addr, recv
+
+  method getsockopt opt = Eio_unix.Net.Sockopt.get sock opt
+  method setsockopt opt v = Eio_unix.Net.Sockopt.set sock opt v
 end
 
 (* https://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml *)
@@ -97,11 +103,11 @@ let listen ~reuse_addr ~reuse_port ~backlog ~sw (listen_addr : Eio.Net.Sockaddr.
     | `Unix _ | `Tcp _ ->
       Switch.null_hook
   in
+  if reuse_addr then
+    Eio_unix.Net.Sockopt.(set sock SO_REUSEADDR true);
+  if reuse_port then
+    Eio_unix.Net.Sockopt.(set sock SO_REUSEPORT true);
   Fd.use_exn "listen" sock (fun fd ->
-      if reuse_addr then
-        Unix.setsockopt fd Unix.SO_REUSEADDR true;
-      if reuse_port then
-        Unix.setsockopt fd Unix.SO_REUSEPORT true;
       Unix.bind fd addr;
       Unix.listen fd backlog;
     );
@@ -126,13 +132,9 @@ let create_datagram_socket ~reuse_addr ~reuse_port ~sw saddr =
   begin match saddr with
     | `Udp _ | `Unix _ as saddr ->
       let addr = Eio_unix.Net.sockaddr_to_unix saddr in
-      Fd.use_exn "datagram_socket" sock (fun fd ->
-          if reuse_addr then
-            Unix.setsockopt fd Unix.SO_REUSEADDR true;
-          if reuse_port then
-            Unix.setsockopt fd Unix.SO_REUSEPORT true;
-          Unix.bind fd addr
-        )
+      if reuse_addr then Eio_unix.Net.Sockopt.(set sock SO_REUSEADDR true);
+      if reuse_port then Eio_unix.Net.Sockopt.(set sock SO_REUSEPORT true);
+      Fd.use_exn "datagram_socket" sock (fun fd -> Unix.bind fd addr)
     | `UdpV4 | `UdpV6 -> ()
   end;
   (datagram_socket sock :> Eio.Net.datagram_socket)