add LIST command

lib/server/chan.ml

@@ -24,6 +24,7 @@ let creation_time t = t.creation_time
 let topic t = fst t.topic
 let topic_who_time t = snd t.topic
 let set_topic ~who ?time t text = t.topic <- text, Some (who, value_or_now time)
+let member_count t = t.member_count
 let mode t = t.chan_mode
 let set_mode t new_mode = t.chan_mode <- new_mode
 let limit t = t.chan_limit

lib/server/connection.ml

@@ -347,30 +347,29 @@ let membership_prefix = function
 let is_invisible user =
   Mode.Set.mem `i (User.mode user)
 
-let list_names t me chan =
+let is_secret chan =
-  let is_secret = Mode.Set.mem `s (Chan.mode chan) in
+  Mode.Set.mem `s (Chan.mode chan)
 
+let list_names t me chan =
   let members =
     match Router.membership chan me with
     | _is_member -> Chan.membership chan
     | exception Not_found ->
-      if is_secret then
+      if is_secret chan then
         []
       else
         Chan.membership_when
           (fun mem -> not (is_invisible mem.mem_user))
           chan
   in
-
   let nicks =
     List.map
       (fun mem ->
          membership_prefix mem.mem_priv ^ User.nick mem.mem_user)
       members
   in
-
   let chan_name = Chan.name chan in
-  let chan_sym = if is_secret then "@" else "=" in
+  let chan_sym = if is_secret chan then "@" else "=" in
   begin
     (* TODO: concat member names until message becomes too long *)
     List.iter (fun nick -> reply t ("353", [chan_sym; chan_name; nick])) nicks;
@@ -686,6 +685,43 @@ let on_msg_userhost t nicks =
   reply t ("302", [String.concat " " results]);
   Ok ()
 
+let list_channels t me channels =
+  begin
+    reply t ("321", ["Channel"; "Users  Name"]);
+    Seq.iter
+      (function
+        | Error err -> reply t err
+        | Ok chan ->
+          try
+            if is_secret chan then Router.membership chan me |> ignore;
+            let count = Chan.member_count chan in
+            let topic = Option.value (Chan.topic chan) ~default:"" in
+            reply t ("322", [Chan.name chan; string_of_int count; topic])
+          with Not_found ->
+            ())
+      channels;
+    reply t ("323", ["End of /LIST"]);
+  end
+
+let on_msg_list t names =
+  let* me = require_registered t in
+  let channels = match names with
+    | [] ->
+      Seq.map Result.ok
+        (Router.all_channels_seq t.router)
+    | _ ->
+      Seq.map
+        (fun name ->
+           try
+             match name_type name with
+             | `chan -> Ok (Router.find_chan t.router name)
+             | `nick | `invalid -> raise Not_found
+           with Not_found ->
+             Error (nosuchnick name))
+        (List.to_seq names)
+  in
+  list_channels t me channels;
+  Ok ()
 
 (* welcome and quit *)
 
@@ -938,6 +974,8 @@ let dispatch t = function
   | "WHOWAS", ([] | "" :: _) -> Error nonicknamegiven
   | "WHOWAS", [nick] -> on_msg_whowas t nick ""
   | "WHOWAS", nick :: count :: _ -> on_msg_whowas t nick count
+  | "LIST", chans :: _ -> on_msg_list t (String.split_on_char ',' chans)
+  | "LIST", [] -> on_msg_list t []
   | "USERHOST", nicks -> on_msg_userhost t nicks
   | ("USER" | "JOIN" | "NAMES" | "PART" | "KICK" | "MODE" | "WHO") as cmd, _ ->
     Error (needmoreparams cmd)
@@ -951,7 +989,6 @@ let dispatch t = function
       | tgt :: msg :: _ -> on_msg_privmsg t tgt msg ~cmd
     end
 
-  (* TODO: "LIST" *)
   | cmd, _ ->
     Error (unknowncommand cmd)
 

lib/server/router.ml

@@ -28,6 +28,9 @@ let find_chan t name =
 let whowas t nick =
   Cache.find_all t.whowas (string_ci nick)
 
+let all_channels_seq t =
+  Hashtbl.to_seq_values t.channels
+
 let nuke t =
   begin
     Hashtbl.iter (fun _ u -> Dllist.reset u.membership) t.users;