From d17e573e4159ed02e30379daf0ecd9e70186887b Mon Sep 17 00:00:00 2001 From: tali Date: Tue, 9 Jan 2024 22:01:21 -0500 Subject: [PATCH] add part; part on quit; broadcast messages --- lib/server/connection.ml | 88 +++++++++++++++++++++++++++++----------- lib/server/router.ml | 53 ++++++++++++++++-------- 2 files changed, 101 insertions(+), 40 deletions(-) diff --git a/lib/server/connection.ml b/lib/server/connection.ml index 7e72bdf..5c0e596 100644 --- a/lib/server/connection.ml +++ b/lib/server/connection.ml @@ -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 diff --git a/lib/server/router.ml b/lib/server/router.ml index 361c478..95e2dc4 100644 --- a/lib/server/router.ml +++ b/lib/server/router.ml @@ -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