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

Attempt to get QUIT command (rewrites of some stuff)

This commit is contained in:
Neale Pickett 2008-03-18 17:20:44 -06:00
parent 667062bf93
commit 8616bb1f80
7 changed files with 75 additions and 254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
OMakefile
View File

@ -7,7 +7,7 @@ OCAMLCFLAGS += -g
StaticCLibrary(ocamlepoll, epoll_wrapper)
OCamlProgram(ircd, ircd irc command iobuf client channel)
OCamlProgram(ircd, ircd irc command iobuf dispatch client channel)
section
OCAMLPACKS[] +=

188
chat.ml
View File

@ -1,188 +0,0 @@
open Unixqueue
exception Buffer_overrun
type chat_event =
| Send of string
| Recv of string
| Regex of string
exception Chat_match of (string * chat_event)
exception Chat_timeout of chat_event
let dbg msg a = prerr_endline msg; a
let string_of_chat_event e =
match e with
| Send str ->
("Send (\"" ^ (String.escaped str) ^ "\")")
| Recv str ->
("Recv (\"" ^ (String.escaped str) ^ "\")")
| Regex str ->
("Regex (\"" ^ (String.escaped str) ^ "\")")
(** Return true if str starts with substr *)
let startswith str substr =
let l = String.length substr in
if l > String.length str then
false
else
String.sub str 0 l = substr
(** Return all but the first index chars in a string *)
let string_after str index =
let l = String.length str in
String.sub str index (l - index)
(** Read a chunk of bytes from fd *)
let read_fd fd =
let s = 4096 in
let buf = String.create s in
let len = Unix.read fd buf 0 s in
String.sub buf 0 len
class chat_handler chatscript
?(input_timeout=0.1)
?(output_timeout = 0.1)
?(output_max = 4096)
?(input_max = 4096)
(ues : unix_event_system) fd =
object (self)
val g = ues#new_group ()
val mutable debug = false
val obuf = String.create output_max
val mutable obuf_len = 0
val mutable script = chatscript
val inbuf = Buffer.create 4096
initializer
ues#add_handler g self#handle_event;
ues#add_resource g (Wait_in fd, input_timeout);
self#run_script ();
method write data =
let data_len = String.length data in
if (data_len + obuf_len > output_max) then
raise Buffer_overrun;
String.blit data 0 obuf obuf_len data_len;
obuf_len <- obuf_len + data_len;
ues#add_resource g (Wait_out fd, output_timeout)
method handle_event ues esys e =
match e with
| Input_arrived (g, fd) ->
let data = String.create input_max in
let len = Unix.read fd data 0 input_max in
if (len > 0) then
begin
Buffer.add_string inbuf (String.sub data 0 len);
self#run_script ()
end
else
begin
Unix.close fd;
ues#clear g;
end
| Output_readiness (g, fd) ->
let size = obuf_len in
let n = Unix.single_write fd obuf 0 size in
obuf_len <- obuf_len - n;
if (obuf_len = 0) then
(* Don't check for output readiness anymore *)
begin
ues#remove_resource g (Wait_out fd)
end
else
(* Put unwritten output back into the output queue *)
begin
String.blit obuf n obuf 0 (obuf_len)
end
| Out_of_band (g, fd) ->
raise (Failure "Out of band data")
| Timeout (g, op) ->
raise (Chat_timeout (List.hd script))
| Signal ->
raise (Failure "Signal")
| Extra exn ->
raise (Failure "Extra")
method run_script () =
match script with
| [] ->
Unix.close fd;
ues#clear g
| Send buf :: tl ->
self#write buf;
script <- tl;
self#run_script ()
| Recv buf :: tl ->
let buf_len = String.length buf in
let inbuf_str = Buffer.contents inbuf in
if (Buffer.length inbuf >= buf_len) then
if startswith inbuf_str buf then
begin
script <- tl;
Buffer.clear inbuf;
Buffer.add_substring
inbuf
inbuf_str
buf_len
((String.length inbuf_str) - buf_len);
self#run_script ()
end
else
raise (Chat_match (inbuf_str, Recv buf))
else
()
| Regex buf :: tl ->
let inbuf_str = Buffer.contents inbuf in
let matched = Str.string_match (Str.regexp buf) inbuf_str 0 in
if (Buffer.length inbuf > 0) then
if matched then
let match_len = Str.match_end () in
script <- tl;
Buffer.clear inbuf;
Buffer.add_substring
inbuf
inbuf_str
match_len
((String.length inbuf_str) - match_len);
self#run_script ()
else
raise (Chat_match (inbuf_str, Regex buf))
else
()
end
let chat_create ues script proc =
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
ignore (proc ues a);
ignore (new chat_handler script ues b)
(** Run a chat script
[chat script proc] will create a Unix domain socket pair, call [proc
ues fd] with the event system and one of the sockets, and then run
[script] through it.
*)
let chat_run ues =
try
Unixqueue.run ues;
with
| Chat_match (got, expected) ->
raise (Failure ("Not matched: got \"" ^
(String.escaped got) ^
"\"\n expected " ^
(string_of_chat_event expected)))
| Chat_timeout evt ->
raise (Failure ("Timeout waiting for " ^
(string_of_chat_event evt)))

40
client.ml
View File

@ -30,17 +30,16 @@ let uhost cli =
let close cli =
Iobuf.close cli.iobuf
let write cli cmd =
let write_command cli cmd =
Iobuf.write cli.iobuf cmd
let reply cli num ?(args=[]) text =
write cli (Command.create
(Some !(Irc.name))
num
([!(cli.nick)] @ args)
(Some text))
let write cli sender name args text =
write_command cli (Command.create sender name args text)
let handle_close cli message =
let reply cli num ?(args=[]) text =
write cli (Some !(Irc.name)) num ([!(cli.nick)] @ args) (Some text)
let handle_error cli iobuf message =
Hashtbl.remove by_nick !(cli.nick)
let handle_command cli iobuf cmd =
@ -51,8 +50,12 @@ let handle_command cli iobuf cmd =
()
| (None, "SERVICE", [nickname; _; distribution; svctype; _], Some info) ->
()
| (None, "QUIT", [], message) ->
()
| (None, "QUIT", [], None) ->
write cli (Some !(Irc.name)) "ERROR" [] (Some "So long");
Iobuf.close iobuf "No reason provided"
| (None, "QUIT", [], Some message) ->
write cli (Some !(Irc.name)) "ERROR" [] (Some "So long");
Iobuf.close iobuf message
| (None, "JOIN", ["0"], None) ->
()
| (None, "JOIN", [channels], None) ->
@ -81,11 +84,7 @@ let handle_command cli iobuf cmd =
begin
try
let peer = lookup target in
write peer (Command.create
(Some (uhost cli))
command
[target]
(Some text))
write peer (Some (uhost cli)) command [target] (Some text)
with Not_found ->
reply cli "401" ~args:[target] "No such nick/channel"
end
@ -131,7 +130,7 @@ let handle_command cli iobuf cmd =
()
| (None, "PING", [], Some text)
| (None, "PING", [text], None) ->
write cli (Command.create (Some !(Irc.name)) "PONG" [!(Irc.name)] (Some text))
write cli (Some !(Irc.name)) "PONG" [!(Irc.name)] (Some text)
| (None, "PONG", [payload], None) ->
()
| (None, "ERROR", [], Some message) ->
@ -189,7 +188,7 @@ let rec handle_command_prereg (nick, username, realname, password) iobuf cmd =
" " ^ Irc.version ^
" " ^ modes ^
" " ^ Channel.modes);
Iobuf.rebind iobuf (handle_command cli) (handle_close cli)
Iobuf.bind iobuf (handle_command cli) (handle_error cli)
with Error cmd ->
Iobuf.write iobuf cmd
in
@ -209,10 +208,9 @@ let rec handle_command_prereg (nick, username, realname, password) iobuf cmd =
username = username;
realname = realname}
| _ ->
Iobuf.rebind iobuf (handle_command_prereg acc) ignore
Iobuf.bind iobuf (handle_command_prereg acc) (fun _ _ -> ())
let handle_connection d fd addr =
let command_handler = handle_command_prereg (None, None, None, None) in
let close_handler = ignore in
Iobuf.bind d fd command_handler close_handler
let handle_command = handle_command_prereg (None, None, None, None) in
Iobuf.create d fd addr handle_command (fun _ _ -> ())

