95 lines
2.8 KiB
OCaml
95 lines
2.8 KiB
OCaml
open! Import
|
|
|
|
type t = {
|
|
addr : sockaddr;
|
|
userbase : Userbase.t;
|
|
user : Userbase.user;
|
|
mutable regis : string option * (string * string) option;
|
|
outbox : Irc.Msg.t Lwt_stream.t;
|
|
push_outbox : (Irc.Msg.t option -> unit);
|
|
quit : unit Lwt_condition.t;
|
|
}
|
|
|
|
let make ~(userbase : Userbase.t) ~(addr : sockaddr) : t =
|
|
let user = Userbase.make_user () in
|
|
let regis = None, None in
|
|
let outbox, push_outbox = Lwt_stream.create () in
|
|
let quit = Lwt_condition.create () in
|
|
{ addr; userbase; user; regis; outbox; push_outbox; quit }
|
|
|
|
let quitting t = Lwt_condition.wait t.quit
|
|
let outbox t = t.outbox
|
|
let send t msg = t.push_outbox (Some msg)
|
|
|
|
let cleanup t =
|
|
Userbase.leave t.userbase t.user
|
|
|
|
(* message handlers *)
|
|
|
|
(* > user registration *)
|
|
|
|
let update_regis t nick username =
|
|
t.regis <- (nick, username);
|
|
match nick, username with
|
|
| Some nick, Some _ ->
|
|
begin match Userbase.register t.userbase ~nick ~user:t.user with
|
|
| `inuse -> `nicknameinuse nick
|
|
| `ok -> `ok
|
|
end
|
|
| _, _ ->
|
|
(* wait for remaining credentials *)
|
|
`ok
|
|
|
|
let on_nick_msg t new_nick =
|
|
(* TODO: validate nickname string *)
|
|
let _, username = t.regis in
|
|
update_regis t (Some new_nick) username
|
|
|
|
let on_user_msg t new_username _mode =
|
|
(* TODO: validate user string *)
|
|
(* TODO: validate mode string *)
|
|
match t.regis with
|
|
| nick, None ->
|
|
update_regis t nick (Some new_username)
|
|
| _, Some _ ->
|
|
`alreadyregistered
|
|
|
|
(* > misc *)
|
|
|
|
let on_quit_msg t why =
|
|
Logs.debug (fun m -> m "%a: quit: %S" pp_sockaddr t.addr (String.concat " " why));
|
|
Lwt_condition.broadcast t.quit ();
|
|
`ok
|
|
|
|
(* message transmission *)
|
|
|
|
module Rpl = struct
|
|
open Irc.Msg
|
|
let unknowncommand cmd = make "421" [cmd; "Unknown command"]
|
|
let needmoreparams cmd = make "461" [cmd; "Not enough parameters"]
|
|
let tryagain cmd = make "263" [cmd; "Please wait a while and try again."]
|
|
let alreadyregistered () = make "462" ["Unauthorized command (already registered)"]
|
|
let nicknameinuse nick = make "433" [nick; "Nickname is already in use"]
|
|
end
|
|
|
|
let on_msg t (msg : Irc.Msg.t) : unit =
|
|
Logs.debug (fun m -> m "%a: %a" pp_sockaddr t.addr Irc.Msg.pp msg);
|
|
let result =
|
|
match msg.command, msg.params with
|
|
| "NICK", new_nick :: _ ->
|
|
on_nick_msg t new_nick
|
|
| "USER", uname :: modestr :: _host :: rname :: _ ->
|
|
on_user_msg t (uname, rname) modestr
|
|
| "QUIT", why ->
|
|
on_quit_msg t why
|
|
| "NICK", _ | "USER", _ -> `needmoreparams
|
|
| _, _ -> `unknowncommand
|
|
in
|
|
match result with
|
|
| `ok -> ()
|
|
| `unknowncommand -> send t (Rpl.unknowncommand msg.command)
|
|
| `needmoreparams -> send t (Rpl.needmoreparams msg.command)
|
|
| `tryagain -> send t (Rpl.tryagain msg.command)
|
|
| `alreadyregistered -> send t (Rpl.alreadyregistered ())
|
|
| `nicknameinuse n -> send t (Rpl.nicknameinuse n)
|