talircd/lib/server/outbox.ml

40 lines
1.1 KiB
OCaml
Raw Normal View History

open! Import
2024-01-12 02:49:48 +00:00
(* include (val Logging.sublogs logger "Outbox") *)
type t = {
2024-01-23 19:23:45 +00:00
stream : Msg.t Lwt_stream.t;
push : Msg.t option -> unit;
mutable bcc_incl : bool;
}
let make () =
let stream, push = Lwt_stream.create () in
{ stream; push; bcc_incl = false }
let stream t = t.stream
let send t msg = try t.push (Some msg) with Lwt_stream.Closed -> ()
let close t = try t.push None with Lwt_stream.Closed -> ()
2024-01-10 02:19:22 +00:00
2024-01-11 04:41:01 +00:00
module Bcc = struct
(** this module is used to send a message to a number of outboxes at once without sending
to the same destination twice. it uses a global linked list of recipients with an
intrusive bool ([outbox.bcc_incl]) to prevent enqueuing the same destination twice.
[Bcc.add a; Bcc.add b; Bcc.send_all msg;
(* sends [msg] to [a] and [b]. *)]
*)
2024-01-11 04:41:01 +00:00
let _recipients = Dllist.create ()
2024-01-11 04:41:01 +00:00
let add obx =
if not obx.bcc_incl then
let _ = Dllist.add_r obx _recipients in
obx.bcc_incl <- true
2024-01-11 04:41:01 +00:00
let rec send_all msg =
match Dllist.take_l _recipients with
| obx -> obx.bcc_incl <- false; send obx msg; send_all msg
2024-01-11 04:41:01 +00:00
| exception Dllist.Empty -> ()
end