add KICK command and clean up KICK/PART/QUIT reason param

lib/server/connection.ml

@@ -35,6 +35,8 @@ type reply = string * string list
 
 type 'a result = ('a, reply) Result.t
 
+let ( >>= ) = Result.bind
+
 let list_of_errors = function
   | Ok () -> []
   | Error e -> [e]
@@ -433,18 +435,23 @@ let on_msg_join t name =
       Ok ()
     end
 
-let leave t user chan ~why =
-  let mem = Router.membership chan user in
+let leave t (mem : membership) ~from ~why =
+  let user = mem.mem_user in
+  let chan = mem.mem_chan in
   begin match why with
-    (* TODO: KICK *)
     | `quit ->
-      (* if called from [quit], then we already relayed the QUIT message *)
+      (* assume QUIT message has already been relayed *)
       ()
     | `part reason ->
       let always_trailing = Option.is_some reason in
-      let reason = Option.to_list reason in
-      let msg = Msg.make "PART" (Chan.name chan :: reason) ~always_trailing in
-      Router.relay msg ~from:user [`to_chan chan; `to_self]
+      let params = Chan.name chan :: Option.to_list reason in
+      let msg = Msg.make "PART" params ~always_trailing in
+      Router.relay msg ~from [`to_chan chan; `to_self]
+    | `kick comment ->
+      let always_trailing = Option.is_some comment in
+      let params = Chan.name chan :: User.nick user :: Option.to_list comment in
+      let msg = Msg.make "KICK" params ~always_trailing in
+      Router.relay msg ~from [`to_chan chan; `to_self]
   end;
   Router.part mem;
   if Chan.is_empty chan then
@@ -454,10 +461,6 @@ let leave t user chan ~why =
     end
 
 let on_msg_part t name reason =
-  let reason = match reason with
-    | [] -> None
-    | xs -> Some (String.concat " " xs)
-  in
   let* me = require_registered t in
   let* chan =
     try
@@ -467,18 +470,43 @@ let on_msg_part t name reason =
     with Not_found ->
       Error (nosuchchannel name)
   in
-  try
-    leave t me chan ~why:(`part reason);
-    Ok ()
-  with Not_found ->
-    Error (notonchannel name)
+  let* mem = try Ok (Router.membership chan me)
+    with Not_found -> Error (notonchannel name) in
+  leave t mem ~from:me ~why:(`part reason);
+  Ok ()
+
+let on_msg_kick t name nick comment =
+  let* me = require_registered t in
+  let* chan =
+    try
+      match name_type name with
+      | `chan -> Ok (Router.find_chan t.router name)
+      | `nick | `invalid -> raise Not_found
+    with Not_found ->
+      Error (nosuchchannel name)
+  in
+  let* () = require_membership chan me >>= require_chan_op in
+  let* user =
+    try
+      match name_type nick with
+      | `nick -> Ok (Router.find_user t.router nick)
+      | `chan | `invalid -> raise Not_found
+    with Not_found ->
+      Error (nosuchnick name)
+  in
+  let* mem = try Ok (Router.membership chan user)
+    with Not_found ->
+      Error (usernotinchannel (User.nick user) (Chan.name chan))
+  in
+  leave t mem ~from:me ~why:(`kick comment);
+  Ok ()
 
 let on_msg_join_0 t =
   (* "JOIN 0" actually means part from all joined channels *)
   let* me = require_registered t in
   List.iter
-    (leave t me ~why:(`part None))
-    (User.channels me);
+    (leave t ~from:me ~why:(`part None))
+    (User.membership me);
   Ok ()
 
 
@@ -523,8 +551,8 @@ let quit t me ~reason =
     Router.relay msg ~from:me [`to_interested];
 
     List.iter
-      (leave t me ~why:`quit)
-      (User.channels me);
+      (leave t ~from:me ~why:`quit)
+      (User.membership me);
 
     User.unregister me ~router:t.router;
     t.user <- None
@@ -536,8 +564,8 @@ let close ?(reason = "Client closed") t =
 
 let on_msg_quit t reason =
   let reason = match reason with
-    | [] -> "Quit"
-    | xs -> String.concat " " ("Quit:" :: xs)
+    | None -> "Quit"
+    | Some x -> "Quit: " ^ x
   in
   close t ~reason;
   Ok ()
@@ -602,11 +630,15 @@ let on_msg_user t username realname =
 
 (* message parsing *)
 
+let concat_args = function
+  | [] -> None
+  | xs -> Some (String.concat " " xs)
+
 let dispatch t = function
   | "NICK", nick :: _ when nick <> "" -> on_msg_nick t nick
   | "NICK", _ -> Error nonicknamegiven
   | "USER", unm :: _ :: _ :: rnm :: _ -> on_msg_user t unm rnm
-  | "QUIT", reason -> on_msg_quit t reason
+  | "QUIT", reason -> on_msg_quit t (concat_args reason)
   | "MOTD", _ -> on_msg_motd t
   | "PRIVMSG", ([] | "" :: _) -> Error norecipient
   | "PRIVMSG", ([_] | _ :: "" :: _) -> Error notexttosend
@@ -615,9 +647,11 @@ let dispatch t = function
   | "JOIN 0", _ -> (* hack; see split_command_params *) on_msg_join_0 t
   | "NAMES", tgt :: _ when tgt <> "" -> on_msg_names t tgt
   | "TOPIC", tgt :: args when tgt <> "" -> on_msg_topic t tgt args
-  | "PART", tgt :: reason when tgt <> "" -> on_msg_part t tgt reason
+  | "PART", tgt :: reason when tgt <> "" -> on_msg_part t tgt (concat_args reason)
+  | "KICK", chn :: tgt :: comment when chn <> "" && tgt <> "" ->
+    on_msg_kick t chn tgt (concat_args comment)
   | "MODE", tgt :: args when tgt <> "" -> on_msg_mode t tgt args
-  | ("USER" | "JOIN" | "NAMES" | "PART" | "MODE") as cmd, _ ->
+  | ("USER" | "JOIN" | "NAMES" | "PART" | "KICK" | "MODE") as cmd, _ ->
     Error (needmoreparams cmd)
   | cmd, _ ->
     Error (unknowncommand cmd)
@@ -638,6 +672,12 @@ let split_command_params cmd params =
     (* TODO: "JOIN" should be handled specially *)
     String.split_on_char ',' tgts |>
     List.map (fun tgt -> cmd, tgt :: rest)
+
+  | "KICK", chan :: tgts :: rest
+    when String.contains tgts ',' ->
+    String.split_on_char ',' tgts |>
+    List.map (fun tgt -> "KICK", chan :: tgt :: rest)
+
   | _ ->
     [cmd, params]
 

lib/server/user.ml

@@ -31,5 +31,8 @@ let is_registered t ~router = Hashtbl.mem router.users t.nick_key
 let prefix t =
   Irc.Msg.User_prefix (t.nick, Some t.userinfo)
 
+let membership t =
+  Dllist.fold_r (fun m xs -> m :: xs) t.membership []
+
 let channels t =
   Dllist.fold_r (fun m xs -> m.mem_chan :: xs) t.membership []