move server info and config to Server_info

bin/main.ml

@@ -4,5 +4,7 @@ Logging.init_pretty_writer stderr
 Lwt_main.run
   (Server.run {
       port = 6667;
-      tcp_listen_backlog = 8
+      tcp_listen_backlog = 8;
+      hostname = "irc.tali.software";
+      (* TODO: motd *)
     })

lib/server/connection.ml

@@ -5,6 +5,7 @@ include (val Logging.sublogs logger "Connection")
 
 type t = {
   router : Router.t;
+  server_info : Server_info.t;
   addr : sockaddr;
   outbox : Outbox.t;
   mutable user : User.t option;
@@ -12,25 +13,18 @@ type t = {
   mutable pending_userinfo : Irc.userinfo option;
 }
 
-let make ~(router : Router.t) ~(addr : sockaddr) : t =
+let make ~router ~server_info ~addr = {
-  let outbox = Outbox.make () in
+  router;
-  { router; addr; outbox; user = None; pending_nick = None; pending_userinfo = None }
+  server_info;
+  addr;
+  outbox = Outbox.make ();
+  user = None;
+  pending_nick = None;
+  pending_userinfo = None;
+}
 
 let outbox t = t.outbox
 
-(* TODO: configure these in some centralized location *)
-let srv_host = "irc.tali.software"
-let srv_ver = "0.0.0"
-let srv_created = "Sun Jan 7 09:58:24 PM EST 2024"
-let srv_motd_lines = [
-  "MEOW MEOW MEOW MEOW MEOW";
-  "meow meow meow meow meow";
-  "meowmeowmeowmeowmeowmeow";
-]
-
-let initial_user_mode = Irc.Mode.Set.of_string "iw"
-let initial_chan_mode = Irc.Mode.Set.of_string "nst"
-
 
 (* numeric replies *)
 
@@ -39,8 +33,9 @@ type reply = string * string list
 type 'a result = ('a, reply) Result.t
 
 let reply t (num, params) =
-  let prefix = Irc.Msg.Server_prefix srv_host in
+  let prefix = Server_info.prefix t.server_info in
-  let target = match t.user with
+  let target =
+    match t.user with
     | Some me -> User.nick me
     | None -> "*"
   in
@@ -72,11 +67,11 @@ let require_registered t : User.t result =
 
 (* modes *)
 
-let set_user_mode user chg =
+let set_user_mode ?(add = Irc.Mode.Set.empty) ?(rem = Irc.Mode.Set.empty) user =
   let mode, chg =
     Irc.Mode.Set.normalize
       (User.mode user)
-      Irc.Mode.Set.{ chg with add = remove `o chg.add (* can't set +o *) }
+      { add = Irc.Mode.Set.remove `o add; rem }
   in
   if chg <> Irc.Mode.Set.no_change then
     let modestr = Fmt.str "%a" Irc.Mode.Set.pp_change chg in
@@ -86,8 +81,12 @@ let set_user_mode user chg =
       User.set_mode user mode;
     end
 
-let set_chan_mode chan ~from chg =
+let set_chan_mode ~from ?(add = Irc.Mode.Set.empty) ?(rem = Irc.Mode.Set.empty) chan =
-  let mode, chg = Irc.Mode.Set.normalize (Chan.mode chan) chg in
+  let mode, chg =
+    Irc.Mode.Set.normalize
+      (Chan.mode chan)
+      { add; rem }
+  in
   if chg <> Irc.Mode.Set.no_change then
     let modestr = Fmt.str "%a" Irc.Mode.Set.pp_change chg in
     let msg = Irc.Msg.make "MODE" [Chan.name chan; modestr] in
@@ -142,7 +141,7 @@ let on_set_user_mode user me modestr _args =
          (501) in reply along with the MODE message." *)
       Error modeunknownflag
   in
-  set_user_mode me chg;
+  set_user_mode me ~add:chg.add ~rem:chg.rem;
   Ok []
 
 let on_get_chan_mode chan _me =
@@ -179,7 +178,7 @@ let on_set_chan_mode chan me modestr args =
       Error modeunknownflag
   in
 
-  set_chan_mode chan ~from:me chg.chan_modes;
+  set_chan_mode chan ~from:me ~add:chg.chan_modes.add ~rem:chg.chan_modes.rem;
   Option.iter (set_chan_key chan ~from:me) chg.chan_key;
   Option.iter (set_chan_limit chan ~from:me) chg.chan_limit;
   (* TODO: ban/op/voice *)
