diff --git a/lib/irc/mode.ml b/lib/irc/mode.ml index bafb130..c1a4991 100644 --- a/lib/irc/mode.ml +++ b/lib/irc/mode.ml @@ -100,13 +100,15 @@ module Set = struct } let pp_change ppf { add; rem } = - if rem = 0 then + if rem = empty then Format.fprintf ppf "+%a" pp add - else if add = 0 then + else if add = empty then Format.fprintf ppf "-%a" pp rem else Format.fprintf ppf "+%a-%a" pp add pp rem + let no_change = { add = empty; rem = empty } + let normalize t { add; rem } = let add = diff add t in let rem = inter rem t in @@ -120,6 +122,8 @@ module Parse = struct let fail fmt = Format.kasprintf (fun _ -> raise Error) fmt + type user_modes = Set.change + let parse_mode_set str ~of_char ~add ~rem ~init = let rec loop dir acc i = if i >= String.length str then acc diff --git a/lib/irc/mode.mli b/lib/irc/mode.mli index f0d8f09..a5ee4c0 100644 --- a/lib/irc/mode.mli +++ b/lib/irc/mode.mli @@ -64,19 +64,14 @@ module Set : sig val pp_change : Format.formatter -> change -> unit + val no_change : change val normalize : t -> change -> t * change end module Parse : sig exception Error - val user_modes : string -> Set.change + type user_modes = Set.change - (* type ('a, 'b) add_rem = Add of 'a | Rem of 'b *) - (* type chan_mode_set = *) - (* | A of chan_a * (string, string option) add_rem *) - (* | B of chan_b * (string, string) add_rem *) - (* | C of chan_c * (string, unit) add_rem *) - (* | D of chan_d * (unit, unit) add_rem *) - (* val chan : string -> chan_mode_set list *) + val user_modes : string -> user_modes end diff --git a/lib/server/connection.ml b/lib/server/connection.ml index 3a924f7..5e2fd22 100644 --- a/lib/server/connection.ml +++ b/lib/server/connection.ml @@ -75,6 +75,8 @@ 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"] +let usersdontmatch_set = "502", ["Can't change mode for other users"] +let usersdontmatch_get = "502", ["Can't view mode for other users"] (* user registration *) @@ -232,21 +234,28 @@ let on_msg_part t name = (* modes *) -let set_user_mode from user chg = - let mode, chg = Irc.Mode.Set.normalize (User.mode user) chg in - let modestr = Fmt.str "%a" Irc.Mode.Set.pp_change chg in - let msg = Irc.Msg.make "MODE" [User.nick user; modestr] ~always_trailing:true in - Router.relay msg ~from [`to_user user; `to_self]; - User.set_mode user mode +let set_user_mode user chg = + let mode, chg = + Irc.Mode.Set.normalize + (User.mode user) + Irc.Mode.Set.{ chg with add = remove `o chg.add (* can't set +o *) } + in + if chg <> Irc.Mode.Set.no_change then + let modestr = Fmt.str "%a" Irc.Mode.Set.pp_change chg in + let msg = Irc.Msg.make "MODE" [User.nick user; modestr] ~always_trailing:true in + begin + Router.relay msg ~from:user [`to_self]; + User.set_mode user mode; + end -let on_get_user_mode user _me = - (* TODO: only +o can get/set modes for users besides themselves *) +let on_get_user_mode user me = + let* () = if user != me then Error usersdontmatch_get else Ok () in Ok [ - "221", [Fmt.str "+%a" Irc.Mode.Set.pp (User.mode user)] + "221", [Fmt.str "+%a" Irc.Mode.Set.pp (User.mode me)] ] let on_set_user_mode user me modestr _args = - (* TODO: only +o can get/set modes for users besides themselves *) + let* () = if user != me then Error usersdontmatch_set else Ok () in let* chg = try Ok (Irc.Mode.Parse.user_modes modestr) with Irc.Mode.Parse.Error -> (* TODO: "If one or more modes sent are not implemented on the server, the server @@ -254,8 +263,7 @@ let on_set_user_mode user me modestr _args = (501) in reply along with the MODE message." *) Error modeunknownflag in - (* TODO: only +o can set +o mode *) - set_user_mode me user chg; + set_user_mode me chg; Ok () let on_get_chan_mode chan me = @@ -319,7 +327,7 @@ let motd t = let welcome t me = about t me; motd t; - set_user_mode me me { + set_user_mode me { add = Irc.Mode.Set.of_string initial_user_modestr; rem = Irc.Mode.Set.empty; }