iitalics
/
talircd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

split Router into Router_types + User + Chan

This commit is contained in:
tali 2024-01-21 15:04:08 -05:00
parent 7372227578
commit 39de7303d2
6 changed files with 162 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
lib/server/chan.ml Normal file
View File

@ -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

2
lib/server/connection.ml
View File

@ -1,7 +1,5 @@
open! Import
open Result_syntax
module User = Router.User
module Chan = Router.Chan
include (val Logging.sublogs logger "Connection")

5
lib/server/import.ml
View File

@ -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

164
lib/server/router.ml
View File

@ -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

38
lib/server/router_types.ml Normal file
View File

@ -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;
}

54
lib/server/user.ml Normal file
View File

@ -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 ->
()