improve server

This commit is contained in:
Simon Cruanes 2025-05-02 00:27:11 -04:00
parent c8d88e3887
commit 299dd9dddb
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
3 changed files with 13 additions and 5 deletions

View file

@ -13,7 +13,11 @@ let[@unroll 1] rec retry_read_ fd f =
match f () with match f () with
| res -> res | res -> res
| exception | exception
Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) -> Unix.Unix_error
( ( Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR | Unix.EINPROGRESS
| Unix.ECONNRESET ),
_,
_ ) ->
(* Trace_.message "read must wait"; *) (* Trace_.message "read must wait"; *)
let trigger = Picos.Trigger.create () in let trigger = Picos.Trigger.create () in
let closed_r = ref false in let closed_r = ref false in
@ -29,7 +33,11 @@ let[@unroll 1] rec retry_write_ fd f =
match f () with match f () with
| res -> res | res -> res
| exception | exception
Unix.Unix_error ((Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR), _, _) -> Unix.Unix_error
( ( Unix.EAGAIN | Unix.EWOULDBLOCK | Unix.EINTR | Unix.EINPROGRESS
| Unix.ECONNRESET ),
_,
_ ) ->
(* Trace_.message "write must wait"; *) (* Trace_.message "write must wait"; *)
let ev = get_loop_exn_ () in let ev = get_loop_exn_ () in
let trigger = Picos.Trigger.create () in let trigger = Picos.Trigger.create () in

View file

@ -8,9 +8,8 @@ type t = {
mutable running: unit Picos.Computation.t option; mutable running: unit Picos.Computation.t option;
} }
let shutdown (self : t) = let join (self : t) : unit = Option.iter Picos.Computation.await self.running
if Atomic.exchange self.active false then let shutdown (self : t) = if Atomic.exchange self.active false then ()
Option.iter Picos.Computation.await self.running
open struct open struct
let run (self : t) () : unit = let run (self : t) () : unit =

View file

@ -1,6 +1,7 @@
type client_handler = Unix.sockaddr -> IO_in.t -> IO_out.t -> unit type client_handler = Unix.sockaddr -> IO_in.t -> IO_out.t -> unit
type t type t
val join : t -> unit
val shutdown : t -> unit val shutdown : t -> unit
val establish : val establish :