3
client.mli
View File

@ -1,5 +1,6 @@
type t
val write : t -> Command.t -> unit
val write_command : t -> Command.t -> unit
val write : t -> string option -> string -> string list -> string option -> unit
val handle_connection : Dispatch.t -> Unix.file_descr -> Unix.sockaddr -> unit

79
iobuf.ml
View File

@ -7,15 +7,24 @@ type t = {d: Dispatch.t;
unsent: string ref;
ibuf: string;
ibuf_len: int ref;
addr: string;
command_handler: (t -> Command.t -> unit) ref;
close_handler: (string -> unit) ref}
addr: Unix.sockaddr;
handle_command: command_handler ref;
handle_error: error_handler ref;
valid: bool ref}
and command_handler = t -> Command.t -> unit
and error_handler = t -> string -> unit
let ibuf_max = 4096
let max_outq = 50
let obuf_max = 4096
let addr iobuf = iobuf.addr
let addr iobuf =
match iobuf.addr with
| Unix.ADDR_UNIX s ->
"UDS"
| Unix.ADDR_INET (addr, port) ->
Unix.string_of_inet_addr addr
let write iobuf cmd =
let was_empty = Queue.is_empty iobuf.outq in
@ -23,11 +32,6 @@ let write iobuf cmd =
if (was_empty && (!(iobuf.unsent) = "")) then
Dispatch.modify iobuf.d iobuf.fd [Dispatch.Input; Dispatch.Output]
let close iobuf message =
!(iobuf.close_handler) message;
Dispatch.delete iobuf.d iobuf.fd;
Unix.close iobuf.fd
let crlf = Str.regexp "\r?\n"
let handle_input iobuf =
@ -42,11 +46,16 @@ let handle_input iobuf =
String.blit leftover 0 iobuf.ibuf 0 !(iobuf.ibuf_len)
| line :: tl ->
let parsed = Command.from_string line in
!(iobuf.command_handler) iobuf parsed;
!(iobuf.handle_command) iobuf parsed;
loop tl
in
loop lines
let close iobuf message =
!(iobuf.handle_error) iobuf message;
iobuf.valid := false;
Dispatch.modify iobuf.d iobuf.fd [Dispatch.Input; Dispatch.Output]
let rec handle_events iobuf fd events =
match events with
| [] ->
@ -72,11 +81,18 @@ let rec handle_events iobuf fd events =
in
let buflen = String.length buf in
let n = Unix.single_write fd buf 0 buflen in
if n < buflen then
iobuf.unsent := Str.string_after buf n
else if Queue.is_empty iobuf.outq then
Dispatch.modify iobuf.d fd [Dispatch.Input];
handle_events iobuf fd tl
if n < buflen then begin
iobuf.unsent := Str.string_after buf n;
handle_events iobuf fd tl
end else if Queue.is_empty iobuf.outq then
if !(iobuf.valid) then begin
Dispatch.modify iobuf.d fd [Dispatch.Input];
handle_events iobuf fd tl
end else begin
(* Close invalid connection after all output has despooled *)
Dispatch.delete iobuf.d iobuf.fd;
Unix.close iobuf.fd
end
| Dispatch.Priority :: tl ->
let s = String.create 4096 in
ignore (Unix.recv fd s 0 4096 [Unix.MSG_OOB]);
@ -86,30 +102,19 @@ let rec handle_events iobuf fd events =
| Dispatch.Hangup :: tl ->
close iobuf "Hangup"
let bind iobuf handle_command handle_error =
iobuf.handle_command := handle_command;
iobuf.handle_error := handle_error
let bind d fd command_handler close_handler =
let (outq, unsent, ibuf, ibuf_len) =
(Queue.create (), ref "", String.create ibuf_max, ref 0)
in
let addr =
match Unix.getpeername fd with
| Unix.ADDR_UNIX s ->
"UDS"
| Unix.ADDR_INET (addr, port) ->
Unix.string_of_inet_addr addr
in
let create d fd addr handle_command handle_error =
let iobuf = {d = d;
fd = fd;
outq = outq;
unsent = unsent;
ibuf = ibuf;
ibuf_len = ibuf_len;
outq = Queue.create ();
unsent = ref "";
ibuf = String.create ibuf_max;
ibuf_len = ref 0;
addr = addr;
command_handler = ref command_handler;
close_handler = ref close_handler}
in
handle_command = ref handle_command;
handle_error = ref handle_error;
valid = ref true} in
Dispatch.add d fd (handle_events iobuf) [Dispatch.Input]
let rebind t command_handler close_handler =
t.command_handler := command_handler;
t.close_handler := close_handler

