improve mode parsing yet again, more graceful failures
This commit is contained in:
parent
3ab60bc4c0
commit
2ecef57faa
220
lib/irc/mode.ml
220
lib/irc/mode.ml
|
@ -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] |}];
|
||||
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue