82 lines
1.9 KiB
OCaml
82 lines
1.9 KiB
OCaml
type nick_key = Nick_key of string [@@unboxed]
|
|
let nick_key n = Nick_key (String.lowercase_ascii n) (* TODO: "scandinavian" lowercase *)
|
|
let unset = Nick_key ""
|
|
|
|
type t = {
|
|
users : (nick_key, user) Hashtbl.t
|
|
(* TODO: channels *)
|
|
}
|
|
|
|
and user = {
|
|
router : t;
|
|
hostname : string;
|
|
mutable key : nick_key;
|
|
mutable nick : Irc.nick option;
|
|
mutable userinfo : Irc.userinfo option;
|
|
mutable mode : Irc.Mode.t;
|
|
inbox : Irc.Msg.t Lwt_stream.t;
|
|
push_inbox : (Irc.Msg.t option -> unit);
|
|
}
|
|
|
|
let make () =
|
|
{ users = Hashtbl.create 4096 }
|
|
|
|
let find_user t nick =
|
|
Hashtbl.find_opt t.users (nick_key nick)
|
|
|
|
module User = struct
|
|
type t = user
|
|
|
|
let make router ~hostname =
|
|
let inbox, push_inbox = Lwt_stream.create () in
|
|
{
|
|
router;
|
|
hostname;
|
|
key = unset;
|
|
nick = None;
|
|
userinfo = None;
|
|
mode = Irc.Mode.of_string "iw";
|
|
inbox; push_inbox;
|
|
}
|
|
|
|
let inbox t = t.inbox
|
|
let send t msg = try t.push_inbox (Some msg) with Lwt_stream.Closed -> ()
|
|
let close t = try t.push_inbox None with Lwt_stream.Closed -> ()
|
|
|
|
let nick t = Option.value t.nick ~default:"*"
|
|
let prefix t : Irc.Msg.prefix =
|
|
match t.nick with
|
|
| None -> No_prefix
|
|
| Some nick -> User_prefix (nick, t.userinfo, Some t.hostname)
|
|
|
|
let is_registered t = t.key <> unset
|
|
|
|
let unset_nick t =
|
|
Hashtbl.remove t.router.users t.key;
|
|
t.key <- unset
|
|
|
|
let set_nick t new_nick =
|
|
let key = nick_key new_nick in
|
|
if Hashtbl.mem t.router.users key then
|
|
`nick_in_use
|
|
else begin
|
|
((* TODO: relay NICK message *));
|
|
unset_nick t;
|
|
Hashtbl.add t.router.users key t;
|
|
t.key <- key;
|
|
`nick_set
|
|
end
|
|
|
|
let cleanup t =
|
|
(* TODO: relay QUIT message *)
|
|
close t;
|
|
unset_nick t
|
|
end
|
|
|
|
let privmsg src dst txt =
|
|
let prefix = User.prefix src in
|
|
match dst with
|
|
| `user dst ->
|
|
let msg = Irc.Msg.make "PRIVMSG" [User.nick dst; txt] ~prefix in
|
|
User.send dst msg
|