fix logic for setting modes, initial mode, get mode reply
This commit is contained in:
parent
5a355b1e45
commit
11640e4aa1
|
@ -93,6 +93,24 @@ module Set = struct
|
|||
| _ -> invalid_arg "Irc.Mode.Set.of_string"
|
||||
in
|
||||
String.fold_left (fun s c -> add (chr c) s) empty s
|
||||
|
||||
type change = {
|
||||
add : t;
|
||||
rem : t;
|
||||
}
|
||||
|
||||
let pp_change ppf { add; rem } =
|
||||
if rem = 0 then
|
||||
Format.fprintf ppf "+%a" pp add
|
||||
else if add = 0 then
|
||||
Format.fprintf ppf "-%a" pp rem
|
||||
else
|
||||
Format.fprintf ppf "+%a-%a" pp add pp rem
|
||||
|
||||
let normalize t { add; rem } =
|
||||
let add = diff add t in
|
||||
let rem = inter rem t in
|
||||
diff (union t add) rem, { add; rem }
|
||||
end
|
||||
|
||||
|
||||
|
@ -102,16 +120,6 @@ module Parse = struct
|
|||
let fail fmt =
|
||||
Format.kasprintf (fun _ -> raise Error) fmt
|
||||
|
||||
type user_mode_set = {
|
||||
add : Set.t;
|
||||
rem : Set.t;
|
||||
}
|
||||
|
||||
let pp_user_mode_set ppf { add; rem } = match add, rem with
|
||||
| _, 0 -> Format.fprintf ppf "+%a" Set.pp add
|
||||
| 0, _ -> Format.fprintf ppf "-%a" Set.pp rem
|
||||
| _, _ -> Format.fprintf ppf "+%a-%a" Set.pp add Set.pp rem
|
||||
|
||||
let parse_mode_set str ~of_char ~add ~rem ~init =
|
||||
let rec loop dir acc i =
|
||||
if i >= String.length str then acc
|
||||
|
@ -130,12 +138,12 @@ module Parse = struct
|
|||
in
|
||||
loop `none init 0
|
||||
|
||||
let user str =
|
||||
let user_modes str =
|
||||
parse_mode_set str
|
||||
~of_char:of_char_user
|
||||
~init:{ add = Set.empty; rem = Set.empty }
|
||||
~add:(fun ms m -> { add = Set.add m ms.add; rem = Set.remove m ms.rem })
|
||||
~rem:(fun ms m -> { add = Set.remove m ms.add; rem = Set.add m ms.rem })
|
||||
~init:Set.{ add = empty; rem = empty }
|
||||
~add:(fun ms m -> Set.{ add = add m ms.add; rem = remove m ms.rem })
|
||||
~rem:(fun ms m -> Set.{ add = remove m ms.add; rem = add m ms.rem })
|
||||
end
|
||||
|
||||
|
||||
|
@ -162,6 +170,7 @@ let%expect_test _ =
|
|||
|
||||
let print_set_nl s = Printf.printf "[%s]\n" (Set.to_string s) in
|
||||
let print_bool_nl b = print_endline (if b then "true" else "false") in
|
||||
let print_change_nl c = Format.printf "%a\n" Set.pp_change c in
|
||||
|
||||
print_set_nl Set.empty; [%expect {| [] |}];
|
||||
print_set_nl Set.(of_string "i"); [%expect {| [i] |}];
|
||||
|
@ -173,21 +182,21 @@ let%expect_test _ =
|
|||
print_bool_nl Set.(mem `w (of_string "wwww")); [%expect "true"];
|
||||
print_bool_nl Set.(mem `t (of_string "imnosw")); [%expect "false"];
|
||||
|
||||
let print_user_mode_set_nl um =
|
||||
Format.printf "%a\n" Parse.pp_user_mode_set um
|
||||
in
|
||||
|
||||
let expect_parse_error f =
|
||||
try f () |> ignore; print_endline "no error"
|
||||
with Parse.Error -> ()
|
||||
| e -> print_endline (Printexc.to_string e)
|
||||
in
|
||||
|
||||
print_user_mode_set_nl (Parse.user "+iw"); [%expect {| +iw |}];
|
||||
print_user_mode_set_nl (Parse.user "-wo"); [%expect {| -ow |}];
|
||||
print_user_mode_set_nl (Parse.user "+i-w"); [%expect {| +i-w |}];
|
||||
print_user_mode_set_nl (Parse.user "-i+w"); [%expect {| +w-i |}];
|
||||
print_user_mode_set_nl (Parse.user "+i-i"); [%expect {| -i |}];
|
||||
print_user_mode_set_nl (Parse.user "-o+o"); [%expect {| +o |}];
|
||||
expect_parse_error (fun () -> Parse.user "+b");
|
||||
expect_parse_error (fun () -> Parse.user "w");
|
||||
print_change_nl (Parse.user_modes "+iw"); [%expect {| +iw |}];
|
||||
print_change_nl (Parse.user_modes "-wo"); [%expect {| -ow |}];
|
||||
print_change_nl (Parse.user_modes "+i-w"); [%expect {| +i-w |}];
|
||||
print_change_nl (Parse.user_modes "-i+w"); [%expect {| +w-i |}];
|
||||
print_change_nl (Parse.user_modes "+i-i"); [%expect {| -i |}];
|
||||
print_change_nl (Parse.user_modes "-o+o"); [%expect {| +o |}];
|
||||
expect_parse_error (fun () -> Parse.user_modes "+b");
|
||||
expect_parse_error (fun () -> Parse.user_modes "w");
|
||||
|
||||
let m, c = Set.normalize (Set.of_string "iw") (Parse.user_modes "-w+io") in
|
||||
Format.printf "%a -> [%a]" Set.pp_change c Set.pp m;
|
||||
[%expect {| +o-w -> [io] |}];
|
||||
|
|
|
@ -56,19 +56,21 @@ module Set : sig
|
|||
val of_string : string -> t
|
||||
(* val to_list : t -> elt list *)
|
||||
(* val of_list : [< elt] list -> t *)
|
||||
|
||||
type change = {
|
||||
add : t;
|
||||
rem : t;
|
||||
}
|
||||
|
||||
val pp_change : Format.formatter -> change -> unit
|
||||
|
||||
val normalize : t -> change -> t * change
|
||||
end
|
||||
|
||||
module Parse : sig
|
||||
exception Error
|
||||
|
||||
type user_mode_set = {
|
||||
add : Set.t;
|
||||
rem : Set.t;
|
||||
}
|
||||
|
||||
val pp_user_mode_set : Format.formatter -> user_mode_set -> unit
|
||||
|
||||
val user : string -> user_mode_set
|
||||
val user_modes : string -> Set.change
|
||||
|
||||
(* type ('a, 'b) add_rem = Add of 'a | Rem of 'b *)
|
||||
(* type chan_mode_set = *)
|
||||
|
|
|
@ -42,6 +42,9 @@ let srv_motd_lines = [
|
|||
"meowmeowmeowmeowmeowmeow";
|
||||
]
|
||||
|
||||
let initial_user_modestr = "iw"
|
||||
(* let initial_chan_modestr = "nst" *)
|
||||
|
||||
|
||||
(* numeric replies *)
|
||||
|
||||
|
@ -91,7 +94,8 @@ let attempt_to_register ~welcome t =
|
|||
| `nick_in_use -> Error (nicknameinuse nick)
|
||||
| `nick_set ->
|
||||
t.user <- Some me;
|
||||
welcome t me
|
||||
welcome t me;
|
||||
Ok ()
|
||||
end
|
||||
| _, _ ->
|
||||
Ok ()
|
||||
|
@ -228,66 +232,70 @@ let on_msg_part t name =
|
|||
|
||||
(* modes *)
|
||||
|
||||
let user_get_mode user me =
|
||||
let modestr = Fmt.str "+%a" Irc.Mode.Set.pp (User.mode user) in
|
||||
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:me [`to_self];
|
||||
Ok ()
|
||||
Router.relay msg ~from [`to_user user; `to_self];
|
||||
User.set_mode user 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)
|
||||
let on_get_user_mode user _me =
|
||||
(* TODO: only +o can get/set modes for users besides themselves *)
|
||||
Ok [
|
||||
"221", [Fmt.str "+%a" Irc.Mode.Set.pp (User.mode user)]
|
||||
]
|
||||
|
||||
let on_set_user_mode user me modestr _args =
|
||||
(* TODO: only +o can get/set modes for users besides themselves *)
|
||||
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
|
||||
MUST apply the modes that are implemented, and then send the ERR_UMODEUNKNOWNFLAG
|
||||
(501) in reply along with the MODE message." *)
|
||||
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
|
||||
Router.relay msg ~from:me [`to_user user; `to_self];
|
||||
User.set_mode user mode;
|
||||
set_user_mode me user chg;
|
||||
Ok ()
|
||||
|
||||
let chan_get_mode chan me =
|
||||
let on_get_chan_mode chan me =
|
||||
let _ = me, chan in
|
||||
(* TODO *)
|
||||
(* If <modestring> is not given, the RPL_CHANNELMODEIS (324) numeric is returned. Servers
|
||||
MAY choose to hide sensitive information such as channel keys when sending the current
|
||||
modes. Servers MAY also return the RPL_CREATIONTIME (329) numeric following
|
||||
RPL_CHANNELMODEIS. *)
|
||||
Error (tryagain "MODE")
|
||||
|
||||
let chan_set_mode chan me modestr args =
|
||||
let on_set_chan_mode chan me modestr args =
|
||||
let _ = me, chan, modestr, args in
|
||||
(* TODO *)
|
||||
Error (tryagain "MODE")
|
||||
|
||||
let on_msg_mode t name args =
|
||||
let* me = require_registered t in
|
||||
let* set, get =
|
||||
let* on_set, on_get =
|
||||
try
|
||||
match Irc.name_type name with
|
||||
| `nick ->
|
||||
let u = Router.find_user t.router name in
|
||||
Ok (user_set_mode u, user_get_mode u)
|
||||
Ok (on_set_user_mode u, on_get_user_mode u)
|
||||
| `chan ->
|
||||
let c = Router.find_chan t.router name in
|
||||
Ok (chan_set_mode c, chan_get_mode c)
|
||||
Ok (on_set_chan_mode c, on_get_chan_mode c)
|
||||
| `invalid -> raise Not_found
|
||||
with Not_found ->
|
||||
Error (nosuchnick name)
|
||||
in
|
||||
match args with
|
||||
| [] -> get me
|
||||
| modestr :: args -> set me modestr args
|
||||
|
||||
| [] ->
|
||||
let+ rpls = on_get me in
|
||||
List.iter (reply t) rpls
|
||||
| modestr :: args ->
|
||||
on_set me modestr args
|
||||
|
||||
(* misc *)
|
||||
|
||||
let about t me =
|
||||
let about t me : unit =
|
||||
let who = Irc.Msg.prefix_string (User.prefix me) in
|
||||
begin
|
||||
reply t ("001", [Fmt.str "Welcome to the tali IRC network %s" who]);
|
||||
|
@ -311,7 +319,10 @@ let motd t =
|
|||
let welcome t me =
|
||||
about t me;
|
||||
motd t;
|
||||
user_get_mode me me
|
||||
set_user_mode me me {
|
||||
add = Irc.Mode.Set.of_string initial_user_modestr;
|
||||
rem = Irc.Mode.Set.empty;
|
||||
}
|
||||
|
||||
let on_msg_nick = on_msg_nick ~welcome
|
||||
let on_msg_user = on_msg_user ~welcome
|
||||
|
|
|
@ -83,7 +83,7 @@ module User = struct
|
|||
userinfo;
|
||||
nick = "*";
|
||||
nick_key = empty_string_ci;
|
||||
user_mode = Irc.Mode.Set.of_string "iw";
|
||||
user_mode = Irc.Mode.Set.empty;
|
||||
membership = Dllist.create ();
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue