privmsg between users; better cleanup on quit

lib/server/connection.ml

@@ -1,11 +1,11 @@
 open! Import
+module User = Router.User
 
 type t = {
   addr : sockaddr;
-  user : Router.user;
+  user : User.t;
   outbox : Irc.Msg.t Lwt_stream.t;
   push_outbox : (Irc.Msg.t option -> unit);
-  quit : unit Lwt_condition.t;
 }
 
 let make ~(router : Router.t) ~(addr : sockaddr) : t =
@@ -13,25 +13,22 @@ let make ~(router : Router.t) ~(addr : sockaddr) : t =
     | ADDR_INET (ia, _) -> Unix.string_of_inet_addr ia
     | ADDR_UNIX path -> path
   in
-  let user = Router.User.make router ~hostname in
+  let user = User.make router ~hostname in
   let outbox, push_outbox = Lwt_stream.create () in
-  {
-    addr; user; outbox; push_outbox;
-    quit = Lwt_condition.create ();
-  }
+  { addr; user; outbox; push_outbox }
 
-let quitting t = Lwt_condition.wait t.quit
-let outbox t = t.outbox
+let outbox t = Lwt_stream.choose [t.outbox; User.inbox t.user]
 let send t msg = try t.push_outbox (Some msg) with Lwt_stream.Closed -> ()
+let close t = try t.push_outbox None with Lwt_stream.Closed -> ()
 
 let cleanup t =
-  t.push_outbox None;
-  Router.User.cleanup t.user
+  close t;
+  User.cleanup t.user
 
 (* message handling *)
 
 let require_registered t f =
-  if Router.User.is_registered t.user then
+  if User.is_registered t.user then
     f (Option.get t.user.userinfo)
   else
     `notregistered
@@ -41,18 +38,21 @@ let require_registered t f =
 let attempt_to_register t =
   match t.user.nick, t.user.userinfo with
   | Some nick, Some _userinfo ->
-    begin match Router.User.set_nick t.user nick with
+    begin match User.set_nick t.user nick with
       | `nick_in_use -> `nicknameinuse nick
       | `nick_set ->
         Logs.debug (fun m -> m "init mode: +%a" Irc.Mode.pp t.user.mode);
+        User.send t.user
+          (Irc.Msg.make "MODE" [nick; Fmt.str "+%a" Irc.Mode.pp t.user.mode]
+             ~prefix:(User_prefix (nick, None, None)));
         (* TODO: set initial mode *)
         `welcome
     end
   | _, _ -> `ok
 
 let on_msg_nick t nick =
-  if Router.User.is_registered t.user then
-    match Router.User.set_nick t.user nick with
+  if User.is_registered t.user then
+    match User.set_nick t.user nick with
     | `nick_in_use -> `nicknameinuse nick
     | `nick_set -> `ok
   else begin
@@ -61,10 +61,10 @@ let on_msg_nick t nick =
   end
 
 let on_msg_user t username modestr realname =
-  if Router.User.is_registered t.user then
+  if User.is_registered t.user then
     `alreadyregistered
   else begin
-    (* NB: +iw is automatically set, so it's impossible to actually affect the initial
+    (* NB: "+iw" is automatically set, so it's impossible to actually affect the initial
        mode with the parameter to USER *)
     ignore modestr;
     t.user.userinfo <- Some { username; realname };
@@ -73,13 +73,10 @@ let on_msg_user t username modestr realname =
 
 (* > messages and channels *)
 
-let on_msg_privmsg t tgt msg _userinfo =
+let on_msg_privmsg t tgt msg _ =
   match Router.find_user t.user.router tgt with
   | None -> `nosuchnick tgt
-  | Some _ ->
-    let _ = msg in
-    (* TODO: send messages *)
-    `tryagain
+  | Some dst -> Router.privmsg t.user (`user dst) msg; `ok
 
 let on_msg_privmsg t tgt msg = require_registered t (on_msg_privmsg t tgt msg)
     
@@ -88,8 +85,8 @@ let on_msg_privmsg t tgt msg = require_registered t (on_msg_privmsg t tgt msg)
 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);
-  Lwt_condition.broadcast t.quit ();
-  `ok
+  (* broadcast "quit" message *)
+  `quit
 
 (* message sending *)
 
@@ -105,13 +102,13 @@ let srv_motd_lines = [
 
 let rpl t cmd params =
   let prefix = Irc.Msg.Server_prefix srv_host in
-  let target = Router.User.nick t.user in
+  let target = User.nick t.user in
   send t (Irc.Msg.make ~prefix cmd (target :: params))
 
 let rpl_tryagain t cmd = rpl t "263" [cmd; "Please wait a while and try again."]
 
 let rpl_welcome t =
-  let who = Irc.Msg.prefix_string (Router.User.prefix t.user) in
+  let who = Irc.Msg.prefix_string (User.prefix t.user) in
   begin
     rpl t "001" [Fmt.str "Welcome to the tali IRC network %s" who];
     rpl t "002" [Fmt.str "Your host is %s, running version %s" srv_host srv_ver];
@@ -155,6 +152,7 @@ let on_msg t (msg : Irc.Msg.t) : unit =
   in
   match result with
   | `ok -> ()
