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

move on_msg_{nick,user} around, take set_mode out of welcome

This commit is contained in:
tali 2024-01-22 12:30:26 -05:00
parent 39de7303d2
commit 6824f95a6f
1 changed files with 91 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

184
lib/server/connection.ml
View File

@ -76,63 +76,53 @@ let modeunknownflag = "501", ["Didn't understand MODE command"]
let usersdontmatch_set = "502", ["Can't change mode for other users"]
let usersdontmatch_get = "502", ["Can't view mode for other users"]
(* user registration *)
let require_registered t : User.t result =
match t.user with
| Some me -> Ok me
| None -> Error notregistered
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;
let me = User.make ~userinfo ~outbox:t.outbox in
begin match User.set_nick me nick ~router:t.router with
| `nick_in_use -> Error (nicknameinuse nick)
| `nick_set ->
t.user <- Some me;
welcome t me;
Ok ()
end
| _, _ ->
Ok ()
let on_msg_nick ~welcome t nick =
let* () =
match Irc.name_type nick with
| `nick -> Ok ()
| `chan | `invalid -> Error (erroneusnickname nick)
in
match t.user with
| Some me ->
begin
let msg = Irc.Msg.make "NICK" [nick] in
match
User.set_nick me nick
~router:t.router
~success_callback:(fun () -> Router.relay msg ~from:me [`to_interested])
with
| `nick_in_use -> Error (nicknameinuse nick)
| `nick_set -> Ok ()
end
| None ->
t.pending_nick <- Some nick;
attempt_to_register t ~welcome
(* init and quit *)
let on_msg_user ~welcome t username realname =
match t.user with
| Some _me -> Error alreadyregistered
| None ->
(* TODO: configure hiding hostnames *)
let hostname = match t.addr with
| ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
| ADDR_UNIX path -> path
in
t.pending_userinfo <- Some { username; realname; hostname };
attempt_to_register t ~welcome
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 =
begin
about t me;
motd t;
end
let on_msg_motd t =
let* _me = require_registered t in
motd t;
Ok ()
let on_msg_quit t reason =
(* TODO: '''When connections are terminated by a client-sent QUIT command, servers
SHOULD prepend <reason> with the ASCII string "Quit: " when sending QUIT messages to
other clients''' *)
let reason = String.concat " " reason in
shutdown t ~reason;
Ok ()
(* messages and channels *)
@ -384,52 +374,60 @@ let on_msg_mode t name args =
let on_msg_join = on_msg_join ~set_chan_mode
(* misc *)
(* user registration *)
let about t me : unit =
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 attempt_to_register t =
match t.pending_nick, t.pending_userinfo with
| Some nick, Some userinfo ->
t.pending_nick <- None;
let me = User.make ~userinfo ~outbox:t.outbox in
begin match User.set_nick me nick ~router:t.router with
| `nick_in_use -> Error (nicknameinuse nick)
| `nick_set ->
t.user <- Some me;
welcome t me;
set_user_mode me {
add = Irc.Mode.Set.of_string initial_user_modestr;
rem = Irc.Mode.Set.empty;
};
Ok ()
end
| _, _ ->
Ok ()
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 on_msg_nick t nick =
let* () =
match Irc.name_type nick with
| `nick -> Ok ()
| `chan | `invalid -> Error (erroneusnickname nick)
in
match t.user with
| Some me ->
begin
let msg = Irc.Msg.make "NICK" [nick] in
match
User.set_nick me nick
~router:t.router
~success_callback:(fun () -> Router.relay msg ~from:me [`to_interested])
with
| `nick_in_use -> Error (nicknameinuse nick)
| `nick_set -> Ok ()
end
| None ->
t.pending_nick <- Some nick;
attempt_to_register t
let welcome t me =
about t me;
motd t;
set_user_mode me {
add = Irc.Mode.Set.of_string initial_user_modestr;
rem = Irc.Mode.Set.empty;
}
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;
Ok ()
let on_msg_quit t reason =
(* TODO: '''When connections are terminated by a client-sent QUIT command, servers
SHOULD prepend <reason> with the ASCII string "Quit: " when sending QUIT messages to
other clients''' *)
let reason = String.concat " " reason in
shutdown t ~reason;
Ok ()
let on_msg_user t username realname =
match t.user with
| Some _me -> Error alreadyregistered
| None ->
(* TODO: configure hiding hostnames *)
let hostname = match t.addr with
| ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
| ADDR_UNIX path -> path
in
t.pending_userinfo <- Some { username; realname; hostname };
attempt_to_register t
(* message parsing *)