This commit is contained in:
Neale Pickett 2008-05-09 08:01:11 -06:00
parent 68428d8347
commit fce7bc36d5
7 changed files with 70 additions and 11 deletions

View File

@ -8,11 +8,11 @@ type client = Iobuf.t * Irc.nuhost
type t = {name: string; type t = {name: string;
modes: string ref; modes: string ref;
clients: client String_map.t} clients: client String_map.t ref}
let modes = "aimnqpsrtklb" let modes = "aimnqpsrtklb"
let channels = String_map.empty let by_name = ref String_map.empty
let is_channel_name name = let is_channel_name name =
match name.[0] with match name.[0] with
@ -24,7 +24,54 @@ let is_channel_name name =
let has_mode chan mode = let has_mode chan mode =
String.contains !(chan.modes) mode String.contains !(chan.modes) mode
let handle_command iobuf (nick, username, hostname) cmd = (* Channels handle:
NICK, MODE, JOIN, PART, QUIT, TOPIC, NAMES, LIST, INVITE, KICK, PRIVMSG, NOTICE
*)
let write iobuf command args text =
Iobuf.write iobuf (Command.create (Some !(Irc.name)) command args text)
let broadcast ?(metoo=false) chan sender command args text =
let sender_iobuf, sender_nuhost = sender in
let cmd =
Command.create
(Some (Irc.string_of_nuhost sender_nuhost))
command
args
text
in
let bwrite _ (iobuf, nuhost) =
if (metoo || (nuhost <> sender_nuhost)) then
Iobuf.write iobuf cmd
in
String_map.iter bwrite !(chan.clients)
let reply iobuf nick num ?(args=[]) text =
write iobuf num (nick :: args) (Some text)
let handle_command cli nuhost cmd =
match (Command.as_tuple cmd) with match (Command.as_tuple cmd) with
| (None, "JOIN", ["0"], None) ->
(* Leave all channels *)
failwith "XXX: JOIN 0"
| (None, "JOIN", [name], None) ->
let nick = Irc.nick nuhost in
let chan =
try
String_map.find name !by_name
with Not_found ->
let c = {name = name; modes = ref ""; clients = ref String_map.empty} in
by_name := String_map.add name c !by_name;
c
in
if String_map.mem nick !(chan.clients) then
(* Apparently we're expected to drop the command *)
()
else
let me = (cli, nuhost) in
chan.clients := String_map.add nick me !(chan.clients);
broadcast ~metoo:true chan me "JOIN" [name] None
| _ -> | _ ->
() ()

View File

@ -1,10 +1,5 @@
type t type t
(* Channels handle:
MODE, JOIN, PART, TOPIC, NAMES, LIST, INVITE, KICK, PRIVMSG, NOTICE
*)
val modes : string val modes : string
val handle_command : Iobuf.t -> Irc.nuhost -> Command.t -> unit val handle_command : Iobuf.t -> Irc.nuhost -> Command.t -> unit

View File

@ -36,7 +36,7 @@ let write cli sender name args text =
write_command cli (Command.create sender name args text) write_command cli (Command.create sender name args text)
let reply cli num ?(args=[]) text = let reply cli num ?(args=[]) text =
write cli (Some !(Irc.name)) num ([!(cli.nick)] @ args) (Some text) write cli (Some !(Irc.name)) num (!(cli.nick) :: args) (Some text)
let handle_error cli iobuf message = let handle_error cli iobuf message =
Hashtbl.remove by_nick !(cli.nick) Hashtbl.remove by_nick !(cli.nick)
@ -58,7 +58,8 @@ let handle_command cli iobuf cmd =
| (None, "JOIN", ["0"], None) -> | (None, "JOIN", ["0"], None) ->
() ()
| (None, "JOIN", [channels], None) -> | (None, "JOIN", [channels], None) ->
() let nuhost = (!(cli.nick), cli.username, (Iobuf.addr cli.iobuf)) in
Channel.handle_command cli.iobuf nuhost cmd
| (None, "JOIN", [channels; keys], None) -> | (None, "JOIN", [channels; keys], None) ->
() ()
| (None, "PART", [channels], message) -> | (None, "PART", [channels], message) ->

5
irc.ml
View File

@ -40,3 +40,8 @@ let truncate s len =
s s
else else
Str.string_before s (min slen len) Str.string_before s (min slen len)
let string_of_nuhost (nick, user, host) = nick ^ "!" ^ user ^ "@" ^ host
let nick (nick, user, host) = nick
let user (nick, user, host) = user
let host (nick, user, host) = host

View File

@ -1,3 +1,4 @@
(** (Nickname, username, hostname) tuple *) (** (Nickname, username, hostname) tuple *)
type nuhost = (string * string * string) type nuhost = (string * string * string)
@ -8,3 +9,8 @@ val start_time : float
val uppercase : string -> string val uppercase : string -> string
val lowercase : string -> string val lowercase : string -> string
val truncate : string -> int -> string val truncate : string -> int -> string
val string_of_nuhost : nuhost -> string
val nick : nuhost -> string
val user : nuhost -> string
val host : nuhost -> string

View File

@ -26,7 +26,7 @@ let establish_server d connection_handler addr =
Unix.bind srv addr; Unix.bind srv addr;
Unix.listen srv 50; Unix.listen srv 50;
Unix.setsockopt srv Unix.SO_REUSEADDR true; Unix.setsockopt srv Unix.SO_REUSEADDR true;
Dispatch.add d fd handle_event [Dispatch.Input]; Dispatch.add d fd handle_event [Dispatch.Input]
let main () = let main () =
let d = Dispatch.create 50 in let d = Dispatch.create 50 in

View File

@ -414,7 +414,10 @@ let regression_tests =
[ [
Send "ISON bob\r\n"; Send "ISON bob\r\n";
Recv ":testserver.test 303 alice :bob\r\n"; Recv ":testserver.test 303 alice :bob\r\n";
Send "JOIN #foo\r\n";
Recv ":alice!alice@UDS JOIN #foo\r\n";
Send "PRIVMSG bob :Hi Bob!\r\n"; Send "PRIVMSG bob :Hi Bob!\r\n";
Recv ":bob!bob@UDS JOIN #foo\r\n";
Send "QUIT :foo\r\n"; Send "QUIT :foo\r\n";
Recv ":testserver.test ERROR :So long\r\n"; Recv ":testserver.test ERROR :So long\r\n";
] ]
@ -425,6 +428,8 @@ let regression_tests =
Send "ISON alice\r\n"; Send "ISON alice\r\n";
Recv ":testserver.test 303 bob :alice\r\n"; Recv ":testserver.test 303 bob :alice\r\n";
Recv ":alice!alice@UDS PRIVMSG bob :Hi Bob!\r\n"; Recv ":alice!alice@UDS PRIVMSG bob :Hi Bob!\r\n";
Send "JOIN #foo\r\n";
Recv ":bob!bob@UDS JOIN #foo\r\n";
Send "QUIT :foo\r\n"; Send "QUIT :foo\r\n";
Recv ":testserver.test ERROR :So long\r\n"; Recv ":testserver.test ERROR :So long\r\n";
] ]