move on_msg_{nick,user} around, take set_mode out of welcome
This commit is contained in:
parent
39de7303d2
commit
6824f95a6f
|
|
@ -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_set = "502", ["Can't change mode for other users"]
|
||||||
let usersdontmatch_get = "502", ["Can't view mode for other users"]
|
let usersdontmatch_get = "502", ["Can't view mode for other users"]
|
||||||
|
|
||||||
|
|
||||||
(* user registration *)
|
|
||||||
|
|
||||||
let require_registered t : User.t result =
|
let require_registered t : User.t result =
|
||||||
match t.user with
|
match t.user with
|
||||||
| Some me -> Ok me
|
| Some me -> Ok me
|
||||||
| None -> Error notregistered
|
| 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 =
|
(* init and quit *)
|
||||||
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
|
|
||||||
|
|
||||||
let on_msg_user ~welcome t username realname =
|
let about t me =
|
||||||
match t.user with
|
let who = Irc.Msg.prefix_string (User.prefix me) in
|
||||||
| Some _me -> Error alreadyregistered
|
begin
|
||||||
| None ->
|
reply t ("001", [Fmt.str "Welcome to the tali IRC network %s" who]);
|
||||||
(* TODO: configure hiding hostnames *)
|
reply t ("002", [Fmt.str "Your host is %s, running version %s" srv_host srv_ver]);
|
||||||
let hostname = match t.addr with
|
reply t ("003", [Fmt.str "This server was created %s" srv_created]);
|
||||||
| ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
|
reply t ("004", [srv_host; srv_ver; "iow"; "imnst"; "bklov"]);
|
||||||
| ADDR_UNIX path -> path
|
reply t ("005", ["CASEMAPPING=ascii";
|
||||||
in
|
"CHANTYPES=#";
|
||||||
t.pending_userinfo <- Some { username; realname; hostname };
|
"CHANMODES=b,k,l,imstn";
|
||||||
attempt_to_register t ~welcome
|
"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 *)
|
(* messages and channels *)
|
||||||
|
|
@ -384,52 +374,60 @@ let on_msg_mode t name args =
|
||||||
let on_msg_join = on_msg_join ~set_chan_mode
|
let on_msg_join = on_msg_join ~set_chan_mode
|
||||||
|
|
||||||
|
|
||||||
(* misc *)
|
(* user registration *)
|
||||||
|
|
||||||
let about t me : unit =
|
let attempt_to_register t =
|
||||||
let who = Irc.Msg.prefix_string (User.prefix me) in
|
match t.pending_nick, t.pending_userinfo with
|
||||||
begin
|
| Some nick, Some userinfo ->
|
||||||
reply t ("001", [Fmt.str "Welcome to the tali IRC network %s" who]);
|
t.pending_nick <- None;
|
||||||
reply t ("002", [Fmt.str "Your host is %s, running version %s" srv_host srv_ver]);
|
let me = User.make ~userinfo ~outbox:t.outbox in
|
||||||
reply t ("003", [Fmt.str "This server was created %s" srv_created]);
|
begin match User.set_nick me nick ~router:t.router with
|
||||||
reply t ("004", [srv_host; srv_ver; "iow"; "imnst"; "bklov"]);
|
| `nick_in_use -> Error (nicknameinuse nick)
|
||||||
reply t ("005", ["CASEMAPPING=ascii";
|
| `nick_set ->
|
||||||
"CHANTYPES=#";
|
t.user <- Some me;
|
||||||
"CHANMODES=b,k,l,imstn";
|
welcome t me;
|
||||||
"PREFIX=(ov)@+";
|
set_user_mode me {
|
||||||
"are supported by this server"]);
|
add = Irc.Mode.Set.of_string initial_user_modestr;
|
||||||
end
|
rem = Irc.Mode.Set.empty;
|
||||||
|
};
|
||||||
|
Ok ()
|
||||||
|
end
|
||||||
|
| _, _ ->
|
||||||
|
Ok ()
|
||||||
|
|
||||||
let motd t =
|
let on_msg_nick t nick =
|
||||||
begin
|
let* () =
|
||||||
reply t ("375", [Fmt.str "- %s Message of the day - " srv_host]);
|
match Irc.name_type nick with
|
||||||
List.iter (fun ln -> reply t ("372", ["- " ^ ln])) srv_motd_lines;
|
| `nick -> Ok ()
|
||||||
reply t ("376", ["End of /MOTD command"]);
|
| `chan | `invalid -> Error (erroneusnickname nick)
|
||||||
end
|
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 =
|
let on_msg_user t username realname =
|
||||||
about t me;
|
match t.user with
|
||||||
motd t;
|
| Some _me -> Error alreadyregistered
|
||||||
set_user_mode me {
|
| None ->
|
||||||
add = Irc.Mode.Set.of_string initial_user_modestr;
|
(* TODO: configure hiding hostnames *)
|
||||||
rem = Irc.Mode.Set.empty;
|
let hostname = match t.addr with
|
||||||
}
|
| ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
|
||||||
|
| ADDR_UNIX path -> path
|
||||||
let on_msg_nick = on_msg_nick ~welcome
|
in
|
||||||
let on_msg_user = on_msg_user ~welcome
|
t.pending_userinfo <- Some { username; realname; hostname };
|
||||||
|
attempt_to_register t
|
||||||
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 ()
|
|
||||||
|
|
||||||
|
|
||||||
(* message parsing *)
|
(* message parsing *)
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue