add part; part on quit; broadcast messages
This commit is contained in:
parent
17e3739cfe
commit
d17e573e41
|
@ -21,8 +21,15 @@ let make ~(router : Router.t) ~(addr : sockaddr) : t =
|
|||
|
||||
let outbox t = t.outbox
|
||||
|
||||
let shutdown t =
|
||||
User.quit t.user ~router:t.router;
|
||||
let shutdown ?reason t =
|
||||
if User.is_registered t.user then begin
|
||||
(* TODO: relay to everyone interested *)
|
||||
let reason = Option.value reason ~default:"Goot bye" in
|
||||
Router.relay (Irc.Msg.make "QUIT" [reason])
|
||||
~from:t.user (`to_interested t.user);
|
||||
User.part_all t.user;
|
||||
User.unregister t.user ~router:t.router;
|
||||
end;
|
||||
Outbox.close t.outbox
|
||||
|
||||
(* message handling *)
|
||||
|
@ -53,11 +60,13 @@ let on_msg_nick t nick =
|
|||
if Irc.name_type nick <> `nick then
|
||||
(if nick = "" then `nonicknamegiven else `erroneusnickname nick)
|
||||
else if User.is_registered t.user then
|
||||
match User.set_nick t.user nick ~router:t.router with
|
||||
let success_callback () =
|
||||
let msg = Irc.Msg.make "NICK" [nick] in
|
||||
Router.relay msg ~from:t.user (`to_interested t.user);
|
||||
in
|
||||
match User.set_nick t.user nick ~router:t.router ~success_callback with
|
||||
| `nick_in_use -> `nicknameinuse nick
|
||||
| `nick_set ->
|
||||
((* TODO: relay NICK message *));
|
||||
`ok
|
||||
| `nick_set -> `ok
|
||||
else begin
|
||||
t.pending_nick <- Some nick;
|
||||
attempt_to_register t
|
||||
|
@ -77,7 +86,7 @@ let on_msg_user t username modestr realname =
|
|||
(* > messages and channels *)
|
||||
|
||||
let on_msg_privmsg t tgt txt _ =
|
||||
let msg = Irc.Msg.make "PRIVMSG" [tgt; txt] in
|
||||
let msg = Irc.Msg.make "PRIVMSG" [tgt; txt] ~always_trailing:true in
|
||||
let dst =
|
||||
try
|
||||
match Irc.name_type tgt with
|
||||
|
@ -89,6 +98,7 @@ let on_msg_privmsg t tgt txt _ =
|
|||
match dst with
|
||||
| `not_found -> `nosuchnick tgt
|
||||
| (`to_user _ | `to_chan _) as dst ->
|
||||
(* TODO: check if allowed to send to channel *)
|
||||
Router.relay msg ~from:t.user dst;
|
||||
`ok
|
||||
|
||||
|
@ -100,6 +110,19 @@ let list_names chan =
|
|||
in
|
||||
`names ("@", Chan.name chan, names)
|
||||
|
||||
let on_msg_names t name _ =
|
||||
match Irc.name_type name with
|
||||
| `nick | `invalid ->
|
||||
if name = "" then `needmoreparams else `nosuchchannel name
|
||||
| `chan ->
|
||||
let chan = try Some (Router.find_chan t.router name)
|
||||
with Not_found -> None
|
||||
in
|
||||
(* TODO: check if allowed to list names *)
|
||||
match chan with
|
||||
| None -> `nosuchchannel name
|
||||
| Some chan -> list_names chan
|
||||
|
||||
let on_msg_join t name _ =
|
||||
match Irc.name_type name with
|
||||
| `nick | `invalid ->
|
||||
|
@ -113,15 +136,17 @@ let on_msg_join t name _ =
|
|||
Chan.register chan ~router:t.router;
|
||||
chan
|
||||
in
|
||||
if not (Chan.is_member chan t.user) then begin
|
||||
if Chan.is_member chan t.user then
|
||||
`ok
|
||||
else begin
|
||||
Chan.join chan t.user;
|
||||
let join_msg = Irc.Msg.make "JOIN" [name] in
|
||||
Router.relay join_msg ~from:t.user `to_self;
|
||||
Router.relay join_msg ~from:t.user (`to_chan chan);
|
||||
end;
|
||||
list_names chan
|
||||
let msg = Irc.Msg.make "JOIN" [name] in
|
||||
Router.relay msg ~from:t.user `to_self;
|
||||
Router.relay msg ~from:t.user (`to_chan chan);
|
||||
list_names chan
|
||||
end
|
||||
|
||||
let on_msg_names t name _ =
|
||||
let on_msg_part t name _ =
|
||||
match Irc.name_type name with
|
||||
| `nick | `invalid ->
|
||||
if name = "" then `needmoreparams else `nosuchchannel name
|
||||
|
@ -129,20 +154,32 @@ let on_msg_names t name _ =
|
|||
let chan = try Some (Router.find_chan t.router name)
|
||||
with Not_found -> None
|
||||
in
|
||||
(* TODO: check if allowed to list names *)
|
||||
match chan with
|
||||
| None -> `nosuchchannel name
|
||||
| Some chan -> list_names chan
|
||||
| Some chan ->
|
||||
if not (Chan.is_member chan t.user) then `notonchannel name
|
||||
else begin
|
||||
let msg = Irc.Msg.make "PART" [name] in
|
||||
Router.relay msg ~from:t.user `to_self;
|
||||
Router.relay msg ~from:t.user (`to_chan chan);
|
||||
Chan.part chan t.user;
|
||||
if Chan.no_members chan then
|
||||
Chan.unregister chan ~router:t.router;
|
||||
`ok
|
||||
end
|
||||
|
||||
let on_msg_privmsg t tgt msg = require_registered t (on_msg_privmsg t tgt msg)
|
||||
let on_msg_join t name = require_registered t (on_msg_join t name)
|
||||
let on_msg_names t name = require_registered t (on_msg_names t name)
|
||||
let on_msg_join t name = require_registered t (on_msg_join t name)
|
||||
let on_msg_part t name = require_registered t (on_msg_part t name)
|
||||
|
||||
(* > misc *)
|
||||
|
||||
let on_msg_quit t why =
|
||||
let why = String.concat " " why in
|
||||
Logs.debug (fun m -> m "%a: quit: %S" pp_sockaddr t.addr why);
|
||||
`quit
|
||||
let on_msg_quit t reason =
|
||||
let reason = String.concat " " reason in
|
||||
shutdown t ~reason;
|
||||
`ok
|
||||
|
||||
(* message sending *)
|
||||
|
||||
|
@ -199,6 +236,7 @@ let err_unknowncommand t cmd = rpl t "421" [cmd; "Unknown command"]
|
|||
let err_nonicknamegiven t = rpl t "431" ["No nickname given"]
|
||||
let err_erroneousnickname t nick = rpl t "432" [nick; "Erroneus nickname"]
|
||||
let err_nicknameinuse t nick = rpl t "433" [nick; "Nickname is already in use"]
|
||||
let err_notonchannel t chan = rpl t "442" [chan; "You're not on that channel"]
|
||||
let err_notregistered t = rpl t "451" ["You have not registered"]
|
||||
let err_needmoreparams t cmd = rpl t "461" [cmd; "Not enough parameters"]
|
||||
let err_alreadyregistered t = rpl t "462" ["Unauthorized command (already registered)"]
|
||||
|
@ -221,23 +259,25 @@ let on_msg t (msg : Irc.Msg.t) : unit =
|
|||
| "JOIN", _ -> `needmoreparams
|
||||
| "NAMES", tgt :: _ -> on_msg_names t tgt
|
||||
| "NAMES", _ -> `needmoreparams
|
||||
| "PART", tgt :: _ -> on_msg_part t tgt
|
||||
| "PART", _ -> `needmoreparams
|
||||
| _, _ -> `unknowncommand
|
||||
in
|
||||
match result with
|
||||
| `ok -> ()
|
||||
| `quit -> shutdown t
|
||||
| `welcome -> rpl_welcome t; rpl_motd t
|
||||
| `motd -> rpl_motd t
|
||||
| `names (cp, ch, us) -> rpl_names t cp ch us
|
||||
| `tryagain -> rpl_tryagain t msg.command
|
||||
| `alreadyregistered -> err_alreadyregistered t
|
||||
| `erroneusnickname n -> err_erroneousnickname t n
|
||||
| `needmoreparams -> err_needmoreparams t msg.command
|
||||
| `nicknameinuse n -> err_nicknameinuse t n
|
||||
| `nonicknamegiven -> err_nonicknamegiven t
|
||||
| `norecipient -> err_norecipient t msg.command
|
||||
| `nosuchnick n -> err_nosuchnick t n
|
||||
| `nosuchchannel c -> err_nosuchchannel t c
|
||||
| `nosuchnick n -> err_nosuchnick t n
|
||||
| `notexttosend -> err_notexttosend t
|
||||
| `notonchannel c -> err_notonchannel t c
|
||||
| `notregistered -> err_notregistered t
|
||||
| `unknowncommand -> err_unknowncommand t msg.command
|
||||
| `nonicknamegiven -> err_nonicknamegiven t
|
||||
| `erroneusnickname n -> err_erroneousnickname t n
|
||||
|
|
|
@ -25,8 +25,8 @@ and chan = {
|
|||
and membership = {
|
||||
mem_user : user;
|
||||
mem_chan : chan;
|
||||
mutable mem_of_chan : membership Dllist.node option;
|
||||
mutable mem_of_user : membership Dllist.node option;
|
||||
mutable mem_in_chan : membership Dllist.node option;
|
||||
(* mutable mem_of_user : membership Dllist.node option; *)
|
||||
}
|
||||
|
||||
type router = t
|
||||
|
@ -56,6 +56,15 @@ let relay ~from msg target =
|
|||
Dllist.iter_l (fun m -> Outbox.incl bcc m.mem_user.outbox) dst.members;
|
||||
Outbox.excl from.outbox;
|
||||
Outbox.send_all bcc msg
|
||||
| `to_interested user ->
|
||||
let bcc = Outbox.make_bcc () in
|
||||
Dllist.iter_l
|
||||
(fun m ->
|
||||
Dllist.iter_l
|
||||
(fun m -> Outbox.incl bcc m.mem_user.outbox)
|
||||
m.mem_chan.members)
|
||||
user.membership;
|
||||
Outbox.send_all bcc msg
|
||||
|
||||
module User = struct
|
||||
type t = user
|
||||
|
@ -80,11 +89,13 @@ module User = struct
|
|||
Hashtbl.remove router.users t.nick_key;
|
||||
t.nick_key <- empty_string_ci
|
||||
|
||||
let set_nick t new_nick ~router =
|
||||
let set_nick ?(success_callback = ignore) t new_nick ~router =
|
||||
let key = string_ci new_nick in
|
||||
if Hashtbl.mem router.users key then
|
||||
`nick_in_use
|
||||
else begin
|
||||
(* hack to allow broadcasting a NICK message before nick is actually changed *)
|
||||
success_callback ();
|
||||
unregister t ~router;
|
||||
Hashtbl.add router.users key t;
|
||||
t.nick <- new_nick;
|
||||
|
@ -92,13 +103,13 @@ module User = struct
|
|||
`nick_set
|
||||
end
|
||||
|
||||
let quit t ~router =
|
||||
if is_registered t then begin
|
||||
let reason = "Goot bye" in
|
||||
(* TODO: relay to everyone interested *)
|
||||
relay ~from:t (Irc.Msg.make "QUIT" [reason]) `to_self;
|
||||
unregister t ~router
|
||||
end
|
||||
let rec part_all t =
|
||||
match Dllist.take_l t.membership with
|
||||
| m ->
|
||||
Option.iter Dllist.remove m.mem_in_chan;
|
||||
part_all t
|
||||
| exception Dllist.Empty ->
|
||||
()
|
||||
end
|
||||
|
||||
module Chan = struct
|
||||
|
@ -114,6 +125,7 @@ module Chan = struct
|
|||
|
||||
let name t = t.name
|
||||
let topic t = t.topic
|
||||
let no_members t = Dllist.is_empty t.members
|
||||
|
||||
let register t ~router =
|
||||
Hashtbl.replace router.channels t.name_key t
|
||||
|
@ -125,18 +137,27 @@ module Chan = struct
|
|||
Dllist.fold_r (fun m xs -> m.mem_user :: xs) t.members []
|
||||
|
||||
let is_member t user =
|
||||
let is_mem m = m.mem_user == user in
|
||||
Option.is_some (Dllist.find_node_opt_l is_mem t.members)
|
||||
let is_mem m = m.mem_chan == t in
|
||||
try
|
||||
ignore (Dllist.find_node_l is_mem user.membership);
|
||||
true
|
||||
with Not_found ->
|
||||
false
|
||||
|
||||
let join t user =
|
||||
let m = {
|
||||
mem_chan = t;
|
||||
mem_user = user;
|
||||
mem_of_chan = None;
|
||||
mem_of_user = None;
|
||||
mem_in_chan = None;
|
||||
} in
|
||||
begin
|
||||
m.mem_of_chan <- Some (Dllist.add_r m t.members);
|
||||
m.mem_of_user <- Some (Dllist.add_r m user.membership);
|
||||
m.mem_in_chan <- Some (Dllist.add_r m t.members);
|
||||
ignore (Dllist.add_r m user.membership);
|
||||
end
|
||||
|
||||
let part t user =
|
||||
let is_mem m = m.mem_chan == t in
|
||||
let mem = Dllist.find_node_l is_mem user.membership in
|
||||
Option.iter Dllist.remove (Dllist.get mem).mem_in_chan;
|
||||
Dllist.remove mem
|
||||
end
|
||||
|
|
Loading…
Reference in New Issue