diff --git a/lib/server/connection.ml b/lib/server/connection.ml index 953694e..f0f4719 100644 --- a/lib/server/connection.ml +++ b/lib/server/connection.ml @@ -71,6 +71,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 modeunknownflag = "501", ["Unknown MODE flag"] (* user registration *) @@ -226,14 +227,31 @@ let on_msg_part t name = let user_get_mode user me = let modestr = Fmt.str "+%a" Irc.Mode.Set.pp (User.mode user) in - let msg = Irc.Msg.make "MODE" [User.nick user; modestr] in + let msg = Irc.Msg.make "MODE" [User.nick user; modestr] ~always_trailing:true in Router.relay msg ~from:me `to_self; Ok () -let user_set_mode user me modestr args = - let _ = me, user, modestr, args in - (* TODO *) - Error (tryagain "MODE") +let user_set_mode user me modestr _args = + (* TODO: only +o can set modes for users besides themselves *) + let* set = try Ok (Irc.Mode.Parse.user modestr) + with Irc.Mode.Parse.Error -> + Error modeunknownflag + in + let mode = User.mode user in + (* TODO: only +o can set +o mode *) + let mode, modestr = + let open Irc.Mode.Set in + let add = diff set.add mode in + let rem = inter set.rem mode in + let mode = union mode add in + let mode = diff mode rem in + mode, Fmt.str "%a" Irc.Mode.Parse.pp_user_mode_set { add; rem } + in + let msg = Irc.Msg.make "MODE" [User.nick user; modestr] ~always_trailing:true in + (* TODO: if setting mode for user besides self, notify them too *) + Router.relay msg ~from:me `to_self; + User.set_mode user mode; + Ok () let chan_get_mode chan me = let _ = me, chan in diff --git a/lib/server/router.ml b/lib/server/router.ml index fafc840..044a6a6 100644 --- a/lib/server/router.ml +++ b/lib/server/router.ml @@ -100,6 +100,9 @@ module User = struct `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 ->