fix logic for setting modes, initial mode, get mode reply

This commit is contained in:
tali 2024-01-18 12:29:36 -05:00
parent 5a355b1e45
commit 11640e4aa1
4 changed files with 88 additions and 66 deletions

View File

@ -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] |}];

View File

@ -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 = *)

View File

@ -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

View File

@ -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 ();
}