Expose listen in low-level

patricoferris · Feb 28, 2024 · 5e34c4e · 5e34c4e
1 parent ef415fb
commit 5e34c4e
Show file tree

Hide file tree

Showing 6 changed files with 71 additions and 0 deletions.
diff --git a/lib_eio/unix/net.ml b/lib_eio/unix/net.ml
@@ -30,6 +30,16 @@ let sockaddr_of_unix_datagram = function
     let host = Ipaddr.of_unix host in
     `Udp (host, port)
 
+let socket_domain_of = function
+  | `Unix _ -> Unix.PF_UNIX
+  | `UdpV4 -> Unix.PF_INET
+  | `UdpV6 -> Unix.PF_INET6
+  | `Udp (host, _)
+  | `Tcp (host, _) ->
+    Eio.Net.Ipaddr.fold host
+      ~v4:(fun _ -> Unix.PF_INET)
+      ~v6:(fun _ -> Unix.PF_INET6)
+
 let send_msg (Eio.Resource.T (t, ops)) ?(fds=[]) bufs =
   let module X = (val (Eio.Resource.get ops Pi.Stream_socket)) in
   let rec aux ~fds bufs =

diff --git a/lib_eio/unix/net.mli b/lib_eio/unix/net.mli
@@ -44,6 +44,7 @@ val fd : [> `Platform of [> `Unix] | `Socket] r -> Fd.t
 val sockaddr_to_unix : [< Eio.Net.Sockaddr.stream | Eio.Net.Sockaddr.datagram] -> Unix.sockaddr
 val sockaddr_of_unix_stream : Unix.sockaddr -> Eio.Net.Sockaddr.stream
 val sockaddr_of_unix_datagram : Unix.sockaddr -> Eio.Net.Sockaddr.datagram
+val socket_domain_of : [< Eio.Net.Sockaddr.stream | Eio.Net.Sockaddr.datagram] -> Unix.socket_domain
 
 (** Convert between Eio.Net.Ipaddr and Unix.inet_addr. *)
 module Ipaddr : sig

diff --git a/lib_eio_posix/eio_posix.ml b/lib_eio_posix/eio_posix.ml
@@ -40,3 +40,7 @@ let run main =
     method secure_random = Flow.secure_random
     method backend_id = "posix"
   end
+
+
+let flow_of_fd = Flow.of_fd
+
diff --git a/lib_eio_posix/eio_posix.mli b/lib_eio_posix/eio_posix.mli
@@ -10,3 +10,17 @@ val run : (stdenv -> 'a) -> 'a
 
 module Low_level = Low_level
 (** Low-level API for making POSIX calls directly. *)
+
+val flow_of_fd :
+  Eio_unix.Fd.t ->
+  [< `Close
+  | `File
+  | `Flow
+  | `Platform of [ `Generic | `Unix ]
+  | `R
+  | `Shutdown
+  | `Socket
+  | `Stream
+  | `Unix_fd
+  | `W ]
+  Eio.Std.r
diff --git a/lib_eio_posix/low_level.ml b/lib_eio_posix/low_level.ml
@@ -465,6 +465,41 @@ let fstatat ~buf ~follow dirfd path =
     Fd.use_exn "fstat" dirfd @@ fun dirfd ->
     fstatat_confined ~buf ~follow (Some dirfd) path
 
+let listen ~reuse_addr ~reuse_port ~backlog ~sw listen_addr =
+  let socket_type, addr =
+    match listen_addr with
+    | `Unix path         ->
+      if reuse_addr then (
+        let buf = create_stat () in
+        match fstatat ~buf ~follow:false Fs path with
+        | () -> if kind buf = `Socket then Unix.unlink path
+        | exception Unix.Unix_error (Unix.ENOENT, _, _) -> ()
+        | exception Unix.Unix_error (code, name, arg) -> raise @@ Err.wrap code name arg
+      );
+      Unix.SOCK_STREAM, Unix.ADDR_UNIX path
+    | `Tcp (host, port)  ->
+      let host = Eio_unix.Net.Ipaddr.to_unix host in
+      Unix.SOCK_STREAM, Unix.ADDR_INET (host, port)
+  in
+  let sock = socket ~sw (Eio_unix.Net.socket_domain_of listen_addr) socket_type 0 in
+  (* For Unix domain sockets, remove the path when done (except for abstract sockets). *)
+  let hook =
+    match listen_addr with
+    | `Unix path when String.length path > 0 && path.[0] <> Char.chr 0 ->
+      Switch.on_release_cancellable sw (fun () -> Unix.unlink path)
+    | `Unix _ | `Tcp _ ->
+      Switch.null_hook
+  in
+  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;
+    );
+  sock
+
 let lseek fd off cmd =
   Fd.use_exn "lseek" fd @@ fun fd ->
   let cmd =

diff --git a/lib_eio_posix/low_level.mli b/lib_eio_posix/low_level.mli
@@ -30,6 +30,13 @@ val write : fd -> bytes -> int -> int -> int
 val socket : sw:Switch.t -> Unix.socket_domain -> Unix.socket_type -> int -> fd
 val connect : fd -> Unix.sockaddr -> unit
 val accept : sw:Switch.t -> fd -> fd * Unix.sockaddr
+val listen :
+  reuse_addr:bool ->
+  reuse_port:bool ->
+  backlog:int ->
+  sw:Switch.t ->
+  Eio.Net.Sockaddr.stream ->
+  fd
 
 val shutdown : fd -> Unix.shutdown_command -> unit