From 39de7303d25abe5d754dbac4a8b51bae5423e033 Mon Sep 17 00:00:00 2001 From: tali Date: Sun, 21 Jan 2024 15:04:08 -0500 Subject: [PATCH] split Router into Router_types + User + Chan --- lib/server/chan.ml | 65 +++++++++++++++ lib/server/connection.ml | 2 - lib/server/import.ml | 5 -- lib/server/router.ml | 164 ++----------------------------------- lib/server/router_types.ml | 38 +++++++++ lib/server/user.ml | 54 ++++++++++++ 6 files changed, 162 insertions(+), 166 deletions(-) create mode 100644 lib/server/chan.ml create mode 100644 lib/server/router_types.ml create mode 100644 lib/server/user.ml diff --git a/lib/server/chan.ml b/lib/server/chan.ml new file mode 100644 index 0000000..4ad8570 --- /dev/null +++ b/lib/server/chan.ml @@ -0,0 +1,65 @@ +open! Import +include Router_types + +type t = chan + +let make ~name = + { + name; + name_key = string_ci name; + topic = None; + members = Dllist.create (); + chan_mode = Irc.Mode.Set.empty; + chan_limit = None; + chan_key = None; + } + +let name t = t.name +let topic t = t.topic +let mode t = t.chan_mode +let set_mode t new_mode = t.chan_mode <- new_mode +let limit t = t.chan_limit +let set_limit t n = t.chan_limit <- n +let key t = t.chan_key +let set_key t k = t.chan_key <- k + +let members chan = + Dllist.fold_r (fun m xs -> m.mem_user :: xs) chan.members [] + +let no_members t = + Dllist.is_empty t.members + +let register t ~router = + Hashtbl.replace router.channels t.name_key t + +let unregister t ~router = + Hashtbl.remove router.channels t.name_key + +let is_registered t ~router = + Hashtbl.mem router.channels t.name_key + +let is_member t user = + let is_mem m = m.mem_chan == t in + try + ignore (Dllist.find_node_l is_mem user.membership); + true + with Not_found -> + false + +let join t user = + let m = { + mem_chan = t; + mem_user = user; + mem_in_chan = None; + } in + begin + m.mem_in_chan <- Some (Dllist.add_r m t.members); + ignore (Dllist.add_r m user.membership); + end + +let part t user = + let is_mem m = m.mem_chan == t in + let mem = Dllist.find_node_l is_mem user.membership in + Option.iter Dllist.remove (Dllist.get mem).mem_in_chan; + Dllist.remove mem + diff --git a/lib/server/connection.ml b/lib/server/connection.ml index 34ffa1f..f8d2ea7 100644 --- a/lib/server/connection.ml +++ b/lib/server/connection.ml @@ -1,7 +1,5 @@ open! Import open Result_syntax -module User = Router.User -module Chan = Router.Chan include (val Logging.sublogs logger "Connection") diff --git a/lib/server/import.ml b/lib/server/import.ml index 404e355..15d4945 100644 --- a/lib/server/import.ml +++ b/lib/server/import.ml @@ -7,11 +7,6 @@ let pp_sockaddr ppf = function | Unix.ADDR_INET (adr, port) -> Fmt.pf ppf "%s:%d" (Unix.string_of_inet_addr adr) port | Unix.ADDR_UNIX path -> Fmt.string ppf path -type string_ci = Case_insensitive of string [@@unboxed] -let pp_string_ci ppf (Case_insensitive s) = Fmt.string ppf s -let string_ci s = Case_insensitive (String.lowercase_ascii s) -let empty_string_ci = Case_insensitive "" - let defer f = Lwt.on_success (Lwt.pause ()) f diff --git a/lib/server/router.ml b/lib/server/router.ml index 80e008c..0e5bc16 100644 --- a/lib/server/router.ml +++ b/lib/server/router.ml @@ -1,39 +1,7 @@ open! Import +include Router_types -type t = { - users : (string_ci, user) Hashtbl.t; - channels : (string_ci, chan) Hashtbl.t; -} - -and user = { - outbox : Outbox.t; - userinfo : Irc.userinfo; - mutable user_mode : Irc.Mode.Set.t; - mutable nick : Irc.name; - mutable nick_key : string_ci; - mutable membership : membership Dllist.t; -} - -and chan = { - name : Irc.name; - name_key : string_ci; - mutable topic : string option; - mutable members : membership Dllist.t; - mutable chan_mode : Irc.Mode.Set.t; (* +imstn *) - mutable chan_limit : int option; (* +l *) - mutable chan_key : string option; (* +k *) - (* TODO: +b, +o, +v *) - (* TODO: creation time *) -} - -and membership = { - mem_user : user; - mem_chan : chan; - mutable mem_in_chan : membership Dllist.node option; - (* mutable mem_of_user : membership Dllist.node option; *) -} - -type router = t +type t = router let make () = { users = Hashtbl.create 4096; @@ -45,142 +13,20 @@ let find_user t nick = let find_chan t name = Hashtbl.find t.channels (string_ci name) -let user_prefix user = - Irc.Msg.User_prefix (user.nick, Some user.userinfo) - -let chan_members chan = - Dllist.fold_r (fun m xs -> m.mem_user :: xs) chan.members [] - -let user_channels user = - Dllist.fold_r (fun m xs -> m.mem_chan :: xs) user.membership [] - let relay ~(from : user) (msg : Irc.Msg.t) tgts = let msg = if msg.prefix = No_prefix then - { msg with prefix = user_prefix from } + { msg with prefix = User.prefix from } else msg in let bcc u = Outbox.Bcc.add u.outbox in let bcc_not_self u = if u != from then bcc u in - let bcc_channel c = List.iter bcc_not_self (chan_members c) in + let bcc_channel c = List.iter bcc_not_self (Chan.members c) in List.iter (function | `to_self -> bcc from | `to_user tgt -> bcc tgt | `to_chan tgt -> bcc_channel tgt - | `to_interested -> bcc from; List.iter bcc_channel (user_channels from)) + | `to_interested -> bcc from; List.iter bcc_channel (User.channels from)) tgts; Outbox.Bcc.send_all msg - -(* TODO: split out [User] and [Chan] into separate files *) - - -module User = struct - type t = user - - let make ~userinfo ~outbox = - { - outbox; - userinfo; - nick = "*"; - nick_key = empty_string_ci; - user_mode = Irc.Mode.Set.empty; - membership = Dllist.create (); - } - - let outbox t = t.outbox - let nick t = t.nick - let mode t = t.user_mode - let set_mode t new_mode = t.user_mode <- new_mode - let channels = user_channels - let prefix = user_prefix - (* let is_registered t = t.nick_key <> empty_string_ci *) - - let unregister t ~router = - Hashtbl.remove router.users t.nick_key; - t.nick_key <- empty_string_ci - - let set_nick ?(success_callback = ignore) t new_nick ~router = - let key = string_ci new_nick in - if Hashtbl.mem router.users key then - `nick_in_use - else begin - (* hack to allow broadcasting a NICK message before nick is actually changed *) - success_callback (); - unregister t ~router; - Hashtbl.add router.users key t; - t.nick <- new_nick; - t.nick_key <- key; - `nick_set - end - - let rec part_all t = - (* List.iter (fun c -> Chan.part c t) (channels t) *) - match Dllist.take_l t.membership with - | m -> - Option.iter Dllist.remove m.mem_in_chan; - part_all t - | exception Dllist.Empty -> - () -end - - -module Chan = struct - type t = chan - - let make ~name = - { - name; - name_key = string_ci name; - topic = None; - members = Dllist.create (); - chan_mode = Irc.Mode.Set.empty; - chan_limit = None; - chan_key = None; - } - - let name t = t.name - let topic t = t.topic - let members = chan_members - let no_members t = Dllist.is_empty t.members - let mode t = t.chan_mode - let set_mode t new_mode = t.chan_mode <- new_mode - let limit t = t.chan_limit - let set_limit t n = t.chan_limit <- n - let key t = t.chan_key - let set_key t k = t.chan_key <- k - - let register t ~router = - Hashtbl.replace router.channels t.name_key t - - let unregister t ~router = - Hashtbl.remove router.channels t.name_key - - let is_registered t ~router = - Hashtbl.mem router.channels t.name_key - - let is_member t user = - let is_mem m = m.mem_chan == t in - try - ignore (Dllist.find_node_l is_mem user.membership); - true - with Not_found -> - false - - let join t user = - let m = { - mem_chan = t; - mem_user = user; - mem_in_chan = None; - } in - begin - m.mem_in_chan <- Some (Dllist.add_r m t.members); - ignore (Dllist.add_r m user.membership); - end - - let part t user = - let is_mem m = m.mem_chan == t in - let mem = Dllist.find_node_l is_mem user.membership in - Option.iter Dllist.remove (Dllist.get mem).mem_in_chan; - Dllist.remove mem -end diff --git a/lib/server/router_types.ml b/lib/server/router_types.ml new file mode 100644 index 0000000..3c2adac --- /dev/null +++ b/lib/server/router_types.ml @@ -0,0 +1,38 @@ +open! Import + +type string_ci = Case_insensitive of string [@@unboxed] +let string_ci s = Case_insensitive (String.lowercase_ascii s) +let empty_string_ci = Case_insensitive "" + +type user = { + outbox : Outbox.t; + userinfo : Irc.userinfo; + mutable user_mode : Irc.Mode.Set.t; + mutable nick : Irc.name; + mutable nick_key : string_ci; + mutable membership : membership Dllist.t; +} + +and chan = { + name : Irc.name; + name_key : string_ci; + mutable topic : string option; + mutable members : membership Dllist.t; + mutable chan_mode : Irc.Mode.Set.t; (* +imstn *) + mutable chan_limit : int option; (* +l *) + mutable chan_key : string option; (* +k *) + (* TODO: +b, +o, +v *) + (* TODO: creation time *) +} + +and membership = { + mem_user : user; + mem_chan : chan; + mutable mem_in_chan : membership Dllist.node option; + (* mutable mem_of_user : membership Dllist.node option; *) +} + +type router = { + users : (string_ci, user) Hashtbl.t; + channels : (string_ci, chan) Hashtbl.t; +} diff --git a/lib/server/user.ml b/lib/server/user.ml new file mode 100644 index 0000000..96c77d8 --- /dev/null +++ b/lib/server/user.ml @@ -0,0 +1,54 @@ +open! Import +include Router_types + +type t = user + +let make ~userinfo ~outbox = + { + outbox; + userinfo; + nick = ""; + nick_key = empty_string_ci; + user_mode = Irc.Mode.Set.empty; + membership = Dllist.create (); + } + +let outbox t = t.outbox +let nick t = t.nick +let mode t = t.user_mode +let set_mode t new_mode = t.user_mode <- new_mode + +let prefix user = + Irc.Msg.User_prefix (user.nick, Some user.userinfo) + +let channels user = + Dllist.fold_r (fun m xs -> m.mem_chan :: xs) user.membership [] + +let register t ~router = + Hashtbl.add router.users t.nick_key t + +let unregister t ~router = + Hashtbl.remove router.users t.nick_key + +let set_nick ?(success_callback = ignore) t new_nick ~router = + let key = string_ci new_nick in + if Hashtbl.mem router.users key then + `nick_in_use + else begin + (* hack to allow broadcasting a NICK message before nick is actually changed *) + success_callback (); + unregister t ~router; + t.nick <- new_nick; + t.nick_key <- key; + register t ~router; + `nick_set + end + +let rec part_all t = + (* List.iter (fun c -> Chan.part c t) (channels t) *) + match Dllist.take_l t.membership with + | m -> + Option.iter Dllist.remove m.mem_in_chan; + part_all t + | exception Dllist.Empty -> + ()