improve mode parsing yet again, more graceful failures

This commit is contained in:
tali 2024-01-30 18:21:02 -05:00
parent 3ab60bc4c0
commit 2ecef57faa
3 changed files with 122 additions and 118 deletions

View File

@ -114,6 +114,11 @@ module Set = struct
let no_change = { add = empty; rem = empty }
let change dir m chg =
match dir with
| `add -> { add = add m chg.add; rem = remove m chg.rem }
| `rem -> { add = remove m chg.add; rem = add m chg.rem }
let normalize t { add; rem } =
let add = diff add t in
let rem = inter rem t in
@ -122,55 +127,34 @@ end
module Parse = struct
exception Error
exception Unknown_mode of char
exception Missing_args
let fail fmt =
Format.kasprintf (fun _ -> raise Error) fmt
let parse_mode_set str ~of_char ~add ~rem ~init =
let parse_mode_flags f str =
let rec loop dir acc i =
if i >= String.length str then acc
if i >= String.length str then List.rev acc
else match str.[i] with
| '+' -> loop `add acc (i + 1)
| '-' -> loop `rem acc (i + 1)
| _ ->
let mode = try of_char str.[i]
| ch ->
let mode = try f ch
with Invalid_argument _ ->
fail "unrecognized mode char"
raise (Unknown_mode ch)
in
match dir with
| `add -> loop dir (add acc mode) (i + 1)
| `rem -> loop dir (rem acc mode) (i + 1)
| `none -> fail "mode must start with + or -"
loop dir ((dir, mode) :: acc) (i + 1)
in
loop `none init 0
let take_string = function
| [] -> fail "expected argument"
| x :: xs -> x, xs
let take_int = function
| [] -> fail "expected argument"
| x :: xs -> try int_of_string x, xs
with Invalid_argument _ -> fail "invalid integer"
let is_valid_key = function
| "" | "*" -> false
| _ -> true
let take_key = function
| [] -> fail "expected argument"
| x :: xs when is_valid_key x -> x, xs
| _ -> fail "invalid key"
loop `add [] 0
type user_modes = Set.change
let no_user_mdoes = Set.no_change
let user_modes str =
parse_mode_set str
~of_char:of_char_user
~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 })
let parse ms (dir, m) = Set.change dir m ms in
List.fold_left
parse
no_user_mdoes
(parse_mode_flags of_char_user str)
type 'a set_or_unset = [
| `set of 'a
@ -191,75 +175,82 @@ module Parse = struct
chan_privs : (add_or_rem * priv * name) list;
}
let chan_modes_add (args, modes) = function
| `b ->
(* type A *)
(* TODO: ban *)
let args = match args with [] -> [] | _ :: args -> args in
args, modes
| `k ->
(* type B *)
let key, args = take_key args in
let chan_key = Some (`set key) in
args, { modes with chan_key }
| (`o | `v) as priv ->
(* type B *)
let nick, args = take_string args in
let chan_privs = (`add, priv, nick) :: modes.chan_privs in
args, { modes with chan_privs }
| `l ->
(* type C *)
let limit, args = take_int args in
let chan_limit = Some (`set limit) in
args, { modes with chan_limit }
| #chan_d as m ->
let chan_modes = {
Set.add = Set.add m modes.chan_modes.add;
Set.rem = Set.remove m modes.chan_modes.rem;
} in
args, { modes with chan_modes }
let chan_modes_rem (args, modes) = function
| `b ->
(* type A *)
(* TODO: ban *)
let args = match args with [] -> [] | _ :: args -> args in
args, modes
| `k ->
(* type B *)
let _key, args = take_string args in
let chan_key = Some `unset in
args, { modes with chan_key }
| `l ->
(* type C *)
let chan_limit = Some `unset in
args, { modes with chan_limit }
| (`o | `v) as priv ->
(* type B *)
let nick, args = take_string args in
let chan_privs = (`rem, priv, nick) :: modes.chan_privs in
args, { modes with chan_privs }
| #chan_d as m ->
let chan_modes = {
Set.add = Set.remove m modes.chan_modes.add;
Set.rem = Set.add m modes.chan_modes.rem;
} in
args, { modes with chan_modes }
let no_chan_modes = {
chan_modes = Set.no_change;
chan_key = None;
chan_limit = None;
chan_privs = []
}
let chan_modes str args =
let modes = {
chan_modes = Set.no_change;
chan_key = None;
chan_limit = None;
chan_privs = []
} in
let _, modes =
parse_mode_set str
~of_char:of_char_chan
~init:(args, modes)
~add:chan_modes_add
~rem:chan_modes_rem
let parse (acc, args) (dir, m) = match m, dir, args with
(* Type A: Modes that add or remove an address to or from a list. These modes MUST
always have a parameter when sent from the server to a client. A client MAY issue
this type of mode without an argument to obtain the current contents of the
list. *)
| #chan_a as m, _dir, args ->
begin match m, args with
| `b, [] -> (* TODO: show list *) acc, args
| `b, _ :: args -> (* TODO: add/rem from list *) acc, args
end
(* Type B: Modes that change a setting on a channel. These modes MUST always have a
parameter. *)
| #chan_b as m, dir, args ->
let arg, args = match args with
| [] -> raise Missing_args
| arg :: args -> arg, args
in
begin
try match m, dir, arg with
| `k, `add, k ->
if k = "" then invalid_arg "empty key";
{ acc with chan_key = Some (`set k) }, args
| `k, `rem, _k ->
{ acc with chan_key = Some `unset }, args
| (`o | `v) as priv, dir, nick ->
let chan_privs = (dir, priv, nick) :: acc.chan_privs in
{ acc with chan_privs }, args
with Invalid_argument _ ->
(* ignore invalid args (+k) *)
acc, args
end
(* Type C: Modes that change a setting on a channel. These modes MUST have a
parameter when being set, and MUST NOT have a parameter when being unset. *)
| #chan_c as m, dir, args ->
let arg, args = match dir, args with
| `add, [] -> raise Missing_args
| `add, arg :: args -> `set arg, args
| `rem, args -> `unset, args
in
begin
try match m, arg with
| `l, `set n ->
let n = int_of_string n in
if n <= 0 then invalid_arg "limit <= 0";
{ acc with chan_limit = Some (`set n) }, args
| `l, `unset ->
{ acc with chan_limit = Some `unset }, args
with Invalid_argument _ ->
(* ignore invalid args (+l) *)
acc, args
end
(* Type D: Modes that change a setting on a channel. These modes MUST NOT have a
parameter. *)
| #chan_d as m, dir, args ->
let chan_modes = Set.change dir m acc.chan_modes in
{ acc with chan_modes }, args
in
let modes, _args =
List.fold_left
parse
(no_chan_modes, args)
(parse_mode_flags of_char_chan str)
in
(* chan_privs is built in reverse order *)
{ modes with chan_privs = List.rev modes.chan_privs }
end
@ -299,20 +290,20 @@ 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 expect_parse_error f =
try f () |> ignore; print_endline "no error"
with Parse.Error -> ()
| e -> print_endline (Printexc.to_string e)
let print_parse_error f =
try f () |> ignore; print_endline "()"
with Parse.Unknown_mode c -> Printf.printf "unknown mode %c\n" c
| Parse.Missing_args -> Printf.printf "missing args\n"
in
print_change_nl (Parse.user_modes "+iw"); [%expect {| +iw |}];
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");
print_parse_error (fun () -> Parse.user_modes "+I"); [%expect {| unknown mode I |}];
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;
@ -343,12 +334,23 @@ let%expect_test _ =
print_chan_modes (Parse.chan_modes "+im-nm+s" []);
[%expect {| [+is-mn] |}];
print_chan_modes (Parse.chan_modes "+ls" ["100"]);
[%expect {| [+s +l:100] |}];
print_chan_modes (Parse.chan_modes "+ls" ["-1"]);
[%expect {| [+s] |}];
print_chan_modes (Parse.chan_modes "+l-ik+lt" ["100"; "*"; "200"]);
[%expect {| [+t-i +l:200 -k] |}];
print_chan_modes (Parse.chan_modes "+k-k+k" ["a"; "b"; "c"]);
[%expect {| [+ +k:"c"] |}];
print_parse_error (fun () -> Parse.chan_modes "+k" []);
[%expect {| missing args |}];
print_parse_error (fun () -> Parse.chan_modes "+l" []);
[%expect {| missing args |}];
print_chan_modes (Parse.chan_modes "+o+v" ["aaa"; "bbb"]);
[%expect {| [+ +o:aaa +v:bbb] |}];

View File

@ -71,7 +71,8 @@ module Set : sig
end
module Parse : sig
exception Error
exception Unknown_mode of char
exception Missing_args
type user_modes = Set.change

View File

@ -64,8 +64,9 @@ let notregistered = "451", ["You have not registered"]
let needmoreparams cmd = "461", [cmd; "Not enough parameters"]
let alreadyregistered = "462", ["Unauthorized command (already registered)"]
let channelisfull chan = "471", [chan; "Cannot join channel (+l)"]
let unknownmode chr = "472", [String.make 1 chr; "is an unknown mode char to me"]
let chanoprivsneeded chan = "482", [chan; "You're not channel operator"]
let modeunknownflag = "501", ["Didn't understand MODE command"]
let umodeunknownflag = "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"]
@ -165,11 +166,11 @@ let on_get_user_mode user me =
let on_set_user_mode user me modestr _args =
let* () = require_same_user user me in
let* chg = try Ok (Mode.Parse.user_modes modestr)
with Mode.Parse.Error ->
with Mode.Parse.Unknown_mode _ ->
(* 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
Error umodeunknownflag
in
set_user_mode me ~add:chg.add ~rem:chg.rem;
Ok []
@ -199,13 +200,13 @@ let on_get_chan_mode chan me =
let on_set_chan_mode chan me modestr args ~router =
let* chg = try Ok (Mode.Parse.chan_modes modestr args)
with Mode.Parse.Error ->
with
| Mode.Parse.Missing_args ->
Error (needmoreparams "MODE")
| Mode.Parse.Unknown_mode ch ->
Error (unknownmode ch)
(* TODO: ERR_INVALIDMODEPARAM (696)
"<client> <target chan/user> <mode char> <parameter> :<description>" *)
(* 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* mem = require_membership chan me in