@@ -261,22 +260,21 @@ let on_msg_names t name =
   list_names t chan;
   Ok ()
 
-let join user chan ~router =
+let join t user chan =
   begin
+    (* TODO: check if already a member *)
     (* TODO: check channel mode +k, +l *)
     let msg = Irc.Msg.make "JOIN" [Chan.name chan] in
     Router.relay msg ~from:user [`to_chan chan; `to_self];
 
     Router.join chan user;
 
-    if not (Chan.is_registered chan ~router) then
+    if not (Chan.is_registered chan ~router:t.router) then
       begin
         (* TODO: make founder +o / +q etc. *)
-        Chan.register chan ~router;
+        Chan.register chan ~router:t.router;
-        set_chan_mode chan ~from:user {
+        set_chan_mode chan ~from:user
-          add = initial_user_mode;
+          ~add:(Server_info.conf t.server_info).init_cmode;
-          rem = Irc.Mode.Set.empty;
-        };
       end
   end
 
@@ -293,15 +291,17 @@ let on_msg_join t name =
       debug (fun m -> m "making new channel %S" name);
       Ok (Chan.make ~name)
   in
-  join me chan ~router:t.router;
+  join t me chan;
   (* TODO: send channel topic *)
   list_names t chan;
   Ok ()
 
-let part user chan ~router ~reason =
+let part t user chan ~reason =
   let mem = Router.membership chan user in
   begin
-    if User.is_registered user ~router then
+    (* edge case: don't relay PART messages if the user is QUIT'ing *)
+    (* FIXME: this will need to be changed again to handle KICK, i think *)
+    if User.is_registered user ~router:t.router then
       begin
         let always_trailing = Option.is_some reason in
         let reason = Option.to_list reason in
@@ -316,7 +316,7 @@ let part user chan ~router ~reason =
     if Chan.no_members chan then
       begin
         debug (fun m -> m "recycling empty channel %S" (Chan.name chan));
-        Chan.unregister chan ~router;
+        Chan.unregister chan ~router:t.router;
       end
   end
 
@@ -335,7 +335,7 @@ let on_msg_part t name reason =
       Error (nosuchchannel name)
   in
   try
-    part me chan ~router:t.router ~reason;
+    part t me chan ~reason;
     Ok ()
   with Not_found ->
     Error (notonchannel name)
@@ -345,22 +345,28 @@ let on_msg_part t name reason =
 
 let about t me =
   let who = Irc.Msg.prefix_string (User.prefix me) in
+  let s_hostname = Server_info.hostname t.server_info in
+  let s_version = Server_info.version t.server_info in
+  let s_created = Server_info.created t.server_info in
+  let conf = Server_info.conf t.server_info in
+  let modes l = String.of_seq (List.to_seq l |> Seq.map Irc.Mode.to_char) in
+  let umodes = modes conf.all_umodes in
+  let cmodes = modes conf.all_cmodes in
+  let pmodes = modes conf.all_pmodes in
   begin
     reply t ("001", [Fmt.str "Welcome to the tali IRC network %s" who]);
-    reply t ("002", [Fmt.str "Your host is %s, running version %s" srv_host srv_ver]);
+    reply t ("002", [Fmt.str "Your host is %s, running version %s" s_hostname s_version]);
-    reply t ("003", [Fmt.str "This server was created %s" srv_created]);
+    reply t ("003", [Fmt.str "This server was created %s" s_created]);
-    reply t ("004", [srv_host; srv_ver; "iow"; "imnst"; "bklov"]);
+    reply t ("004", [s_hostname; s_version; umodes; cmodes; pmodes]);
-    reply t ("005", ["CASEMAPPING=ascii";
+    reply t ("005", conf.isupport);
-                     "CHANTYPES=#";
-                     "CHANMODES=b,k,l,imstn";
-                     "PREFIX=(ov)@+";
-                     "are supported by this server"]);
   end
 
 let motd t =
+  let s_hostname = Server_info.hostname t.server_info in
+  let s_motd = Server_info.motd t.server_info in
   begin
-    reply t ("375", [Fmt.str "- %s Message of the day - " srv_host]);
+    reply t ("375", [Fmt.str "- %s Message of the day - " s_hostname]);
-    List.iter (fun ln -> reply t ("372", ["- " ^ ln])) srv_motd_lines;
+    List.iter (fun ln -> reply t ("372", ["- " ^ ln])) s_motd;
     reply t ("376", ["End of /MOTD command"]);
   end
 
@@ -382,7 +388,7 @@ let quit t me ~reason =
 
     User.unregister me ~router:t.router;
     List.iter
