add basic get/set channel mode

lib/server/connection.ml

@@ -43,7 +43,7 @@ let srv_motd_lines = [
 ]
 
 let initial_user_modestr = "iw"
-(* let initial_chan_modestr = "nst" *)
+let initial_chan_modestr = "nst"
 
 
 (* numeric replies *)
@@ -186,7 +186,7 @@ let on_msg_names t name =
   list_names t chan;
   Ok ()
 
-let on_msg_join t name =
+let on_msg_join t name ~set_chan_mode =
   let* me = require_registered t in
   (* TODO: keys parameter *)
   (* TODO: "0" parameter means part from all channels *)
@@ -197,15 +197,27 @@ let on_msg_join t name =
       | _     -> Error (nosuchchannel name)
     with Not_found ->
       debug (fun m -> m "making new channel %S" name);
-      let chan = Chan.make ~name in
+      Ok (Chan.make ~name)
-      Chan.register chan ~router:t.router;
-      (* TODO: make user +o *)
-      Ok chan
   in
-  (* TODO: check if channel is +k *)
+
-  Chan.join chan me;
+  (* TODO: check channel mode +k, +l *)
+
   let msg = Irc.Msg.make "JOIN" [name] in
   Router.relay msg ~from:me [`to_chan chan; `to_self];
+  Chan.join chan me;
+
+  if not (Chan.is_registered chan ~router:t.router) then
+    (* set up newly created channel *)
+    begin
+      Chan.register chan ~router:t.router;
+      set_chan_mode chan ~from:me
+        Irc.Mode.Set.{
+          add = of_string initial_chan_modestr;
+          rem = empty;
+        };
+      (* TODO: make founder +o / +q etc. *)
+    end;
+
   (* TODO: send channel topic *)
   list_names t chan;
   Ok ()
@@ -248,6 +260,16 @@ let set_user_mode user chg =
       User.set_mode user mode;
     end
 
+let set_chan_mode chan ~from chg =
+  let mode, chg = Irc.Mode.Set.normalize (Chan.mode chan) chg 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] ~always_trailing:true in
+    begin
+      Router.relay msg ~from [`to_chan chan; `to_self];
+      Chan.set_mode chan mode;
+    end
+
 let on_get_user_mode user me =
   let* () = if user != me then Error usersdontmatch_get else Ok () in
   Ok [
@@ -264,20 +286,37 @@ let on_set_user_mode user me modestr _args =
       Error modeunknownflag
   in
   set_user_mode me chg;
-  Ok ()
+  Ok []
 
-let on_get_chan_mode chan me =
+let on_get_chan_mode chan _me =
-  let _ = me, chan in
+  Ok [
-  (* If <modestring> is not given, the RPL_CHANNELMODEIS (324) numeric is returned. Servers
+    "324", [Chan.name chan; Fmt.str "+%a" Irc.Mode.Set.pp (Chan.mode chan)];
-     MAY choose to hide sensitive information such as channel keys when sending the current
+    (* TODO: +k *)
-     modes. Servers MAY also return the RPL_CREATIONTIME (329) numeric following
+    (* TODO: +l *)
-     RPL_CHANNELMODEIS.  *)
+    (* TODO: RPL_CREATIONTIME (329) *)
-  Error (tryagain "MODE")
+  ]
 
 let on_set_chan_mode chan me modestr args =
-  let _ = me, chan, modestr, args in
+  (* TODO: If <modestring> is given, the user sending the command MUST have appropriate
-  (* TODO *)
+     channel privileges on the target channel to change the modes given. If a user does
-  Error (tryagain "MODE")
+     not have appropriate privileges to change modes on the target channel, the server
+     MUST NOT process the message, and ERR_CHANOPRIVSNEEDED (482) numeric is returned. *)
+  let _ = me, chan in
+
+  let* chg = try Ok (Irc.Mode.Parse.chan_modes modestr args)
+    with Irc.Mode.Parse.Error ->
+      (* TODO: "If one or more modes sent are not implemented on the server, the server
+         MUST apply the modes that are implemented, and then send the ERR_UMODEUNKNOWNFLAG
+         (501) in reply along with the MODE message." *)
+      Error modeunknownflag
+  in
+
+  set_chan_mode chan chg.chan_modes ~from:me;
+  (* TODO: chg.chan_key *)
+  (* TODO: chg.chan_limit *)
+  (* TODO: chg.chan_priv *)
+
+  Ok []
 
 let on_msg_mode t name args =
   let* me = require_registered t in
@@ -294,12 +333,15 @@ let on_msg_mode t name args =
     with Not_found ->
       Error (nosuchnick name)
   in
-  match args with
+  let+ rpls =
-  | [] ->
+    match args with
-    let+ rpls = on_get me in
+    | [] -> on_get me
-    List.iter (reply t) rpls
+    | modestr :: args -> on_set me modestr args
-  | modestr :: args ->
+  in
-    on_set me modestr args
+  List.iter (reply t) rpls
+
+let on_msg_join = on_msg_join ~set_chan_mode
+
 
 (* misc *)
 

lib/server/router.ml

@@ -23,6 +23,7 @@ and chan = {
   (* TODO: +b, +o, +v *)
   (* TODO: +k *)
   (* TODO: +l *)
+  (* TODO: creation time *)
 }
 
 and membership = {
@@ -133,7 +134,7 @@ module Chan = struct
       name_key = string_ci name;
       topic = None;
       members = Dllist.create ();
-      chan_mode = Irc.Mode.Set.of_string "nst";
+      chan_mode = Irc.Mode.Set.empty;
     }
 
   let name t = t.name
@@ -149,6 +150,9 @@ module Chan = struct
   let unregister t ~router =
     Hashtbl.remove router.channels t.name_key
 
+  let is_registered t ~router =
+    Hashtbl.mem router.channels t.name_key
+
   let is_member t user =
     let is_mem m = m.mem_chan == t in
     try