659 lines
19 KiB
OCaml
659 lines
19 KiB
OCaml
open! Import
|
|
open Result_syntax
|
|
|
|
include (val Logging.sublogs logger "Connection")
|
|
|
|
let _todo_validation_please x = x
|
|
|
|
type t = {
|
|
router : Router.t;
|
|
server_info : Server_info.t;
|
|
addr : sockaddr;
|
|
outbox : Outbox.t;
|
|
mutable user : User.t option;
|
|
mutable pending_nick : name option;
|
|
mutable pending_userinfo : userinfo option;
|
|
}
|
|
|
|
let make ~router ~server_info ~addr = {
|
|
router;
|
|
server_info;
|
|
addr;
|
|
outbox = Outbox.make ();
|
|
user = None;
|
|
pending_nick = None;
|
|
pending_userinfo = None;
|
|
}
|
|
|
|
let outbox t = t.outbox
|
|
|
|
|
|
(* numeric replies *)
|
|
|
|
type reply = string * string list
|
|
|
|
type 'a result = ('a, reply) Result.t
|
|
|
|
let list_of_errors = function
|
|
| Ok () -> []
|
|
| Error e -> [e]
|
|
|
|
let reply t (num, params) =
|
|
let prefix = Server_info.prefix t.server_info in
|
|
let target =
|
|
match t.user with
|
|
| Some me -> User.nick me
|
|
| None -> "*"
|
|
in
|
|
let always_trailing = match num with
|
|
| "332" | "353" -> true
|
|
| _ -> false
|
|
in
|
|
Outbox.send t.outbox
|
|
(Msg.make num (target :: params)
|
|
~prefix ~always_trailing)
|
|
|
|
let tryagain cmd = "263", [cmd; "Please wait a while and try again."]
|
|
let nosuchnick tgt = "401", [tgt; "No such nick/channel"]
|
|
let nosuchchannel tgt = "403", [tgt; "No such channel"]
|
|
let cannotsendtochan tgt = "404", [tgt; "Cannot send to channel"]
|
|
let norecipient = "411", ["No recipient given (PRIVMSG)"]
|
|
let notexttosend = "412", ["No text to send"]
|
|
let unknowncommand cmd = "421", [cmd; "Unknown command"]
|
|
let nonicknamegiven = "431", ["No nickname given"]
|
|
let erroneusnickname nick = "432", [nick; "Erroneus nickname"]
|
|
let nicknameinuse nick = "433", [nick; "Nickname is already in use"]
|
|
let usernotinchannel n c = "442", [n; c; "They aren't on that channel"]
|
|
let notonchannel chan = "442", [chan; "You're not on that channel"]
|
|
let notregistered = "451", ["You have not registered"]
|
|
let needmoreparams cmd = "461", [cmd; "Not enough parameters"]
|
|
let alreadyregistered = "462", ["Unauthorized command (already registered)"]
|
|
let channelisfull chan = "471", [chan; "Cannot join channel (+l)"]
|
|
let unknownmode chr = "472", [String.make 1 chr; "is an unknown mode char to me"]
|
|
let chanoprivsneeded chan = "482", [chan; "You're not channel operator"]
|
|
let umodeunknownflag = "501", ["Unknown MODE flag"]
|
|
let usersdontmatch_set = "502", ["Can't change mode for other users"]
|
|
let usersdontmatch_get = "502", ["Can't view mode for other users"]
|
|
|
|
|
|
(* permission checking *)
|
|
|
|
let require_registered t : User.t result =
|
|
match t.user with
|
|
| Some me -> Ok me
|
|
| None -> Error notregistered
|
|
|
|
let require_same_user user me =
|
|
if (user : User.t) == me then Ok () else Error usersdontmatch_get
|
|
|
|
let require_membership chan me =
|
|
match Router.membership chan me with
|
|
| mem -> Ok mem
|
|
| exception Not_found -> Error (notonchannel (Chan.name chan))
|
|
|
|
let require_chan_op (m : Router.membership) =
|
|
match m.mem_priv with
|
|
| Operator -> Ok ()
|
|
| _ -> Error (chanoprivsneeded (Chan.name m.mem_chan))
|
|
|
|
|
|
(* modes *)
|
|
|
|
let set_user_mode ?(add = Mode.Set.empty) ?(rem = Mode.Set.empty) user =
|
|
let mode, chg =
|
|
Mode.Set.normalize
|
|
(User.mode user)
|
|
{ add = Mode.Set.remove `o add; rem }
|
|
in
|
|
if chg <> Mode.Set.no_change then
|
|
let modestr = Fmt.str "%a" Mode.Set.pp_change chg in
|
|
let msg = Msg.make "MODE" [User.nick user; modestr] in
|
|
begin
|
|
Router.relay msg ~from:user [`to_self];
|
|
User.set_mode user mode;
|
|
end
|
|
|
|
let set_chan_mode ~from ?(add = Mode.Set.empty) ?(rem = Mode.Set.empty) chan =
|
|
let mode, chg =
|
|
Mode.Set.normalize
|
|
(Chan.mode chan)
|
|
{ add; rem }
|
|
in
|
|
if chg <> Mode.Set.no_change then
|
|
let modestr = Fmt.str "%a" Mode.Set.pp_change chg in
|
|
let msg = Msg.make "MODE" [Chan.name chan; modestr] in
|
|
Router.relay msg ~from [`to_chan chan; `to_self];
|
|
Chan.set_mode chan mode
|
|
|
|
let set_chan_key chan ~from chg =
|
|
let key, args = match chg with
|
|
| `set k -> Some k, ["+k"; k]
|
|
| `unset -> None, ["-k"]
|
|
in
|
|
if key <> Chan.key chan then
|
|
let always_trailing = Option.is_some key in
|
|
let msg = Msg.make "MODE" (Chan.name chan :: args) ~always_trailing in
|
|
Router.relay msg ~from [`to_chan chan; `to_self];
|
|
Chan.set_key chan key
|
|
|
|
let set_chan_limit chan ~from chg =
|
|
let limit, args = match chg with
|
|
| `set l -> Some l, ["+l"; string_of_int l]
|
|
| `unset -> None, ["-l"]
|
|
in
|
|
if limit <> Chan.limit chan then
|
|
let msg = Msg.make "MODE" (Chan.name chan :: args) in
|
|
Router.relay msg ~from [`to_chan chan; `to_self];
|
|
Chan.set_limit chan limit
|
|
|
|
let set_member_priv ~from (mem : Router.membership) (priv : Router.priv) =
|
|
let user = mem.mem_user in
|
|
let chan = mem.mem_chan in
|
|
(* let user = (mem : Router.membership).mem_user in *)
|
|
let modestr = match mem.mem_priv, priv with
|
|
| _, Voice -> "+v"
|
|
| _, Operator -> "+o"
|
|
| Voice, Normal -> "-v"
|
|
| Operator, Normal -> "-o"
|
|
| _, _ -> ""
|
|
in
|
|
if mem.mem_priv <> priv then
|
|
let msg = Msg.make "MODE" [Chan.name chan; modestr; User.nick user] in
|
|
Router.relay msg ~from [`to_chan chan; `to_self];
|
|
mem.mem_priv <- priv
|
|
|
|
let on_get_user_mode user me =
|
|
let* () = require_same_user user me in
|
|
Ok [
|
|
"221", [Fmt.str "+%a" Mode.Set.pp (User.mode me)]
|
|
]
|
|
|
|
let on_set_user_mode user me modestr _args =
|
|
let* () = require_same_user user me in
|
|
let* chg = try Ok (Mode.Parse.user_modes modestr)
|
|
with Mode.Parse.Unknown_mode _ ->
|
|
(* TODO: "If one or more modes sent are not implemented on the server, the server
|
|
MUST apply the modes that are implemented, and then send the ERR_UMODEUNKNOWNFLAG
|
|
(501) in reply along with the MODE message." *)
|
|
Error umodeunknownflag
|
|
in
|
|
set_user_mode me ~add:chg.add ~rem:chg.rem;
|
|
Ok []
|
|
|
|
let on_get_chan_mode chan me =
|
|
let rpls = [
|
|
["324", [Chan.name chan; Fmt.str "+%a" Mode.Set.pp (Chan.mode chan)]];
|
|
|
|
begin match Chan.limit chan with
|
|
| Some lim -> ["324", [Chan.name chan; "+l"; string_of_int lim]]
|
|
| None -> []
|
|
end;
|
|
|
|
begin match Chan.key chan with
|
|
| Some key ->
|
|
let key = match Router.membership chan me with
|
|
| _is_member -> key
|
|
| exception Not_found -> "*"
|
|
in
|
|
["324", [Chan.name chan; "+k"; key]]
|
|
| None -> []
|
|
end;
|
|
|
|
(* TODO: RPL_CREATIONTIME (329) *)
|
|
] in
|
|
Ok (List.flatten rpls)
|
|
|
|
let on_set_chan_mode chan me modestr args ~router =
|
|
let* chg = try Ok (Mode.Parse.chan_modes modestr args)
|
|
with
|
|
| Mode.Parse.Missing_args ->
|
|
Error (needmoreparams "MODE")
|
|
| Mode.Parse.Unknown_mode ch ->
|
|
Error (unknownmode ch)
|
|
(* TODO: ERR_INVALIDMODEPARAM (696)
|
|
"<client> <target chan/user> <mode char> <parameter> :<description>" *)
|
|
in
|
|
|
|
let* mem = require_membership chan me in
|
|
let* () = require_chan_op mem in
|
|
|
|
set_chan_mode chan ~from:me ~add:chg.chan_modes.add ~rem:chg.chan_modes.rem;
|
|
Option.iter (set_chan_key chan ~from:me) chg.chan_key;
|
|
Option.iter (set_chan_limit chan ~from:me) chg.chan_limit;
|
|
|
|
(* TODO: MODE <chan> +b *)
|
|
|
|
let results =
|
|
List.map
|
|
(fun (dir, mode, nick) ->
|
|
let* user = try Ok (Router.find_user router nick)
|
|
with Not_found -> Error (nosuchnick nick) in
|
|
let* mem = try Ok (Router.membership chan user)
|
|
with Not_found -> Error (usernotinchannel (User.nick user) (Chan.name chan)) in
|
|
let priv : Router.priv = match mode with
|
|
| `o -> Operator
|
|
| `v -> Voice
|
|
in
|
|
begin match dir with
|
|
| `add -> set_member_priv mem priv ~from:me
|
|
| `rem -> if mem.mem_priv = priv then set_member_priv mem Normal ~from:me
|
|
end;
|
|
Ok ())
|
|
chg.chan_privs
|
|
in
|
|
|
|
Ok (List.flat_map list_of_errors results)
|
|
|
|
let on_msg_mode t name args =
|
|
let* me = require_registered t in
|
|
let* on_set, on_get =
|
|
try
|
|
match name_type name with
|
|
| `nick ->
|
|
let u = Router.find_user t.router name in
|
|
Ok (on_set_user_mode u, on_get_user_mode u)
|
|
| `chan ->
|
|
let c = Router.find_chan t.router name in
|
|
Ok (on_set_chan_mode c ~router:t.router, on_get_chan_mode c)
|
|
| `invalid -> raise Not_found
|
|
with Not_found ->
|
|
Error (nosuchnick name)
|
|
in
|
|
let* rpls =
|
|
match args with
|
|
| [] -> on_get me
|
|
| modestr :: args -> on_set me modestr args
|
|
in
|
|
List.iter (reply t) rpls;
|
|
Ok ()
|
|
|
|
|
|
(* messages and channels *)
|
|
|
|
let on_privmsg_chan from chan =
|
|
let cannot_send =
|
|
try
|
|
let mem = Router.membership chan from in
|
|
(* check if moderated (+m) *)
|
|
if Mode.Set.mem `m (Chan.mode chan) then
|
|
mem.mem_priv < Voice
|
|
else
|
|
false
|
|
with Not_found ->
|
|
(* check if no external messages (+n) *)
|
|
Mode.Set.mem `n (Chan.mode chan)
|
|
in
|
|
if cannot_send then
|
|
Error (cannotsendtochan (Chan.name chan))
|
|
else
|
|
Ok (Chan.name chan, [`to_chan chan])
|
|
|
|
let on_privmsg_user _from user =
|
|
(* TODO: check if user is away *)
|
|
Ok (User.nick user, [`to_user user])
|
|
|
|
let on_msg_privmsg t tgt txt =
|
|
let* me = require_registered t in
|
|
let* name, tgts =
|
|
try
|
|
match name_type tgt with
|
|
| `chan -> on_privmsg_chan me (Router.find_chan t.router tgt)
|
|
| `nick -> on_privmsg_user me (Router.find_user t.router tgt)
|
|
| `invalid -> raise Not_found
|
|
with Not_found ->
|
|
Error (nosuchnick tgt)
|
|
in
|
|
let msg = Msg.make "PRIVMSG" [name; txt] ~always_trailing:true in
|
|
Router.relay msg ~from:me tgts;
|
|
Ok ()
|
|
|
|
let list_names t me chan =
|
|
let is_secret = Mode.Set.mem `s (Chan.mode chan) in
|
|
let is_invisible user = Mode.Set.mem `i (User.mode user) in
|
|
|
|
let members =
|
|
match Router.membership chan me with
|
|
| _is_member -> Chan.membership chan
|
|
| exception Not_found ->
|
|
if is_secret then
|
|
[]
|
|
else
|
|
Chan.membership_when
|
|
(fun (m : Router.membership) ->
|
|
not (is_invisible m.mem_user))
|
|
chan
|
|
in
|
|
|
|
let nicks =
|
|
List.map
|
|
(fun (m : Router.membership) ->
|
|
let nick = User.nick m.mem_user in
|
|
match m.mem_priv with
|
|
| Normal -> nick
|
|
| Voice -> "+" ^ nick
|
|
| Operator -> "@" ^ nick)
|
|
members
|
|
in
|
|
|
|
let chan_name = Chan.name chan in
|
|
let chan_sym = if is_secret then "@" else "=" in
|
|
begin
|
|
(* TODO: concat member names until message becomes too long *)
|
|
List.iter (fun nick -> reply t ("353", [chan_sym; chan_name; nick])) nicks;
|
|
reply t ("366", [chan_name; "End of NAMES list"])
|
|
end
|
|
|
|
let on_msg_names t name =
|
|
let* me = require_registered t in
|
|
let* chan =
|
|
try
|
|
match name_type name with
|
|
| `chan -> Ok (Router.find_chan t.router name)
|
|
| `nick | `invalid -> raise Not_found
|
|
with Not_found ->
|
|
Error (nosuchchannel name)
|
|
in
|
|
list_names t me chan;
|
|
Ok ()
|
|
|
|
let get_topic ?(reply_if_missing=true) t chan =
|
|
match Chan.topic chan with
|
|
| Some topic ->
|
|
reply t ("332", [Chan.name chan; topic])
|
|
(* TODO: RPL_TOPICWHOTIME ? *)
|
|
| None ->
|
|
if reply_if_missing then
|
|
reply t ("331", [Chan.name chan; "No topic is set"])
|
|
|
|
let set_topic chan topic =
|
|
Chan.set_topic chan topic
|
|
|
|
let on_msg_topic t name args =
|
|
let* me = require_registered t in
|
|
let* chan =
|
|
try
|
|
match name_type name with
|
|
| `chan -> Ok (Router.find_chan t.router name)
|
|
| `nick | `invalid -> raise Not_found
|
|
with Not_found ->
|
|
Error (nosuchchannel name)
|
|
in
|
|
let* mem = require_membership chan me in
|
|
match args with
|
|
| [] ->
|
|
get_topic t chan;
|
|
Ok ()
|
|
| args ->
|
|
let* () =
|
|
if Mode.Set.mem `t (Chan.mode chan) then require_chan_op mem
|
|
else Ok ()
|
|
in
|
|
let topic = String.concat " " args in
|
|
let msg = Msg.make "TOPIC" [Chan.name chan; topic] ~always_trailing:true in
|
|
Router.relay msg ~from:me [`to_chan chan; `to_self];
|
|
set_topic chan (if args = [""] then None else Some topic);
|
|
Ok ()
|
|
|
|
let join t user chan =
|
|
let msg = Msg.make "JOIN" [Chan.name chan] in
|
|
Router.relay msg ~from:user [`to_chan chan; `to_self];
|
|
let mem = Router.join chan user in
|
|
if not (Chan.is_registered chan ~router:t.router) then
|
|
begin
|
|
Chan.register chan ~router:t.router;
|
|
set_chan_mode chan ~from:user ~add:t.server_info.conf.init_cmode;
|
|
set_member_priv mem ~from:user Operator;
|
|
end
|
|
|
|
let on_msg_join t name =
|
|
let* me = require_registered t in
|
|
let* chan =
|
|
try
|
|
match name_type name with
|
|
| `chan -> Ok (Router.find_chan t.router name)
|
|
| `nick | `invalid ->
|
|
(* pretend malformed channel name means the channel doesn't exist and
|
|
DON'T try to make a new channel *)
|
|
Error (nosuchchannel name)
|
|
with Not_found ->
|
|
debug (fun m -> m "making new channel %S" name);
|
|
Ok (Chan.make ~name)
|
|
in
|
|
match Router.membership chan me with
|
|
| _already_a_member -> Ok ()
|
|
| exception Not_found ->
|
|
if Chan.is_full chan then
|
|
Error (channelisfull (Chan.name chan))
|
|
else begin
|
|
(* TODO: +k *)
|
|
_todo_validation_please ();
|
|
join t me chan;
|
|
get_topic t chan ~reply_if_missing:false;
|
|
list_names t me chan;
|
|
Ok ()
|
|
end
|
|
|
|
let leave t user chan ~why =
|
|
let mem = Router.membership chan user in
|
|
begin match why with
|
|
(* TODO: KICK *)
|
|
| `quit ->
|
|
(* if called from [quit], then we already relayed the QUIT message *)
|
|
()
|
|
| `part reason ->
|
|
let always_trailing = Option.is_some reason in
|
|
let reason = Option.to_list reason in
|
|
let msg = Msg.make "PART" (Chan.name chan :: reason) ~always_trailing in
|
|
Router.relay msg ~from:user [`to_chan chan; `to_self]
|
|
end;
|
|
Router.part mem;
|
|
if Chan.is_empty chan then
|
|
begin
|
|
debug (fun m -> m "recycling empty channel %S" (Chan.name chan));
|
|
Chan.unregister chan ~router:t.router;
|
|
end
|
|
|
|
let on_msg_part t name reason =
|
|
let reason = match reason with
|
|
| [] -> None
|
|
| xs -> Some (String.concat " " xs)
|
|
in
|
|
let* me = require_registered t in
|
|
let* chan =
|
|
try
|
|
match name_type name with
|
|
| `chan -> Ok (Router.find_chan t.router name)
|
|
| `nick | `invalid -> raise Not_found
|
|
with Not_found ->
|
|
Error (nosuchchannel name)
|
|
in
|
|
try
|
|
leave t me chan ~why:(`part reason);
|
|
Ok ()
|
|
with Not_found ->
|
|
Error (notonchannel name)
|
|
|
|
let on_msg_join_0 t =
|
|
(* "JOIN 0" actually means part from all joined channels *)
|
|
let* me = require_registered t in
|
|
List.iter
|
|
(leave t me ~why:(`part None))
|
|
(User.channels me);
|
|
Ok ()
|
|
|
|
|
|
(* welcome and quit *)
|
|
|
|
let motd t =
|
|
let s_hostname = t.server_info.hostname in
|
|
let s_motd = t.server_info.motd in
|
|
begin
|
|
reply t ("375", [Fmt.str "- %s Message of the day - " s_hostname]);
|
|
List.iter (fun ln -> reply t ("372", ["- " ^ ln])) s_motd;
|
|
reply t ("376", ["End of /MOTD command"]);
|
|
end
|
|
|
|
let on_msg_motd t =
|
|
let* _me = require_registered t in
|
|
motd t;
|
|
Ok ()
|
|
|
|
let welcome t me =
|
|
let whoami = Msg.prefix_string (User.prefix me) in
|
|
let s_hostname = t.server_info.hostname in
|
|
let s_version = t.server_info.version in
|
|
let s_created = t.server_info.created in
|
|
let s_conf = t.server_info.conf in
|
|
let modes l = String.of_seq (List.to_seq l |> Seq.map Mode.to_char) in
|
|
let umodes = modes s_conf.all_umodes in
|
|
let cmodes = modes s_conf.all_cmodes in
|
|
let pmodes = modes s_conf.all_pmodes in
|
|
begin
|
|
reply t ("001", [Fmt.str "Welcome to the tali IRC network %s" whoami]);
|
|
reply t ("002", [Fmt.str "Your host is %s, running version %s" s_hostname s_version]);
|
|
reply t ("003", [Fmt.str "This server was created %s" s_created]);
|
|
reply t ("004", [s_hostname; s_version; umodes; cmodes; pmodes]);
|
|
reply t ("005", s_conf.isupport @ ["are supported by this server"]);
|
|
motd t;
|
|
end
|
|
|
|
let quit t me ~reason =
|
|
begin
|
|
let msg = Msg.make "QUIT" [User.nick me; reason] ~always_trailing:true in
|
|
Router.relay msg ~from:me [`to_interested];
|
|
|
|
List.iter
|
|
(leave t me ~why:`quit)
|
|
(User.channels me);
|
|
|
|
User.unregister me ~router:t.router;
|
|
t.user <- None
|
|
end
|
|
|
|
let close ?(reason = "Client closed") t =
|
|
Option.iter (quit t ~reason) t.user;
|
|
Outbox.close t.outbox
|
|
|
|
let on_msg_quit t reason =
|
|
let reason = match reason with
|
|
| [] -> "Quit"
|
|
| xs -> String.concat " " ("Quit:" :: xs)
|
|
in
|
|
close t ~reason;
|
|
Ok ()
|
|
|
|
|
|
(* user registration *)
|
|
|
|
let attempt_to_register t =
|
|
match t.pending_nick, t.pending_userinfo with
|
|
| Some nick, Some userinfo ->
|
|
t.pending_nick <- None;
|
|
if not (Router.is_nick_available t.router nick) then
|
|
Error (nicknameinuse nick)
|
|
else
|
|
let me = User.make nick ~userinfo ~outbox:t.outbox in
|
|
User.register me ~router:t.router;
|
|
t.user <- Some me;
|
|
welcome t me;
|
|
set_user_mode me ~add:t.server_info.conf.init_umode;
|
|
Ok ()
|
|
| _, _ ->
|
|
Ok ()
|
|
|
|
let user_set_nick t me nick =
|
|
if not (Router.is_nick_available t.router nick) then
|
|
Error (nicknameinuse nick)
|
|
else
|
|
begin
|
|
let msg = Msg.make "NICK" [nick] in
|
|
Router.relay msg ~from:me [`to_interested];
|
|
User.unregister me ~router:t.router;
|
|
User.set_nick me nick;
|
|
User.register me ~router:t.router;
|
|
Ok ()
|
|
end
|
|
|
|
let on_msg_nick t nick =
|
|
let* () =
|
|
match name_type nick with
|
|
| `nick -> Ok ()
|
|
| `chan | `invalid -> Error (erroneusnickname nick)
|
|
in
|
|
match t.user with
|
|
| Some me ->
|
|
user_set_nick t me nick
|
|
| None ->
|
|
t.pending_nick <- Some nick;
|
|
attempt_to_register t
|
|
|
|
let on_msg_user t username realname =
|
|
match t.user with
|
|
| Some _me -> Error alreadyregistered
|
|
| None ->
|
|
(* TODO: configure hiding hostnames *)
|
|
let hostname = match t.addr with
|
|
| ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
|
|
| ADDR_UNIX path -> path
|
|
in
|
|
t.pending_userinfo <- Some { username; realname; hostname };
|
|
attempt_to_register t
|
|
|
|
|
|
(* message parsing *)
|
|
|
|
let dispatch t = function
|
|
| "NICK", nick :: _ when nick <> "" -> on_msg_nick t nick
|
|
| "NICK", _ -> Error nonicknamegiven
|
|
| "USER", unm :: _ :: _ :: rnm :: _ -> on_msg_user t unm rnm
|
|
| "QUIT", reason -> on_msg_quit t reason
|
|
| "MOTD", _ -> on_msg_motd t
|
|
| "PRIVMSG", ([] | "" :: _) -> Error norecipient
|
|
| "PRIVMSG", ([_] | _ :: "" :: _) -> Error notexttosend
|
|
| "PRIVMSG", tgt :: msg :: _ -> on_msg_privmsg t tgt msg
|
|
| "JOIN", tgt :: _ when tgt <> "" -> on_msg_join t tgt
|
|
| "JOIN 0", _ -> (* hack; see split_command_params *) on_msg_join_0 t
|
|
| "NAMES", tgt :: _ when tgt <> "" -> on_msg_names t tgt
|
|
| "TOPIC", tgt :: args when tgt <> "" -> on_msg_topic t tgt args
|
|
| "PART", tgt :: reason when tgt <> "" -> on_msg_part t tgt reason
|
|
| "MODE", tgt :: args when tgt <> "" -> on_msg_mode t tgt args
|
|
| ("USER" | "JOIN" | "NAMES" | "PART" | "MODE") as cmd, _ ->
|
|
Error (needmoreparams cmd)
|
|
| cmd, _ ->
|
|
Error (unknowncommand cmd)
|
|
|
|
let split_command_params cmd params =
|
|
match cmd, params with
|
|
| "JOIN", "0" :: _ ->
|
|
["JOIN 0", []]
|
|
|
|
| "JOIN", tgts :: rest
|
|
when String.contains tgts ',' ->
|
|
(* TODO: split <keys> argument as well *)
|
|
String.split_on_char ',' tgts |>
|
|
List.map (fun tgt -> "JOIN", tgt :: rest)
|
|
|
|
| ("PRIVMSG" | "NAMES" | "PART"), tgts :: rest
|
|
when String.contains tgts ',' ->
|
|
(* TODO: "JOIN" should be handled specially *)
|
|
String.split_on_char ',' tgts |>
|
|
List.map (fun tgt -> cmd, tgt :: rest)
|
|
| _ ->
|
|
[cmd, params]
|
|
|
|
let pp_args ppf (cmd, params) =
|
|
Fmt.pf ppf "@[%s@ %a@]" cmd (Fmt.list (Fmt.fmt "%S") ~sep:Fmt.sp) params
|
|
|
|
let on_msg t (msg : Msg.t) : unit =
|
|
let results =
|
|
List.map
|
|
(fun cmd ->
|
|
trace (fun m -> m "@[%a:@ %a@]" pp_sockaddr t.addr pp_args cmd);
|
|
dispatch t cmd)
|
|
(split_command_params
|
|
msg.command
|
|
msg.params)
|
|
in
|
|
List.iter (reply t)
|
|
(List.flat_map list_of_errors results)
|