neale
/
irc-bot
mirror of https://github.com/nealey/irc-bot
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

More modules, now parsing commands 

This is where I realized that there's no point in passing around a
"server" object, since it's entirely reasonable to expect one server
per running instance.
This commit is contained in:
Neale Pickett 2008-02-28 22:00:24 -07:00
parent ef64cd9f8a
commit 4b2a60ec71
12 changed files with 252 additions and 202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
OMakefile
View File

@ -6,7 +6,7 @@ OCAMLPACKS[] =
.DEFAULT: ircd
OCamlProgram(ircd, ircd irc client server)
OCamlProgram(ircd, ircd irc command client channel)
section
OCAMLPACKS[] +=
@ -16,7 +16,7 @@ section
tests.cmi:
tests$(EXT_OBJ):
OCamlProgram(tests, tests chat ircd irc client server)
OCamlProgram(tests, tests chat ircd irc command client channel)
.PHONY: clean
clean:

9
channel.ml Normal file
View File

@ -0,0 +1,9 @@
type t = {name: string}
let by_name = Hashtbl.create 25
let lookup name =
Hashtbl.find by_name name
let create name =
{name = name}

4
channel.mli Normal file
View File

@ -0,0 +1,4 @@
type t
val create : string -> t
val lookup : string -> t

91
client.ml
View File

@ -3,11 +3,33 @@ open Irc
(* ==========================================
* Client stuff
*)
type t = {outq: Command.t Queue.t;
unsent: string ref;
ibuf: string;
ibuf_len: int ref;
output_ready: unit -> unit;
handle_command: t -> Command.t -> unit;
nick: string ref;
username: string ref;
realname: string ref}
let by_file_descr = Hashtbl.create 25
let by_nick = Hashtbl.create 25
let ibuf_max = 4096
let max_outq = 50
let obuf_max = 4096
let shutdown ues g fd =
let lookup nick =
Hashtbl.find by_nick nick
let lookup_fd fd =
Hashtbl.find by_file_descr fd
let close cli ues g fd =
Hashtbl.remove by_nick !(cli.nick);
Hashtbl.remove by_file_descr fd;
Unix.close fd;
Unixqueue.remove_resource ues g (Unixqueue.Wait_in fd);
try
@ -15,25 +37,33 @@ let shutdown ues g fd =
with Not_found ->
()
let write cli line =
let write cli cmd =
let was_empty = Queue.is_empty cli.outq in
Queue.add line cli.outq;
Queue.add cmd cli.outq;
if was_empty then
cli.output_ready ()
let handle_close srv cli =
let handle_close cli =
()
let handle_command_login srv cli command =
let handle_command cli command =
()
let handle_command_login cli cmd =
(* Handle a command during the login phase *)
match command.command with
| "USER"
| "NICK" ->
()
match (Command.as_tuple cmd) with
| (None, "USER", [username], Some realname) ->
cli.username := username;
cli.realname := Irc.truncate realname 40
| (None, "NICK", [nick], None) ->
cli.nick := nick
| _ ->
print_endline "NO CAN DO SIR"
write cli (Command.create
~sender:(Some !Irc.name)
~text:(Some "Register first.")
"451" ["*"])
let rec handle_input srv cli =
let rec handle_input cli =
match cli.ibuf with
| "" ->
()
@ -44,31 +74,40 @@ let rec handle_input srv cli =
raise Not_found;
cli.ibuf_len := !(cli.ibuf_len) - (p + 1);
String.blit ibuf (p + 1) ibuf 0 !(cli.ibuf_len);
let parsed = Irc.command_of_string s in
cli.handle_command srv cli parsed;
handle_input srv cli
let parsed = Command.from_string s in
cli.handle_command cli parsed;
handle_input cli
let create_event_handler srv =
fun ues esys e ->
let handle_event ues esys e =
match e with
| Unixqueue.Input_arrived (g, fd) ->
let cli = Server.get_client_by_file_descr srv fd in
let cli = lookup_fd fd in
let size = ibuf_max - !(cli.ibuf_len) in
let len = Unix.read fd cli.ibuf !(cli.ibuf_len) size in
if (len > 0) then
begin
cli.ibuf_len := !(cli.ibuf_len) + len;
try
handle_input srv cli
handle_input cli
with Not_found ->
if (!(cli.ibuf_len) = ibuf_max) then
(* No newline found, and the buffer is full *)
raise (Failure "Buffer overrun");
end
else
shutdown ues g fd
close cli ues g fd
| Unixqueue.Output_readiness (g, fd) ->
print_endline "out"
(* XXX: Could be optimized to try and fill the output buffer *)
let cli = lookup_fd fd in
let buf =
if (!(cli.unsent) = "") then
let cmd = Queue.pop cli.outq in
Command.as_string cmd
else
!(cli.unsent)
in
let n = Unix.single_write fd buf 0 (String.length buf) in
cli.unsent := Str.string_after buf n
| Unixqueue.Out_of_band (g, fd) ->
print_endline "oob"
| Unixqueue.Timeout (g, op) ->
@ -80,6 +119,7 @@ let create_event_handler srv =
let create ues g fd =
let cli =
{outq = Queue.create ();
unsent = ref "";
ibuf = String.create ibuf_max;
@ -89,5 +129,14 @@ let create ues g fd =
fun () -> Unixqueue.add_resource ues g (Unixqueue.Wait_out fd, -.1.0)
end;
handle_command = handle_command_login;
channels = []}
nick = ref "";
username = ref "";
realname = ref ""}
in
Hashtbl.replace by_file_descr fd cli;
cli
let set_nick cli nick =
Hashtbl.remove by_nick !(cli.nick);
Hashtbl.replace by_nick nick cli;
cli.nick := nick

