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_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 *)
|
||||
|
|
Loading…
Reference in New Issue