From 2ecef57faae976611e8043ca90b756c130767599 Mon Sep 17 00:00:00 2001 From: tali Date: Tue, 30 Jan 2024 18:21:02 -0500 Subject: [PATCH] improve mode parsing yet again, more graceful failures --- lib/irc/mode.ml | 220 ++++++++++++++++++++------------------- lib/irc/mode.mli | 3 +- lib/server/connection.ml | 17 +-- 3 files changed, 122 insertions(+), 118 deletions(-) diff --git a/lib/irc/mode.ml b/lib/irc/mode.ml index 71a80b3..5713223 100644 --- a/lib/irc/mode.ml +++ b/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] |}]; diff --git a/lib/irc/mode.mli b/lib/irc/mode.mli index 2cba653..d7544f2 100644 --- a/lib/irc/mode.mli +++ b/lib/irc/mode.mli @@ -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 diff --git a/lib/server/connection.ml b/lib/server/connection.ml index 0d2ffb6..4daf779 100644 --- a/lib/server/connection.ml +++ b/lib/server/connection.ml @@ -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) " :" *) - (* 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