add WHO command

lib/server/connection.ml

@@ -359,11 +359,7 @@ let list_names t me chan =
   let nicks =
     List.map
       (fun (m : membership) ->
-         let nick = User.nick m.mem_user in
-         match m.mem_priv with
-         | Normal -> nick
-         | Voice -> "+" ^ nick
-         | Operator -> "@" ^ nick)
+         Router.membership_prefix m.mem_priv ^ User.nick m.mem_user)
       members
   in
 
@@ -540,6 +536,56 @@ let on_msg_join_0 t =
   Ok ()
 
 
+(* user queries *)
+
+let user_who_flags user =
+  (* Away status: the letter H ('H', 0x48) to indicate that the user is here, or
+     the letter G ('G', 0x47) to indicate that the user is gone. *)
+  begin match User.away user with
+    | Some _ -> "G"
+    | None -> "H"
+  end ^
+  (* Optionally, the highest channel membership prefix that the client has in <channel>,
+     if the client has one. *)
+  Router.membership_prefix (User.highest_membership_priv user)
+
+let list_who t chan users =
+  let chan_str = match chan with
+    | None -> "*"
+    | Some chan -> Chan.name chan
+  in
+  List.iter
+    (fun user ->
+       let server = t.server_info.hostname in
+       let flags = user_who_flags user in
+       let { username; hostname; realname } = user.userinfo in
+       reply t ("352", [chan_str; username; hostname; server;
+                        User.nick user; flags; "0 " ^ realname]))
+    users
+
+let on_msg_who t mask =
+  let* me = require_registered t in
+  let* chan, users =
+    try
+      match name_type mask with
+      | `nick ->
+        let user = Router.find_user t.router mask in
+        let chan = try Some (User.find_common_channel user me)
+          with Not_found -> None in
+        Ok (chan, [user])
+      | `chan ->
+        let chan = Router.find_chan t.router mask in
+        Ok (Some chan, Chan.members chan)
+      | `invalid ->
+        raise Not_found
+    with Not_found ->
+      Ok (None, [])
+  in
+  list_who t chan users;
+  reply t ("315", [mask; "End of WHO list"]);
+  Ok ()
+
+
 (* welcome and quit *)
 
 let motd t =
@@ -737,7 +783,8 @@ let dispatch t = function
     on_msg_kick t chn tgt (concat_args comment)
   | "AWAY", args -> on_msg_away t (concat_args args)
   | "MODE", tgt :: args when tgt <> "" -> on_msg_mode t tgt args
-  | ("USER" | "JOIN" | "NAMES" | "PART" | "KICK" | "MODE") as cmd, _ ->
+  | "WHO", mask :: _ when mask <> "" -> on_msg_who t mask
+  | ("USER" | "JOIN" | "NAMES" | "PART" | "KICK" | "MODE" | "WHO") as cmd, _ ->
     Error (needmoreparams cmd)
   (* TODO: "LIST" *)
   (* TODO: "ADMIN" *)
@@ -748,7 +795,6 @@ let dispatch t = function
   (* TODO: "HELP" *)
   (* TODO: "INFO" *)
   (* TODO: "NOTICE" *)
-  (* TODO: "WHO" *)
   (* TODO: "WHOIS" *)
   (* TODO: "WHOWAS" *)
   (* TODO: "KILL" *)

lib/server/router.ml

@@ -55,6 +55,11 @@ let membership chan user =
   Dllist.find_node_l (fun mem -> mem.mem_chan == chan)
     user.membership |> Dllist.get
 
+let membership_prefix = function
+  | Normal -> ""
+  | Voice -> "+"
+  | Operator -> "@"
+
 let part mem =
   try
     Dllist.remove (Option.get mem.mem_in_user);

lib/server/test_router.ml

@@ -53,6 +53,7 @@ let%expect_test _ =
   print_int_nl c1.member_count; [%expect "2"];
   print_bool_nl (Router.membership c1 u1 == m11); [%expect "true"];
   print_bool_nl (Router.membership c1 u2 == m12); [%expect "true"];
+  print_bool_nl (User.find_common_channel u1 u2 == c1); [%expect "true"];
   Router.part m11;
   print_bool_nl (Chan.is_empty c1); [%expect "false"];
   print_int_nl c1.member_count; [%expect "1"];

lib/server/user.ml

@@ -39,3 +39,21 @@ let membership t =
 
 let channels t =
   Dllist.fold_r (fun m xs -> m.mem_chan :: xs) t.membership []
+
+let highest_membership_priv t =
+  Dllist.fold_l (fun m p -> max m.mem_priv p) t.membership Normal
+
+let is_member t chan =
+  try
+    Dllist.find_node_l (fun m -> m.mem_chan == chan)
+      t.membership |> ignore;
+    true
+  with Not_found ->
+    false
+
+let find_common_channel t1 t2 =
+  let node =
+    Dllist.find_node_l (fun m -> is_member t2 m.mem_chan)
+      t1.membership
+  in
+  (Dllist.get node).mem_chan