add LUSERS command

lib/server/chan.ml

@@ -31,8 +31,18 @@ let set_limit t n = t.chan_limit <- n
 let key t = t.chan_key
 let set_key t k = t.chan_key <- k
 
-let register t ~router = Hashtbl.replace router.channels t.name_key t
-let unregister t ~router = Hashtbl.remove router.channels t.name_key
+let register t ~router =
+  begin
+    Hashtbl.replace router.channels t.name_key t;
+    router.luserchannels <- succ router.luserchannels;
+  end
+
+let unregister t ~router =
+  begin
+    Hashtbl.remove router.channels t.name_key;
+    router.luserchannels <- pred router.luserchannels;
+  end
+
 let is_registered t ~router = Hashtbl.mem router.channels t.name_key
 
 let members t =

lib/server/connection.ml

@@ -720,6 +720,21 @@ let on_msg_time t =
   reply t ("391", [t.server_info.hostname; time_unix; time_human]);
   Ok ()
 
+let on_msg_lusers t =
+  let* _me = require_registered t in
+  let u = Router.lusers t.router in
+  let c = Router.luserchannels t.router in
+  let m = 9999 in
+  reply t ("252", ["0"; "operator(s) online"]);
+  reply t ("253", ["0"; "unknown connection(s)"]); (* TODO: unknown connections *)
+  reply t ("254", [string_of_int c; Fmt.str "channels formed"]);
+  reply t ("255", [Fmt.str "I have %d clients and %d servers" u 0]);
+  reply t ("265", [string_of_int u; string_of_int m;
+                   Fmt.str "Current local users %d, max %d" u m]);
+  reply t ("266", [string_of_int u; string_of_int m;
+                   Fmt.str "Current global users %d, max %d" u m]);
+  Ok ()
+
 let quit t me ~reason =
   begin
     let msg = Msg.make "QUIT" [User.nick me; reason] ~always_trailing:true in
@@ -872,6 +887,7 @@ let dispatch t = function
   | "ADMIN", _ -> on_msg_admin t
   | "INFO", _ -> on_msg_info t
   | "TIME", _ -> on_msg_time t
+  | "LUSERS", _ -> on_msg_lusers t
   | "HELP", args -> on_msg_help t (concat_args args)
   | "PING", args -> on_msg_ping t (concat_args args)
   | "PONG", args -> on_msg_pong t (concat_args args)
@@ -899,7 +915,6 @@ let dispatch t = function
   | ("CONNECT" | "KILL" | "REHASH" | "RESTART" | "STATS" | "SQUIT" | "WALLOPS"), _ ->
     Error noprivileges
   (* TODO: "LIST" *)
-  (* TODO: "LUSERS" *)
   (* TODO: "LINKS" *)
   (* TODO: "USERHOST" *)
   | cmd, _ ->

lib/server/router.ml

@@ -9,8 +9,13 @@ let make ~whowas_history_len = {
   users = Hashtbl.create 1024;
   channels = Hashtbl.create 1024;
   whowas = Cache.make whowas_history_len;
+  lusers = 0;
+  luserchannels = 0;
 }
 
+let lusers t = t.lusers
+let luserchannels t = t.luserchannels
+
 let is_nick_available t nick =
   not (Hashtbl.mem t.users (string_ci nick))
 

lib/server/router_types.ml

@@ -43,4 +43,6 @@ type router = {
   users : (string_ci, user) Hashtbl.t;
   channels : (string_ci, chan) Hashtbl.t;
   whowas : (string_ci, name * userinfo) Cache.t;
+  mutable lusers : int;
+  mutable luserchannels : int;
 }

lib/server/test_router.ml

@@ -34,10 +34,19 @@ let%expect_test _ =
   let c1 = Chan.make "#wire-fraud" in
   let c2 = Chan.make "#spiderman" in
 
+  print_int_nl (Router.lusers router); [%expect "0"];
+  print_int_nl (Router.luserchannels router); [%expect "0"];
+
   User.register u1 ~router;
   User.register u2 ~router;
+  print_int_nl (Router.lusers router); [%expect "2"];
+  print_int_nl (Router.luserchannels router); [%expect "0"];
+
   Chan.register c1 ~router;
   Chan.register c2 ~router;
+  print_int_nl (Router.lusers router); [%expect "2"];
+  print_int_nl (Router.luserchannels router); [%expect "2"];
+
   print_bool_nl (Router.find_user router "beenie" == u1); [%expect "true"];
   print_bool_nl (Router.find_user router "bobbie" == u2); [%expect "true"];
   print_bool_nl (Router.find_chan router "#wire-fraud" == c1); [%expect "true"];

lib/server/user.ml

@@ -31,9 +31,15 @@ let register t ~router =
   begin
     Hashtbl.add router.users t.nick_key t;
     Cache.add router.whowas t.nick_key (t.nick, t.userinfo);
+    router.lusers <- succ router.lusers;
+  end
+
+let unregister t ~router =
+  begin
+    Hashtbl.remove router.users t.nick_key;
+    router.lusers <- pred router.lusers;
   end
 
-let unregister t ~router = Hashtbl.remove router.users t.nick_key
 let is_registered t ~router = Hashtbl.mem router.users t.nick_key
 
 let prefix t =