91 lines
2.3 KiB
OCaml
91 lines
2.3 KiB
OCaml
open! Import
|
|
include Router_types
|
|
|
|
include (val Logging.sublogs logger "Router")
|
|
|
|
type t = router
|
|
|
|
let make ~whowas_history_len = {
|
|
users = Hashtbl.create 1024;
|
|
channels = Hashtbl.create 1024;
|
|
whowas = Cache.make whowas_history_len;
|
|
lusers = 0;
|
|
luserchannels = 0;
|
|
}
|
|
|
|
let lusers t = t.lusers
|
|
let luserchannels t = t.luserchannels
|
|
|
|
let is_nick_available t nick =
|
|
not (Hashtbl.mem t.users (string_ci nick))
|
|
|
|
let find_user t nick =
|
|
Hashtbl.find t.users (string_ci nick)
|
|
|
|
let find_chan t name =
|
|
Hashtbl.find t.channels (string_ci name)
|
|
|
|
let whowas t nick =
|
|
Cache.find_all t.whowas (string_ci nick)
|
|
|
|
let all_channels_seq t =
|
|
Hashtbl.to_seq_values t.channels
|
|
|
|
let nuke t =
|
|
begin
|
|
Hashtbl.iter (fun _ u -> Dllist.reset u.membership) t.users;
|
|
Hashtbl.iter (fun _ c -> Dllist.reset c.members) t.channels;
|
|
Hashtbl.clear t.users;
|
|
Hashtbl.clear t.channels;
|
|
t.lusers <- 0;
|
|
t.luserchannels <- 0;
|
|
end
|
|
|
|
let relay ~(from : user) (msg : Msg.t) tgts =
|
|
let msg =
|
|
if msg.prefix = No_prefix then
|
|
{ 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
|
|
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))
|
|
tgts;
|
|
Outbox.Bcc.send_all msg
|
|
|
|
let join chan user =
|
|
let mem = {
|
|
mem_chan = chan;
|
|
mem_user = user;
|
|
mem_priv = Normal;
|
|
mem_in_chan = None;
|
|
mem_in_user = None;
|
|
} in
|
|
begin
|
|
mem.mem_in_chan <- Some (Dllist.add_r mem chan.members);
|
|
mem.mem_in_user <- Some (Dllist.add_r mem user.membership);
|
|
chan.member_count <- succ chan.member_count;
|
|
mem
|
|
end
|
|
|
|
let membership chan user =
|
|
Dllist.find (fun mem -> mem.mem_chan == chan)
|
|
user.membership
|
|
|
|
let part mem =
|
|
try
|
|
Dllist.remove (Option.get mem.mem_in_user);
|
|
Dllist.remove (Option.get mem.mem_in_chan);
|
|
mem.mem_in_user <- None;
|
|
mem.mem_in_chan <- None;
|
|
mem.mem_chan.member_count <- pred mem.mem_chan.member_count;
|
|
with Invalid_argument _ ->
|
|
warn (fun m -> m "part (%S,%S): already removed"
|
|
(Chan.name mem.mem_chan) (User.nick mem.mem_user))
|