move MODE handling above JOIN, make set_or_unset a polyvar
This commit is contained in:
parent
6824f95a6f
commit
2ddd0bc827
|
|
@ -158,26 +158,27 @@ module Parse = struct
|
|||
~add:(fun ms m -> Set.{ add = add m ms.add; rem = remove m ms.rem })
|
||||
~rem:(fun ms m -> Set.{ add = remove m ms.add; rem = add m ms.rem })
|
||||
|
||||
type ('a, 'b) set_or_unset =
|
||||
| Set of 'a
|
||||
| Unset of 'b
|
||||
type 'a set_or_unset = [
|
||||
| `set of 'a
|
||||
| `unset
|
||||
]
|
||||
|
||||
type chan_modes = {
|
||||
chan_modes : Set.change;
|
||||
chan_key : (string, string) set_or_unset option;
|
||||
chan_limit : (int, unit) set_or_unset option;
|
||||
chan_key : string set_or_unset option;
|
||||
chan_limit : int set_or_unset option;
|
||||
}
|
||||
|
||||
let chan_modes_add (args, modes) = function
|
||||
| `k ->
|
||||
(* type B *)
|
||||
let key, args = take args in
|
||||
let chan_key = Some (Set key) in
|
||||
let chan_key = Some (`set key) in
|
||||
args, { modes with chan_key }
|
||||
| `l ->
|
||||
(* type C *)
|
||||
let lim, args = take_int args in
|
||||
let chan_limit = Some (Set lim) in
|
||||
let limit, args = take_int args in
|
||||
let chan_limit = Some (`set limit) in
|
||||
args, { modes with chan_limit }
|
||||
| `b | `o | `v -> fail "TODO: + ban/op/voice"
|
||||
| #chan_d as m ->
|
||||
|
|
@ -190,12 +191,12 @@ module Parse = struct
|
|||
let chan_modes_rem (args, modes) = function
|
||||
| `k ->
|
||||
(* type B *)
|
||||
let key, args = take args in
|
||||
let chan_key = Some (Unset key) in
|
||||
let _key, args = take args in
|
||||
let chan_key = Some `unset in
|
||||
args, { modes with chan_key }
|
||||
| `l ->
|
||||
(* type C *)
|
||||
let chan_limit = Some (Unset ()) in
|
||||
let chan_limit = Some `unset in
|
||||
args, { modes with chan_limit }
|
||||
| `b | `o | `v -> fail "TODO: - ban/op/voice"
|
||||
| #chan_d as m ->
|
||||
|
|
|
|||
|
|
@ -73,15 +73,16 @@ module Parse : sig
|
|||
|
||||
type user_modes = Set.change
|
||||
|
||||
type ('a, 'b) set_or_unset =
|
||||
| Set of 'a
|
||||
| Unset of 'b
|
||||
type 'a set_or_unset = [
|
||||
| `set of 'a
|
||||
| `unset
|
||||
]
|
||||
|
||||
type chan_modes = {
|
||||
chan_modes : Set.change;
|
||||
chan_key : (string, string) set_or_unset option;
|
||||
chan_limit : (int, unit) set_or_unset option;
|
||||
(* TODO: bad, op, voice *)
|
||||
chan_key : string set_or_unset option;
|
||||
chan_limit : int set_or_unset option;
|
||||
(* TODO: ban, op, voice *)
|
||||
}
|
||||
|
||||
val user_modes : string -> user_modes
|
||||
|
|
|
|||
|
|
@ -125,113 +125,6 @@ let on_msg_quit t reason =
|
|||
Ok ()
|
||||
|
||||
|
||||
(* messages and channels *)
|
||||
|
||||
let on_msg_privmsg t name txt =
|
||||
let* me = require_registered t in
|
||||
let* tgt =
|
||||
try
|
||||
match Irc.name_type name with
|
||||
| `chan -> Ok (`chan (Router.find_chan t.router name))
|
||||
| _ -> Ok (`user (Router.find_user t.router name))
|
||||
with Not_found ->
|
||||
Error (nosuchnick name)
|
||||
in
|
||||
(* TODO: check if user is away *)
|
||||
(* TODO: check if channel is +n and user is not a member *)
|
||||
(* TODO: check if channel is +m and user is not priviledged *)
|
||||
(* TODO: check if channel is +b <user> *)
|
||||
let name, dst =
|
||||
match tgt with
|
||||
| `chan c -> Chan.name c, [`to_chan c]
|
||||
| `user u -> User.nick u, [`to_user u]
|
||||
in
|
||||
let msg = Irc.Msg.make "PRIVMSG" [name; txt] ~always_trailing:true in
|
||||
Router.relay msg ~from:me dst;
|
||||
Ok ()
|
||||
|
||||
let list_names t chan =
|
||||
begin
|
||||
List.iter
|
||||
(fun user ->
|
||||
(* TODO: check if user is +i and not in channel with them *)
|
||||
reply t ("353", ["@"; Chan.name chan; User.nick user]))
|
||||
(Chan.members chan);
|
||||
reply t ("366", [Chan.name chan; "End of NAMES list"])
|
||||
end
|
||||
|
||||
let on_msg_names t name =
|
||||
let* _me = require_registered t in
|
||||
let* chan =
|
||||
try
|
||||
match Irc.name_type name with
|
||||
| `chan -> Ok (Router.find_chan t.router name)
|
||||
| _ -> Error (nosuchchannel name)
|
||||
with Not_found ->
|
||||
Error (nosuchchannel name)
|
||||
in
|
||||
(* TODO: check if channel is +s and user not member of channel *)
|
||||
list_names t chan;
|
||||
Ok ()
|
||||
|
||||
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 *)
|
||||
let* chan =
|
||||
try
|
||||
match Irc.name_type name with
|
||||
| `chan -> Ok (Router.find_chan t.router name)
|
||||
| _ -> Error (nosuchchannel name)
|
||||
with Not_found ->
|
||||
debug (fun m -> m "making new channel %S" name);
|
||||
Ok (Chan.make ~name)
|
||||
in
|
||||
|
||||
(* 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 ()
|
||||
|
||||
let on_msg_part t name =
|
||||
let* me = require_registered t in
|
||||
(* TODO: part reason *)
|
||||
let* chan =
|
||||
try
|
||||
match Irc.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* () = if Chan.is_member chan me then Ok () else Error (notonchannel name) in
|
||||
let msg = Irc.Msg.make "PART" [name] in
|
||||
Router.relay msg ~from:me [`to_chan chan; `to_self];
|
||||
Chan.part chan me;
|
||||
if Chan.no_members chan then begin
|
||||
debug (fun m -> m "recycling channel %S" name);
|
||||
Chan.unregister chan ~router:t.router;
|
||||
end;
|
||||
Ok ()
|
||||
|
||||
|
||||
(* modes *)
|
||||
|
||||
let set_user_mode user chg =
|
||||
|
|
@ -259,13 +152,13 @@ let set_chan_mode chan ~from chg =
|
|||
end
|
||||
|
||||
let set_chan_key chan ~from = function
|
||||
| Irc.Mode.Parse.Set key ->
|
||||
| `set key ->
|
||||
let msg = Irc.Msg.make "MODE" [Chan.name chan; "+k"; key] ~always_trailing:true in
|
||||
begin
|
||||
Router.relay msg ~from [`to_chan chan; `to_self];
|
||||
Chan.set_key chan (Some key);
|
||||
end
|
||||
| Irc.Mode.Parse.Unset _key ->
|
||||
| `unset ->
|
||||
if Chan.key chan <> None then
|
||||
let msg = Irc.Msg.make "MODE" [Chan.name chan; "-k"; "*"] in
|
||||
begin
|
||||
|
|
@ -274,14 +167,14 @@ let set_chan_key chan ~from = function
|
|||
end
|
||||
|
||||
let set_chan_limit chan ~from = function
|
||||
| Irc.Mode.Parse.Set lim ->
|
||||
| `set lim ->
|
||||
if Chan.limit chan <> Some lim then
|
||||
let msg = Irc.Msg.make "MODE" [Chan.name chan; "+l"; string_of_int lim] in
|
||||
begin
|
||||
Router.relay msg ~from [`to_chan chan; `to_self];
|
||||
Chan.set_limit chan (Some lim);
|
||||
end
|
||||
| Irc.Mode.Parse.Unset () ->
|
||||
| `unset ->
|
||||
if Chan.limit chan <> None then
|
||||
let msg = Irc.Msg.make "MODE" [Chan.name chan; "-l"] in
|
||||
begin
|
||||
|
|
@ -296,7 +189,7 @@ let on_get_user_mode user me =
|
|||
]
|
||||
|
||||
let on_set_user_mode user me modestr _args =
|
||||
let* () = if user != me then Error usersdontmatch_set else Ok () in
|
||||
let* () = if user == me then Ok () else Error usersdontmatch_set in
|
||||
let* chg = try Ok (Irc.Mode.Parse.user_modes modestr)
|
||||
with Irc.Mode.Parse.Error ->
|
||||
(* TODO: "If one or more modes sent are not implemented on the server, the server
|
||||
|
|
@ -308,7 +201,7 @@ let on_set_user_mode user me modestr _args =
|
|||
Ok []
|
||||
|
||||
let on_get_chan_mode chan _me =
|
||||
let rpls =[
|
||||
let rpls = [
|
||||
["324", [Chan.name chan; Fmt.str "+%a" Irc.Mode.Set.pp (Chan.mode chan)]];
|
||||
|
||||
begin match Chan.limit chan with
|
||||
|
|
@ -371,7 +264,111 @@ let on_msg_mode t name args =
|
|||
in
|
||||
List.iter (reply t) rpls
|
||||
|
||||
let on_msg_join = on_msg_join ~set_chan_mode
|
||||
|
||||
(* messages and channels *)
|
||||
|
||||
let on_msg_privmsg t name txt =
|
||||
let* me = require_registered t in
|
||||
let* tgt =
|
||||
try
|
||||
match Irc.name_type name with
|
||||
| `chan -> Ok (`chan (Router.find_chan t.router name))
|
||||
| _ -> Ok (`user (Router.find_user t.router name))
|
||||
with Not_found ->
|
||||
Error (nosuchnick name)
|
||||
in
|
||||
(* TODO: check if user is away *)
|
||||
(* TODO: check if channel is +n and user is not a member *)
|
||||
(* TODO: check if channel is +m and user is not priviledged *)
|
||||
(* TODO: check if channel is +b <user> *)
|
||||
let name, dst =
|
||||
match tgt with
|
||||
| `chan c -> Chan.name c, [`to_chan c]
|
||||
| `user u -> User.nick u, [`to_user u]
|
||||
in
|
||||
let msg = Irc.Msg.make "PRIVMSG" [name; txt] ~always_trailing:true in
|
||||
Router.relay msg ~from:me dst;
|
||||
Ok ()
|
||||
|
||||
let list_names t chan =
|
||||
begin
|
||||
List.iter
|
||||
(fun user ->
|
||||
(* TODO: check if user is +i and not in channel with them *)
|
||||
reply t ("353", ["@"; Chan.name chan; User.nick user]))
|
||||
(Chan.members chan);
|
||||
reply t ("366", [Chan.name chan; "End of NAMES list"])
|
||||
end
|
||||
|
||||
let on_msg_names t name =
|
||||
let* _me = require_registered t in
|
||||
let* chan =
|
||||
try
|
||||
match Irc.name_type name with
|
||||
| `chan -> Ok (Router.find_chan t.router name)
|
||||
| _ -> Error (nosuchchannel name)
|
||||
with Not_found ->
|
||||
Error (nosuchchannel name)
|
||||
in
|
||||
(* TODO: check if channel is +s and user not member of channel *)
|
||||
list_names t chan;
|
||||
Ok ()
|
||||
|
||||
let on_msg_join t name =
|
||||
let* me = require_registered t in
|
||||
(* TODO: keys parameter *)
|
||||
(* TODO: "0" parameter means part from all channels *)
|
||||
let* chan =
|
||||
try
|
||||
match Irc.name_type name with
|
||||
| `chan -> Ok (Router.find_chan t.router name)
|
||||
| _ -> Error (nosuchchannel name)
|
||||
with Not_found ->
|
||||
debug (fun m -> m "making new channel %S" name);
|
||||
Ok (Chan.make ~name)
|
||||
in
|
||||
|
||||
(* 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 {
|
||||
add = Irc.Mode.Set.of_string initial_chan_modestr;
|
||||
rem = Irc.Mode.Set.empty;
|
||||
};
|
||||
(* TODO: make founder +o / +q etc. *)
|
||||
end;
|
||||
|
||||
(* TODO: send channel topic *)
|
||||
list_names t chan;
|
||||
Ok ()
|
||||
|
||||
let on_msg_part t name =
|
||||
let* me = require_registered t in
|
||||
(* TODO: part reason *)
|
||||
let* chan =
|
||||
try
|
||||
match Irc.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* () = if Chan.is_member chan me then Ok () else Error (notonchannel name) in
|
||||
let msg = Irc.Msg.make "PART" [name] in
|
||||
Router.relay msg ~from:me [`to_chan chan; `to_self];
|
||||
Chan.part chan me;
|
||||
if Chan.no_members chan then begin
|
||||
debug (fun m -> m "recycling channel %S" name);
|
||||
Chan.unregister chan ~router:t.router;
|
||||
end;
|
||||
Ok ()
|
||||
|
||||
|
||||
(* user registration *)
|
||||
|
|
|
|||
Loading…
Reference in New Issue