+  | `quit -> close t
   | `welcome -> rpl_welcome t; rpl_motd t
   | `tryagain -> rpl_tryagain t msg.command
   | `alreadyregistered -> err_alreadyregistered t

lib/server/irc_server.ml

@@ -63,15 +63,14 @@ let handle_client (router : Router.t) (conn_fd : fd) (conn_addr : sockaddr) =
   in
   let rd = Lwt_stream.iter (Connection.on_msg conn) (reader conn_fd) in
   let wr = writer conn_fd (Connection.outbox conn) in
-  let qt = Connection.quitting conn in
   Lwt.finalize
     (fun () ->
        Logs.info (fun m -> m "new connection %a" pp_sockaddr conn_addr);
-       Lwt.choose [rd; wr; qt])
+       Lwt.choose [rd; wr])
     (fun () ->
-       Logs.info (fun m -> m "connection closed %a" pp_sockaddr conn_addr);
        Connection.cleanup conn;
-       Lwt_unix.close conn_fd)
+       Lwt_unix.close conn_fd >|= fun () ->
+       Logs.info (fun m -> m "connection closed %a" pp_sockaddr conn_addr))
 
 type config = {
   port : int;

lib/server/router.ml

@@ -2,11 +2,6 @@ type nick_key = Nick_key of string [@@unboxed]
 let nick_key n = Nick_key (String.lowercase_ascii n) (* TODO: "scandinavian" lowercase *)
 let unset = Nick_key ""
 
-(* TODO: notifications *)
-(* type notif = *)
-(*   | Mode of Irc.nick * Irc.nick * Irc.Mode.t *)
-(*   | Nick of Irc.Msg.prefix * Irc.nick *)
-
 type t = {
   users : (nick_key, user) Hashtbl.t
   (* TODO: channels *)
@@ -19,8 +14,8 @@ and user = {
   mutable nick : Irc.nick option;
   mutable userinfo : Irc.userinfo option;
   mutable mode : Irc.Mode.t;
-  (* inbox : notif Lwt_stream.t; *)
-  (* push_inbox : (notif option -> unit); *)
+  inbox : Irc.Msg.t Lwt_stream.t;
+  push_inbox : (Irc.Msg.t option -> unit);
 }
 
 let make () =
@@ -33,7 +28,7 @@ module User = struct
   type t = user
 
   let make router ~hostname =
-    (* let inbox, push_inbox = Lwt_stream.create () in *)
+    let inbox, push_inbox = Lwt_stream.create () in
     {
       router;
       hostname;
@@ -41,11 +36,14 @@ module User = struct
       nick = None;
       userinfo = None;
       mode = Irc.Mode.of_string "iw";
-      (* inbox; push_inbox; *)
+      inbox; push_inbox;
     }
 
-  let nick t = Option.value t.nick ~default:"*"
+  let inbox t = t.inbox
+  let send t msg = try t.push_inbox (Some msg) with Lwt_stream.Closed -> ()
+  let close t = try t.push_inbox None with Lwt_stream.Closed -> ()
 
+  let nick t = Option.value t.nick ~default:"*"
   let prefix t : Irc.Msg.prefix =
     match t.nick with
     | None -> No_prefix
@@ -69,7 +67,15 @@ module User = struct
       `nick_set
     end
 
-  let cleanup user =
-    unset_nick user
-    (* user.push_inbox None *)
+  let cleanup t =
+    (* TODO: notify other users of quit *)
+    close t;
+    unset_nick t
 end
+
+let privmsg src dst txt =
+  match dst with
+  | `user dst ->
+    let prefix = User.prefix src in
+    let msg = Irc.Msg.make "PRIVMSG" [User.nick dst; txt] ~prefix in
+    User.send dst msg