diff --git a/lib/server/chan.ml b/lib/server/chan.ml index 8148f36..a6c38fc 100644 --- a/lib/server/chan.ml +++ b/lib/server/chan.ml @@ -34,5 +34,8 @@ let members t = let membership t = Dllist.fold_r (fun m xs -> m :: xs) t.members [] +let membership_when f t = + Dllist.fold_r (fun m xs -> if f m then m :: xs else xs) t.members [] + let no_members t = Dllist.is_empty t.members diff --git a/lib/server/connection.ml b/lib/server/connection.ml index a2272c1..c4e91eb 100644 --- a/lib/server/connection.ml +++ b/lib/server/connection.ml @@ -52,6 +52,7 @@ let reply t (num, params) = 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"] @@ -62,6 +63,7 @@ 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 chanoprivsneeded chan = "482", [chan; "You're not channel operator"] let modeunknownflag = "501", ["Didn't understand MODE command"] let usersdontmatch_set = "502", ["Can't change mode for other users"] let usersdontmatch_get = "502", ["Can't view mode for other users"] @@ -137,14 +139,22 @@ let set_member_priv ~from (mem : Router.membership) (priv : Router.priv) = Router.relay msg ~from [`to_chan chan; `to_self]; mem.mem_priv <- priv +let require_same_user user me = + if (user : User.t) == me then Ok () else Error usersdontmatch_get + +let require_chan_op chan me = + match Router.membership chan me with + | m when m.mem_priv = Operator -> Ok (* m *) () + | _ | exception Not_found -> Error (chanoprivsneeded (Chan.name chan)) + let on_get_user_mode user me = - let* () = if user != me then Error usersdontmatch_get else Ok () in + 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* () = if user == me then Ok () else Error usersdontmatch_set in + let* () = require_same_user user me in let* chg = try Ok (Mode.Parse.user_modes modestr) with Mode.Parse.Error -> (* TODO: "If one or more modes sent are not implemented on the server, the server @@ -155,7 +165,7 @@ let on_set_user_mode user me modestr _args = set_user_mode me ~add:chg.add ~rem:chg.rem; Ok [] -let on_get_chan_mode chan _me = +let on_get_chan_mode chan me = let rpls = [ ["324", [Chan.name chan; Fmt.str "+%a" Mode.Set.pp (Chan.mode chan)]]; @@ -164,10 +174,13 @@ let on_get_chan_mode chan _me = | None -> [] end; - (* TODO: only display key if priveledged enough to see it *) - _todo_validation_please []; begin match Chan.key chan with - | Some key -> ["324", [Chan.name chan; "+k"; key]] + | 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; @@ -176,14 +189,12 @@ let on_get_chan_mode chan _me = Ok (List.flatten rpls) let on_set_chan_mode chan me modestr args ~router = - (* TODO: If is given, the user sending the command MUST have appropriate - channel privileges on the target channel to change the modes given. If a user does - not have appropriate privileges to change modes on the target channel, the server - MUST NOT process the message, and ERR_CHANOPRIVSNEEDED (482) numeric is returned. *) - _todo_validation_please (); + let* () = require_chan_op chan me in let* chg = try Ok (Mode.Parse.chan_modes modestr args) with Mode.Parse.Error -> + (* TODO: ERR_INVALIDMODEPARAM (696) + " :" *) (* 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." *) @@ -193,7 +204,6 @@ let on_set_chan_mode chan me modestr args ~router = 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; - List.iter (fun (op, mode, nick) -> try @@ -240,53 +250,81 @@ let on_msg_mode t name args = (* messages and channels *) -let on_msg_privmsg t name txt = - let* me = require_registered t in - let* tgt = +let on_privmsg_chan from chan = + let cannot_send = try - match name_type name with - | `chan -> Ok (`chan (Router.find_chan t.router name)) - | _ -> Ok (`user (Router.find_user t.router name)) + 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 -> - Error (nosuchnick name) + (* 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 *) - (* TODO: check if channel is +n and user is not a member *) - (* TODO: check if channel is +m and user is not priviledged *) - (* TODO: check if channel is +b *) - _todo_validation_please (); - let name, dst = - match tgt with - | `chan c -> Chan.name c, [`to_chan c] - | `user u -> User.nick u, [`to_user u] + 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 dst; + Router.relay msg ~from:me tgts; Ok () -let list_names t chan = - let name = Chan.name chan in - let sym = if Mode.Set.mem `s (Chan.mode chan) then "@" else "=" in - let mems = +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 - (* TODO: dont list users who are +i if you are not a member w/ them *) - _todo_validation_please (); match m.mem_priv with | Normal -> nick | Voice -> "+" ^ nick | Operator -> "@" ^ nick) - (Chan.membership chan) + 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", [sym; name; nick])) mems; - reply t ("366", [Chan.name chan; "End of NAMES list"]) + 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* me = require_registered t in let* chan = try match name_type name with @@ -295,9 +333,7 @@ let on_msg_names t name = with Not_found -> Error (nosuchchannel name) in - (* TODO: check if channel is +s and user not member of channel *) - _todo_validation_please (); - list_names t chan; + list_names t me chan; Ok () let get_topic ?(reply_if_missing=true) t chan = @@ -350,7 +386,6 @@ let join t user chan = let on_msg_join t name = let* me = require_registered t in - (* TODO: keys parameter *) let* chan = try match name_type name with @@ -367,11 +402,12 @@ let on_msg_join t name = | _already_a_member -> Ok () | exception Not_found -> begin - (* TODO: check channel mode +k, +l *) + (* TODO: +k *) + (* TODO: +l *) _todo_validation_please (); join t me chan; get_topic t chan ~reply_if_missing:false; - list_names t chan; + list_names t me chan; Ok () end