From fc54fe85997c50b12a14d2a2a1adbd844c6e5699 Mon Sep 17 00:00:00 2001 From: tali Date: Sun, 14 Jan 2024 12:25:06 -0500 Subject: [PATCH] implement "MODE " functionality, refactor welcome message --- lib/server/connection.ml | 125 +++++++++++++++++++++++++++------------ 1 file changed, 87 insertions(+), 38 deletions(-) diff --git a/lib/server/connection.ml b/lib/server/connection.ml index d8479ee..953694e 100644 --- a/lib/server/connection.ml +++ b/lib/server/connection.ml @@ -32,7 +32,7 @@ let shutdown ?reason t = Outbox.close t.outbox -(* TODO: configure these *) +(* TODO: configure these in some centralized location *) let srv_host = "irc.tali.software" let srv_ver = "0.0.0" let srv_created = "Sun Jan 7 09:58:24 PM EST 2024" @@ -47,6 +47,8 @@ let srv_motd_lines = [ type reply = string * string list +type 'a result = ('a, reply) Result.t + let reply t (num, params) = let prefix = Irc.Msg.Server_prefix srv_host in let target = match t.user with @@ -56,29 +58,7 @@ let reply t (num, params) = Outbox.send t.outbox (Irc.Msg.make ~prefix num (target :: params)) -let welcome t me = - let who = Irc.Msg.prefix_string (User.prefix me) in - begin - reply t ("001", [Fmt.str "Welcome to the tali IRC network %s" who]); - reply t ("002", [Fmt.str "Your host is %s, running version %s" srv_host srv_ver]); - reply t ("003", [Fmt.str "This server was created %s" srv_created]); - reply t ("004", [srv_host; srv_ver; "iow"; "imnst"; "bklov"]); - reply t ("005", ["CASEMAPPING=ascii"; - "CHANTYPES=#"; - "CHANMODES=b,k,l,imstn"; - "PREFIX=(ov)@+"; - "are supported by this server"]); - end - -let motd t = - begin - reply t ("375", [Fmt.str "- %s Message of the day - " srv_host]); - List.iter (fun ln -> reply t ("372", ["- " ^ ln])) srv_motd_lines; - reply t ("376", ["End of /MOTD command"]); - end - -(* errors *) - +let tryagain cmd = "263", [cmd; "Please wait a while and try again."] let nosuchnick tgt = "401", [tgt; "No such nick/channel"] let nosuchchannel tgt = "403", [tgt; "No such channel"] let norecipient = "411", ["No recipient given (PRIVMSG)"] @@ -95,12 +75,13 @@ let alreadyregistered = "462", ["Unauthorized command (already registered)"] (* user registration *) -let require_registered t = +let require_registered t : User.t result = match t.user with | Some me -> Ok me | None -> Error notregistered -let attempt_to_register t = +let attempt_to_register ~welcome t = + (* [welcome : t -> user -> unit result] is defined near the bottom of this file *) match t.pending_nick, t.pending_userinfo with | Some nick, Some userinfo -> t.pending_nick <- None; @@ -109,17 +90,12 @@ let attempt_to_register t = | `nick_in_use -> Error (nicknameinuse nick) | `nick_set -> t.user <- Some me; - welcome t me; - motd t; - (* TODO: get "actual" user mode *) - let msg = Irc.Msg.make "MODE" [nick; "+iw"] in - Router.relay msg ~from:me `to_self; - Ok () + welcome t me end | _, _ -> Ok () -let on_msg_nick t nick = +let on_msg_nick ~welcome t nick = let* () = match Irc.name_type nick with | `nick -> Ok () @@ -139,9 +115,9 @@ let on_msg_nick t nick = end | None -> t.pending_nick <- Some nick; - attempt_to_register t + attempt_to_register t ~welcome -let on_msg_user t username realname = +let on_msg_user ~welcome t username realname = match t.user with | Some _me -> Error alreadyregistered | None -> @@ -151,7 +127,7 @@ let on_msg_user t username realname = | ADDR_UNIX path -> path in t.pending_userinfo <- Some { username; realname; hostname }; - attempt_to_register t + attempt_to_register t ~welcome (* messages and channels *) @@ -230,7 +206,7 @@ let on_msg_part t name = try match Irc.name_type name with | `chan -> Ok (Router.find_chan t.router name) - | `nick | `invalid -> Error (nosuchchannel name) + | `nick | `invalid -> raise Not_found with Not_found -> Error (nosuchchannel name) in @@ -246,8 +222,80 @@ let on_msg_part t name = Ok () +(* modes *) + +let user_get_mode user me = + let modestr = Fmt.str "+%a" Irc.Mode.Set.pp (User.mode user) in + let msg = Irc.Msg.make "MODE" [User.nick user; modestr] in + Router.relay msg ~from:me `to_self; + Ok () + +let user_set_mode user me modestr args = + let _ = me, user, modestr, args in + (* TODO *) + Error (tryagain "MODE") + +let chan_get_mode chan me = + let _ = me, chan in + (* TODO *) + Error (tryagain "MODE") + +let chan_set_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 = + 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) + | `chan -> + let c = Router.find_chan t.router name in + Ok (chan_set_mode c, chan_get_mode c) + | `invalid -> raise Not_found + with Not_found -> + Error (nosuchnick name) + in + match args with + | [] -> get me + | modestr :: args -> set me modestr args + + (* misc *) +let about t me = + let who = Irc.Msg.prefix_string (User.prefix me) in + begin + reply t ("001", [Fmt.str "Welcome to the tali IRC network %s" who]); + reply t ("002", [Fmt.str "Your host is %s, running version %s" srv_host srv_ver]); + reply t ("003", [Fmt.str "This server was created %s" srv_created]); + reply t ("004", [srv_host; srv_ver; "iow"; "imnst"; "bklov"]); + reply t ("005", ["CASEMAPPING=ascii"; + "CHANTYPES=#"; + "CHANMODES=b,k,l,imstn"; + "PREFIX=(ov)@+"; + "are supported by this server"]); + end + +let motd t = + begin + reply t ("375", [Fmt.str "- %s Message of the day - " srv_host]); + List.iter (fun ln -> reply t ("372", ["- " ^ ln])) srv_motd_lines; + reply t ("376", ["End of /MOTD command"]); + end + +let welcome t me = + about t me; + motd t; + user_get_mode me me + +let on_msg_nick = on_msg_nick ~welcome +let on_msg_user = on_msg_user ~welcome + let on_msg_motd t = let* _me = require_registered t in motd t; @@ -276,7 +324,8 @@ let dispatch t = function | "JOIN", tgt :: _ when tgt <> "" -> on_msg_join t tgt | "NAMES", tgt :: _ when tgt <> "" -> on_msg_names t tgt | "PART", tgt :: _ when tgt <> "" -> on_msg_part t tgt - | ("USER" | "JOIN" | "NAMES" | "PART") as cmd, _ -> + | "MODE", tgt :: args when tgt <> "" -> on_msg_mode t tgt args + | ("USER" | "JOIN" | "NAMES" | "PART" | "MODE") as cmd, _ -> Error (needmoreparams cmd) | cmd, _ -> Error (unknowncommand cmd)