9
client.mli
View File

@ -1,5 +1,8 @@
val create : Unixqueue.event_system -> Unixqueue.group -> Unix.file_descr -> Irc.client
val create_event_handler : Irc.server -> (Unixqueue.event_system -> Unixqueue.event Equeue.t -> Unixqueue.event -> unit)
val write : Irc.client -> string list -> unit
type t
val create : Unixqueue.event_system -> Unixqueue.group -> Unix.file_descr -> t
val lookup : string -> t
val write : t -> Command.t -> unit
val handle_event : Unixqueue.event_system -> Unixqueue.event Equeue.t -> Unixqueue.event -> unit

83
command.ml Normal file
View File

@ -0,0 +1,83 @@
type t = {sender: string option;
name: string;
args: string list;
text: string option}
let create ?(sender=None) ?(text=None) name args =
{sender = sender;
name = name;
args = args;
text = text}
let as_string cmd =
let ret = Buffer.create 120 in
(match cmd.sender with
| None ->
()
| Some s ->
Buffer.add_char ret ':';
Buffer.add_string ret s;
Buffer.add_char ret ' ');
Buffer.add_string ret cmd.name;
(match cmd.args with
| [] ->
()
| l ->
Buffer.add_char ret ' ';
Buffer.add_string ret (String.concat " " l));
(match cmd.text with
| None ->
()
| Some txt ->
Buffer.add_string ret " :";
Buffer.add_string ret txt);
Buffer.contents ret
let extract_word s =
try
let pos = String.index s ' ' in
(Str.string_before s pos, Str.string_after s (pos + 1))
with Not_found ->
(s, "")
let rec from_string line =
(* Very simple. Pull out words until you get one starting with ":".
The very first word might start with ":", that doesn't count
because it's the sender.. *)
let rec loop sender acc line =
let c = (if (line = "") then None else (Some line.[0])) in
match (c, acc) with
| (None, cmd :: args) ->
(* End of line, no text part *)
{sender = sender;
name = cmd;
args = args;
text = None}
| (None, []) ->
(* End of line, no text part, no args, no command *)
raise (Failure "No command, eh?")
| (Some ':', []) ->
(* First word, starts with ':' *)
let (word, rest) = extract_word line in
loop (Some (Str.string_after word 1)) acc rest
| (Some ':', cmd :: args) ->
(* Not first word, starts with ':' *)
{sender = sender;
name = cmd;
args = args;
text = Some (Str.string_after line 1)}
| (Some _, _) ->
(* Argument *)
let (word, rest) = extract_word line in
loop sender (acc @ [word]) rest
in
loop None [] line
let as_tuple cmd =
(cmd.sender, cmd.name, cmd.args, cmd.text)
let sender cmd = cmd.sender
let name cmd = cmd.name
let args cmd = cmd.args
let text cmd = cmd.text

11
command.mli Normal file
View File

@ -0,0 +1,11 @@
type t
val create : ?sender:string option -> ?text:string option -> string -> string list -> t
val from_string : string -> t
val as_string : t -> string
val as_tuple : t -> (string option * string * string list * string option)
val sender : t -> string option
val name : t -> string
val args : t -> string list
val text : t -> string option

76
irc.ml
View File

@ -1,19 +1,4 @@
type command = {sender: string option;
command: string;
args: string list;
text: string option}
type server = {clients_by_name: (string, client) Hashtbl.t;
clients_by_file_descr: (Unix.file_descr, client) Hashtbl.t;
channels_by_name: (string, channel) Hashtbl.t}
and client = {outq: string list Queue.t;
unsent: string ref;
ibuf: string;
ibuf_len: int ref;
output_ready: unit -> unit;
handle_command: server -> client -> command -> unit;
channels: channel list}
and channel = {name: string}
let name = ref "irc.test"
let newline_re = Pcre.regexp "\n\r?"
let argsep_re = Pcre.regexp " :"
@ -49,56 +34,9 @@ let uppercase_char c =
let uppercase s = string_map uppercase_char s
let lowercase s = string_map lowercase_char s
let extract_word s =
try
let pos = String.index s ' ' in
(Str.string_before s pos, Str.string_after s (pos + 1))
with Not_found ->
(s, "")
let string_list_of_command cmd =
([] @
(match cmd.sender with
| None -> []
| Some s -> [":" ^ s]) @
[cmd.command] @
cmd.args @
(match cmd.text with
| None -> []
| Some s -> [":" ^ s]))
let string_of_command cmd =
String.concat " " (string_list_of_command cmd)
let rec command_of_string line =
(* Very simple. Pull out words until you get one starting with ":".
The very first word might start with ":", that doesn't count
because it's the sender.. *)
let rec loop sender acc line =
let c = (if (line = "") then None else (Some line.[0])) in
match (c, acc) with
| (None, cmd :: args) ->
(* End of line, no text part *)
{sender = sender;
command = cmd;
args = args;
text = None}
| (None, []) ->
(* End of line, no text part, no args, no command *)
raise (Failure "No command, eh?")
| (Some ':', []) ->
(* First word, starts with ':' *)
let (word, rest) = extract_word line in
loop (Some (Str.string_after word 1)) acc rest
| (Some ':', cmd :: args) ->
(* Not first word, starts with ':' *)
{sender = sender;
command = cmd;
args = args;
text = Some (Str.string_after line 1)}
| (Some _, _) ->
(* Argument *)
let (word, rest) = extract_word line in
loop sender (acc @ [word]) rest
in
loop None [] line
let truncate s len =
let slen = String.length s in
if len >= slen then
s
else
Str.string_before s (min slen len)

21
irc.mli
View File

@ -1,21 +1,4 @@
type command = {sender: string option;
command: string;
args: string list;
text: string option}
type server = {clients_by_name: (string, client) Hashtbl.t;
clients_by_file_descr: (Unix.file_descr, client) Hashtbl.t;
channels_by_name: (string, channel) Hashtbl.t}
and client = {outq: string list Queue.t;
unsent: string ref;
ibuf: string;
ibuf_len: int ref;
output_ready: unit -> unit;
handle_command: server -> client -> command -> unit;
channels: channel list}
and channel = {name: string}
val name : string ref
val uppercase : string -> string
val lowercase : string -> string
val command_of_string : string -> command
val string_of_command : command -> string
val truncate : string -> int -> string

9
ircd.ml
View File

@ -25,16 +25,13 @@ let establish_server ues connection_handler addr =
Unixqueue.add_resource ues g (Unixqueue.Wait_in srv, -.1.0)
let main () =
let srv = Server.create () in
let handle_event = Client.create_event_handler srv in
let ues = Unixqueue.create_unix_event_system () in
let g = Unixqueue.new_group ues in
let handle_connection fd =
let cli = Client.create ues g fd in
Hashtbl.replace srv.Irc.clients_by_file_descr fd cli;
Unixqueue.add_resource ues g (Unixqueue.Wait_in fd, -.1.0);
ignore (Client.create ues g fd);
Unixqueue.add_resource ues g (Unixqueue.Wait_in fd, -.1.0)
in
Unixqueue.add_handler ues g handle_event;
Unixqueue.add_handler ues g Client.handle_event;
establish_server
ues
handle_connection

18
server.ml
View File

@ -1,18 +0,0 @@
open Irc
(* ==========================================
* Server stuff
*)
let create () =
{clients_by_name = Hashtbl.create 25;
clients_by_file_descr = Hashtbl.create 25;
channels_by_name = Hashtbl.create 10}
let get_client_by_name srv name =
Hashtbl.find srv.clients_by_name name
let get_client_by_file_descr srv fd =
Hashtbl.find srv.clients_by_file_descr fd
let get_channel_by_name srv name =
Hashtbl.find srv.channels_by_name name

37
tests.ml
View File

@ -5,12 +5,9 @@ open Irc
let do_chat script () =
let ircd_instance ues fd =
let srv = Server.create () in
let handle_event = Client.create_event_handler srv in
let g = Unixqueue.new_group ues in
let cli = Client.create ues g fd in
Hashtbl.replace srv.Irc.clients_by_file_descr fd cli;
Unixqueue.add_handler ues g handle_event;
ignore (Client.create ues g fd);
Unixqueue.add_handler ues g Client.handle_event;
Unixqueue.add_resource ues g (Unixqueue.Wait_in fd, -.1.0)
in
chat script ircd_instance
@ -21,26 +18,20 @@ let unit_tests =
"command_of_string" >::
(fun () ->
assert_equal
~printer:string_of_command
{sender = None;
command = "NICK";
args = ["name"];
text = None}
(command_of_string "NICK name");
~printer:Command.as_string
(Command.create "NICK" ["name"])
(Command.from_string "NICK name");
assert_equal
~printer:string_of_command
{sender = Some "foo";
command = "NICK";
args = ["name"];
text = None}
(command_of_string ":foo NICK name");
~printer:Command.as_string
(Command.create ~sender:(Some "foo") "NICK" ["name"])
(Command.from_string ":foo NICK name");
assert_equal
~printer:string_of_command
{sender = Some "foo.bar";
command = "PART";
args = ["#foo"; "#bar"];
text = Some "ta ta"}
(command_of_string ":foo.bar PART #foo #bar :ta ta");
~printer:Command.as_string
(Command.create
~sender:(Some "foo.bar")
~text:(Some "ta ta")
"PART" ["#foo"; "#bar"])
(Command.from_string ":foo.bar PART #foo #bar :ta ta");
)
]