-      (part me ~router:t.router ~reason:None)
+      (part t me ~reason:None)
       (User.channels me);
 
     t.user <- None
@@ -414,10 +420,8 @@ let attempt_to_register t =
       User.register me ~router:t.router;
       t.user <- Some me;
       welcome t me;
-      set_user_mode me {
+      set_user_mode me
-        add = initial_user_mode;
+        ~add:(Server_info.conf t.server_info).init_umode;
-        rem = Irc.Mode.Set.empty;
-      };
       Ok ()
   | _, _ ->
     Ok ()

lib/server/router.ml

@@ -46,6 +46,7 @@ let join chan user =
   begin
     mem.mem_in_chan <- Some (Dllist.add_r mem chan.members);
     mem.mem_in_user <- Some (Dllist.add_r mem user.membership);
+    (* TODO: return mem? *)
   end
 
 let membership chan user =

lib/server/server.ml

@@ -59,11 +59,17 @@ let writer (fd : fd) (obox : Irc.Msg.t Lwt_stream.t) : unit Lwt.t =
       | Unix.Unix_error (ECONNRESET, _, _) -> Lwt.return_unit
       | exn -> Lwt.fail exn)
 
-let handle_client (router : Router.t) (conn_fd : fd) (conn_addr : sockaddr) =
+let handle_client
+      (conn_fd : fd)
+      (conn_addr : sockaddr)
+      ~(router : Router.t)
+      ~(server_info : Server_info.t)
+  =
   info (fun m -> m "new connection %a" pp_sockaddr conn_addr);
   let conn : Connection.t =
     Connection.make
       ~router
+      ~server_info
       ~addr:conn_addr
   in
   let reader = Lwt_stream.iter (Connection.on_msg conn) (reader conn_fd) in
@@ -80,16 +86,24 @@ let handle_client (router : Router.t) (conn_fd : fd) (conn_addr : sockaddr) =
 type config = {
   port : int;
   tcp_listen_backlog : int;
+  hostname : string;
+  (* TODO: motd *)
 }
 
 let run (cfg : config) : unit Lwt.t =
+  let server_info =
+    Server_info.make
+      ~hostname:cfg.hostname
+      (* ~motd *)
+  in
+
   let router : Router.t =
     Router.make ()
   in
 
   let on_con (fd, adr) =
     Lwt.on_failure
-      (handle_client router fd adr)
+      (handle_client fd adr ~router ~server_info)
       (fun exn ->
          error (fun m -> m "%a: %a" pp_sockaddr adr Fmt.exn exn))
   in

lib/server/server_info.ml

@@ -0,0 +1,56 @@
+type t = {
+  hostname : string;
+  created : string;
+  motd : string list;
+  conf : conf;
+}
+
+and conf = {
+  isupport : string list;
+  all_umodes : Irc.Mode.user list;
+  all_cmodes : Irc.Mode.chan_d list;
+  all_pmodes : [Irc.Mode.chan_a | Irc.Mode.chan_b | Irc.Mode.chan_c] list;
+  init_umode : Irc.Mode.Set.t;
+  init_cmode : Irc.Mode.Set.t;
+}
+
+let isupport = [
+  "CASEMAPPING=ascii";
+  "CHANTYPES=#";
+  "CHANMODES=b,k,l,imstn";
+  "PREFIX=(ov)@+";
+  "are supported by this server";
+]
+
+let default_conf = {
+  isupport;
+  all_umodes = [`i; `o; `w];
+  all_cmodes = [`i; `m; `n; `s; `t];
+  all_pmodes = [`b; `k; `l; `o; `v];
+  init_umode = Irc.Mode.Set.of_list [`i; `w];
+  init_cmode = Irc.Mode.Set.of_list [`n; `s; `t];
+}
+
+let make ~hostname = {
+  hostname;
+  created =
+    (* TODO: stringify timestamp *)
+    "Sun Jan 7 09:58:24 PM EST 2024";
+  motd = [
+    (* TODO: load from file *)
+    "MEOW MEOW MEOW MEOW MEOW";
+    "meow meow meow meow meow";
+    "meowmeowmeowmeowmeowmeow";
+  ];
+  conf = default_conf;
+}
+
+let version (_ : t) =
+  (* TODO: generate version string at build time? *)
+  "0.0.0"
+
+let hostname t = t.hostname
+let prefix t = Irc.Msg.Server_prefix t.hostname
+let created t = t.created
+let motd t = t.motd
+let conf t = t.conf