11
iobuf.mli
View File

@ -1,8 +1,11 @@
type t
val addr : t -> string
type command_handler = t -> Command.t -> unit
type error_handler = t -> string -> unit
val write : t -> Command.t -> unit
val bind : Dispatch.t -> Unix.file_descr -> (t -> Command.t -> unit) -> (string -> unit) -> unit
val rebind: t -> (t -> Command.t -> unit) -> (string -> unit) -> unit
val create : Dispatch.t -> Unix.file_descr -> Unix.sockaddr -> command_handler -> error_handler -> unit
val close: t -> string -> unit
val addr : t -> string
val write : t -> Command.t -> unit
val bind : t -> command_handler -> error_handler -> unit

6
tests.ml
View File

@ -404,8 +404,8 @@ let regression_tests =
Send "ISON bob\r\n";
Recv ":testserver.test 303 alice :bob\r\n";
Send "PRIVMSG bob :Hi Bob!\r\n";
Send "PING :foo\r\n"; (* Make sure we don't disconnect too soon *)
Recv ":testserver.test PONG testserver.test :foo\r\n";
Send "QUIT :foo\r\n";
Recv ":testserver.test ERROR :So long\r\n";
]
in
let script2 =
@ -414,6 +414,8 @@ let regression_tests =
Send "ISON alice\r\n";
Recv ":testserver.test 303 bob :alice\r\n";
Recv ":alice!alice@UDS PRIVMSG bob :Hi Bob!\r\n";
Send "QUIT :foo\r\n";
Recv ":testserver.test ERROR :So long\r\n";
]
in
let d = Dispatch.create 4 in