diff --git a/lib/msg/dune b/lib/msg/dune new file mode 100644 index 0000000..6f5c409 --- /dev/null +++ b/lib/msg/dune @@ -0,0 +1,4 @@ +(library + (name ircd_msg) + (inline_tests) + (preprocess (pps ppx_expect ppx_deriving.show))) diff --git a/lib/msg/ircd_msg.ml b/lib/msg/ircd_msg.ml new file mode 100644 index 0000000..7c7d008 --- /dev/null +++ b/lib/msg/ircd_msg.ml @@ -0,0 +1,127 @@ +type t = { + prefix : string option; + command : string; + params : string list; + trailing : bool; +} [@@deriving show { with_path = false }] + +let rec is_params_trailing = function + | [] -> false + | [tr] -> String.contains tr ' ' + | _ :: tl -> is_params_trailing tl + +let make ?prefix ?(always_trailing = false) command params = + let trailing = always_trailing || is_params_trailing params in + { prefix; command; params; trailing } + +let write buf t = + Option.iter + (fun pre -> + Buffer.add_char buf ':'; + Buffer.add_string buf pre; + Buffer.add_char buf ' ') + t.prefix; + Buffer.add_string buf t.command; + let rec add_params = function + | [] -> () + | [tr] when t.trailing -> + Buffer.add_string buf " :"; + Buffer.add_string buf tr + | hd::tl -> + Buffer.add_char buf ' '; + Buffer.add_string buf hd; + add_params tl + in + add_params t.params; + Buffer.add_string buf "\r\n" + +exception Empty_message + +let parse str i endp = + let startswith f i = if i >= endp then false else f str.[i] in + let rec span f i = if startswith f i then span f (i + 1) else i in + let cl = function ':' -> true | _ -> false in + let sp = function ' ' -> true | _ -> false in + let nosp = function ' ' -> false | _ -> true in + + let i, prefix = + if startswith cl i then + let i_s = i + 1 in + let i_e = span nosp i_s in + let prefix = String.sub str i_s (i_e - i_s) in + i_e, Some prefix + else + i, None + in + + let i, command = + let i_s = span sp i in + if i_s >= endp then raise_notrace Empty_message; + let i_e = span nosp i_s in + let command = String.sub str i_s (i_e - i_s) |> String.uppercase_ascii in + i_e, command + in + + let rec params acc i = + let i_s = span sp i in + if i_s >= endp then + List.rev acc, false + else if startswith cl i_s then + let i_s = i_s + 1 in + let i_e = endp in + let trailing = String.sub str i_s (i_e - i_s) in + List.rev (trailing :: acc), true + else + let i_e = span nosp i_s in + let param = String.sub str i_s (i_e - i_s) in + params (param :: acc) i_e + in + + let params, always_trailing = params [] i in + make command params ?prefix ~always_trailing + +let parse ?(ofs = 0) ?(len = max_int) str = + let endp = ofs + min len (String.length str) in + try Some (parse str ofs endp) + with Empty_message -> None + +;; + +let%expect_test _ = + let print_msg_nl m = + let buf = Buffer.create 64 in + write buf m; + Printf.printf "%S\n" (Buffer.contents buf) + in + let print_parsed_msg_nl = function + | Some m -> Format.kasprintf print_string "%a\n" pp m + | None -> print_endline "empty" + in + + make "NICK" ["tali"] |> print_msg_nl; + [%expect {| "NICK tali\r\n" |}]; + + make "USER" ["milo"; "0"; "*"; "milo"] ~always_trailing:true |> print_msg_nl; + [%expect {| "USER milo 0 * :milo\r\n" |}]; + + make "001" ["tali"; "Welcome to the IRC Network"] ~prefix:"localhost" |> print_msg_nl; + [%expect {| ":localhost 001 tali :Welcome to the IRC Network\r\n" |}]; + + parse ":source usEr tali 0 * iitalics" |> print_parsed_msg_nl; + [%expect {| + { prefix = (Some "source"); command = "USER"; + params = ["tali"; "0"; "*"; "iitalics"]; trailing = false } + |}]; + + parse "PRIVMSG #lol :Hello world" |> print_parsed_msg_nl; + [%expect {| + { prefix = None; command = "PRIVMSG"; params = ["#lol"; "Hello world"]; + trailing = true } + |}]; + + parse " " |> print_parsed_msg_nl; + [%expect {| empty |}]; + + parse ":source " |> print_parsed_msg_nl; + [%expect {| empty |}]; + diff --git a/lib/msg/ircd_msg.mli b/lib/msg/ircd_msg.mli new file mode 100644 index 0000000..fdecca2 --- /dev/null +++ b/lib/msg/ircd_msg.mli @@ -0,0 +1,14 @@ +type t = { + prefix : string option; + command : string; + params : string list; + trailing : bool; +} + +val pp : Format.formatter -> t -> unit + +val make : ?prefix:string -> ?always_trailing:bool -> + string -> string list -> t + +val write : Buffer.t -> t -> unit +val parse : ?ofs:int -> ?len:int -> string -> t option