talircd/lib/server/router.ml

open! Import

type t = {
  users : (string_ci, user) Hashtbl.t;
  channels : (string_ci, chan) Hashtbl.t;
}

and user = {
  outbox : Outbox.t;
  userinfo : Irc.userinfo;
  mutable 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;
}

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

let make () =
  { users = Hashtbl.create 4096;
    channels = Hashtbl.create 4096 }

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 user_prefix user =
  Irc.Msg.User_prefix (user.nick, Some user.userinfo)  

let relay ~(from : user) (msg : Irc.Msg.t) target =
  let msg = { msg with prefix = user_prefix from } in
  match target with
  | `to_self ->
    Outbox.send from.outbox msg
  | `to_user dst ->
    Outbox.send dst.outbox msg
  | `to_chan dst ->
    Dllist.iter_l (fun m -> Outbox.Bcc.incl m.mem_user.outbox) dst.members;
    Outbox.Bcc.excl from.outbox;
    Outbox.Bcc.send_all msg
  | `to_interested user ->
    Dllist.iter_l
      (fun m ->
         Dllist.iter_l
           (fun m -> Outbox.Bcc.incl m.mem_user.outbox)
           m.mem_chan.members)
      user.membership;
    Outbox.Bcc.send_all msg

module User = struct
  type t = user

  let make ~userinfo ~outbox =
    {
      outbox;
      userinfo;
      nick = "*";
      nick_key = empty_string_ci;
      mode = Irc.Mode.Set.of_list [`i; `w];
      membership = Dllist.create ();
    }

  let outbox t = t.outbox
  let nick t = t.nick
  let mode t = t.mode
  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 set_mode t new_mode =
    t.mode <- new_mode

  let rec part_all 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 ();
    }

  let name t = t.name
  let topic t = t.topic
  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 members t =
    Dllist.fold_r (fun m xs -> m.mem_user :: xs) t.members []

  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