iitalics
/
talircd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implement "MODE <user>" functionality, refactor welcome message

This commit is contained in:
tali 2024-01-14 12:25:06 -05:00
parent 65fdddaac6
commit fc54fe8599
1 changed files with 87 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
lib/server/connection.ml
View File

@ -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)