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

add part; part on quit; broadcast messages

This commit is contained in:
tali 2024-01-09 22:01:21 -05:00
parent 17e3739cfe
commit d17e573e41
2 changed files with 101 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
lib/server/connection.ml
View File

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

53
lib/server/router.ml
View File

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