mirror of https://github.com/nealey/irc-bot
Getting tests working, have some output buffer problems
This commit is contained in:
Neale Pickett
parent
eccaa1b4ff
commit
65720b5406
34
Makefile
34
Makefile
|
|
@ -1,34 +0,0 @@
|
||||||
OCAML_PACKAGES := -package equeue -package pcre
|
|
||||||
|
|
||||||
TARGETS = ircd
|
|
||||||
|
|
||||||
OCAMLOPTS = -g
|
|
||||||
OCAMLC = ocamlfind c $(OCAMLOPTS)
|
|
||||||
|
|
||||||
all: $(TARGETS)
|
|
||||||
|
|
||||||
ircd: connection.cmo ircd.cmo
|
|
||||||
|
|
||||||
.PHONY: test
|
|
||||||
test: tests
|
|
||||||
./tests
|
|
||||||
|
|
||||||
##
|
|
||||||
## Generic ways to do things
|
|
||||||
##
|
|
||||||
%.cmo : %.ml
|
|
||||||
$(OCAMLC) -c $^ $(OCAML_PACKAGES)
|
|
||||||
|
|
||||||
%: %.cmo
|
|
||||||
$(OCAMLC) -o $@ $(filter-out $<, $^) $< $(OCAML_PACKAGES) -linkpkg
|
|
||||||
|
|
||||||
##
|
|
||||||
##
|
|
||||||
##
|
|
||||||
include .deps
|
|
||||||
.deps: *.ml
|
|
||||||
ocamldep $^ > $@
|
|
||||||
|
|
||||||
.PHONY: clean
|
|
||||||
clean:
|
|
||||||
rm -f $(TARGETS) *.cm? *.o
|
|
||||||
|
|
@ -0,0 +1,22 @@
|
||||||
|
USE_OCAMLFIND = true
|
||||||
|
OCAMLPACKS[] =
|
||||||
|
equeue
|
||||||
|
pcre
|
||||||
|
|
||||||
|
.DEFAULT: ircd
|
||||||
|
|
||||||
|
OCamlProgram(pgircd, pgircd ircd connection)
|
||||||
|
|
||||||
|
section
|
||||||
|
OCAMLPACKS[] +=
|
||||||
|
oUnit
|
||||||
|
|
||||||
|
tests.cmx:
|
||||||
|
tests.cmi:
|
||||||
|
tests$(EXT_OBJ):
|
||||||
|
|
||||||
|
OCamlProgram(tests, tests chat ircd connection)
|
||||||
|
|
||||||
|
.PHONY: clean
|
||||||
|
clean:
|
||||||
|
rm $(filter-out %.pem tls.c, $(filter-proper-targets $(ls R, .)))
|
||||||
|
|
@ -0,0 +1,45 @@
|
||||||
|
########################################################################
|
||||||
|
# Permission is hereby granted, free of charge, to any person
|
||||||
|
# obtaining a copy of this file, to deal in the File without
|
||||||
|
# restriction, including without limitation the rights to use,
|
||||||
|
# copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
# sell copies of the File, and to permit persons to whom the
|
||||||
|
# File is furnished to do so, subject to the following condition:
|
||||||
|
#
|
||||||
|
# THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||||
|
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
|
||||||
|
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
|
||||||
|
# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
|
||||||
|
# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
|
||||||
|
# OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR
|
||||||
|
# THE USE OR OTHER DEALINGS IN THE FILE.
|
||||||
|
|
||||||
|
########################################################################
|
||||||
|
# The standard OMakeroot file.
|
||||||
|
# You will not normally need to modify this file.
|
||||||
|
# By default, your changes should be placed in the
|
||||||
|
# OMakefile in this directory.
|
||||||
|
#
|
||||||
|
# If you decide to modify this file, note that it uses exactly
|
||||||
|
# the same syntax as the OMakefile.
|
||||||
|
#
|
||||||
|
|
||||||
|
#
|
||||||
|
# Include the standard installed configuration files.
|
||||||
|
# Any of these can be deleted if you are not using them,
|
||||||
|
# but you probably want to keep the Common file.
|
||||||
|
#
|
||||||
|
#open build/C
|
||||||
|
open build/OCaml
|
||||||
|
#open build/LaTeX
|
||||||
|
|
||||||
|
#
|
||||||
|
# The command-line variables are defined *after* the
|
||||||
|
# standard configuration has been loaded.
|
||||||
|
#
|
||||||
|
DefineCommandVars()
|
||||||
|
|
||||||
|
#
|
||||||
|
# Include the OMakefile in this directory.
|
||||||
|
#
|
||||||
|
.SUBDIRS: .
|
||||||
284
irc.ml
284
irc.ml
|
|
@ -1,284 +0,0 @@
|
||||||
open Uq_engines
|
|
||||||
open Unixqueue
|
|
||||||
|
|
||||||
let newline_re = Pcre.regexp "\n\r?"
|
|
||||||
let argsep_re = Pcre.regexp " :"
|
|
||||||
let space_re = Pcre.regexp " "
|
|
||||||
|
|
||||||
let string_map f s =
|
|
||||||
let l = String.length s in
|
|
||||||
if l = 0 then
|
|
||||||
s
|
|
||||||
else
|
|
||||||
let r = String.create l in
|
|
||||||
for i = 0 to l - 1 do
|
|
||||||
String.unsafe_set r i (f (String.unsafe_get s i))
|
|
||||||
done;
|
|
||||||
r
|
|
||||||
|
|
||||||
let lowercase_char c =
|
|
||||||
if (c >= 'A' && c <= '^') then
|
|
||||||
Char.unsafe_chr(Char.code c + 32)
|
|
||||||
else
|
|
||||||
c
|
|
||||||
|
|
||||||
let uppercase_char c =
|
|
||||||
if (c >= 'a' && c <= '~') then
|
|
||||||
Char.unsafe_chr(Char.code c - 32)
|
|
||||||
else
|
|
||||||
c
|
|
||||||
|
|
||||||
let uppercase s = string_map uppercase_char s
|
|
||||||
let lowercase s = string_map lowercase_char s
|
|
||||||
|
|
||||||
|
|
||||||
class irc (ues : unix_event_system) =
|
|
||||||
object (self)
|
|
||||||
|
|
||||||
val mutable debug = false
|
|
||||||
val throttle_interval = 1.0
|
|
||||||
|
|
||||||
(** Group for this bot's events *)
|
|
||||||
val g = ues#new_group ()
|
|
||||||
|
|
||||||
val out_wait_id = ues#new_wait_id ()
|
|
||||||
val mutable check_output = None
|
|
||||||
val mutable output_pending = ""
|
|
||||||
val mutable input_pending = ""
|
|
||||||
val outq_immediate = Queue.create ()
|
|
||||||
val outq_throttled = Queue.create ()
|
|
||||||
val outq_last_sent = Unix.time ()
|
|
||||||
|
|
||||||
initializer
|
|
||||||
ues#add_handler g self#handle_event
|
|
||||||
|
|
||||||
method debug v =
|
|
||||||
debug <- v
|
|
||||||
|
|
||||||
method log msg =
|
|
||||||
if debug then
|
|
||||||
prerr_endline msg
|
|
||||||
|
|
||||||
method handle_event ues' esys e =
|
|
||||||
assert (ues' = ues);
|
|
||||||
match e with
|
|
||||||
| Input_arrived (g, fd) ->
|
|
||||||
self#handle_input fd
|
|
||||||
| Output_readiness (g, fd) ->
|
|
||||||
self#handle_output fd
|
|
||||||
| Out_of_band (g, fd) ->
|
|
||||||
self#handle_oob fd
|
|
||||||
| Timeout (g, op) ->
|
|
||||||
self#handle_timeout op
|
|
||||||
| Signal ->
|
|
||||||
self#handle_signal ()
|
|
||||||
| Extra exn ->
|
|
||||||
self#handle_extra exn
|
|
||||||
|
|
||||||
method handle_input fd =
|
|
||||||
let s = 4096 in
|
|
||||||
let buf = String.create s in
|
|
||||||
let len = Unix.read fd buf 0 s in
|
|
||||||
let input = input_pending ^ (String.sub buf 0 len) in
|
|
||||||
if (input <> "") then
|
|
||||||
let lines = Pcre.split ~rex:newline_re input in
|
|
||||||
let rec handle_lines lines =
|
|
||||||
match lines with
|
|
||||||
| []
|
|
||||||
| [""] ->
|
|
||||||
input_pending <- "";
|
|
||||||
| line :: tl ->
|
|
||||||
self#handle_line line;
|
|
||||||
handle_lines tl
|
|
||||||
in
|
|
||||||
handle_lines lines
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
Unix.close fd;
|
|
||||||
ues#clear g;
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
method handle_output fd =
|
|
||||||
let data = (
|
|
||||||
if (output_pending <> "") then
|
|
||||||
output_pending
|
|
||||||
else if not (Queue.is_empty outq_immediate) then
|
|
||||||
Queue.pop outq_immediate
|
|
||||||
else if not (Queue.is_empty outq_throttled) then
|
|
||||||
begin
|
|
||||||
(* Stop listening for output events; add a timeout to
|
|
||||||
start listening again *)
|
|
||||||
(match check_output with
|
|
||||||
| None -> ()
|
|
||||||
| Some co ->
|
|
||||||
let pay_attention () =
|
|
||||||
ues#add_resource g (co, -.1.0)
|
|
||||||
in
|
|
||||||
ues#remove_resource g co;
|
|
||||||
ues#once g throttle_interval pay_attention
|
|
||||||
);
|
|
||||||
Queue.pop outq_throttled
|
|
||||||
end
|
|
||||||
else
|
|
||||||
match check_output with
|
|
||||||
| None -> ""
|
|
||||||
| Some co ->
|
|
||||||
ues#remove_resource g co;
|
|
||||||
""
|
|
||||||
) in
|
|
||||||
let data_len = String.length data in
|
|
||||||
let n = Unix.single_write fd data 0 data_len in
|
|
||||||
output_pending <- String.sub data n (data_len - n);
|
|
||||||
if (data <> "") then
|
|
||||||
self#log ("--> " ^ (String.escaped data))
|
|
||||||
|
|
||||||
method handle_oob fd =
|
|
||||||
self#log "OOB ready!";
|
|
||||||
raise Equeue.Reject
|
|
||||||
|
|
||||||
method handle_timeout op =
|
|
||||||
self#log "Timeout!";
|
|
||||||
raise Equeue.Reject
|
|
||||||
|
|
||||||
method handle_signal () =
|
|
||||||
self#log "Signal!";
|
|
||||||
raise Equeue.Reject
|
|
||||||
|
|
||||||
method handle_extra exn =
|
|
||||||
self#log "Extra!";
|
|
||||||
raise Equeue.Reject
|
|
||||||
|
|
||||||
method handle_line line =
|
|
||||||
let argstr, txt =
|
|
||||||
match Pcre.split ~max:2 ~rex:argsep_re line with
|
|
||||||
| [] -> ("", "")
|
|
||||||
| [a] -> (a, "")
|
|
||||||
| [a; b] -> (a, b)
|
|
||||||
| _ -> ("", "")
|
|
||||||
in
|
|
||||||
let sender, args =
|
|
||||||
let args' = Pcre.split ~rex:space_re argstr in
|
|
||||||
if (debug) then
|
|
||||||
print_endline ("<-- [" ^
|
|
||||||
(String.concat "; " args') ^
|
|
||||||
"] " ^
|
|
||||||
txt);
|
|
||||||
if (List.hd args').[0] = ':' then
|
|
||||||
(List.hd args', List.tl args')
|
|
||||||
else
|
|
||||||
("", args')
|
|
||||||
in
|
|
||||||
match args with
|
|
||||||
| [] ->
|
|
||||||
()
|
|
||||||
| "NOTICE" :: args ->
|
|
||||||
let tlen = String.length txt in
|
|
||||||
if ((txt.[0] = '\001') &&
|
|
||||||
(txt.[tlen - 1] = '\001')) then
|
|
||||||
self#handle_ctcp_reply sender args (String.sub txt 1 (tlen - 2))
|
|
||||||
else
|
|
||||||
self#handle_notice sender args txt
|
|
||||||
| "PRIVMSG" :: args ->
|
|
||||||
let tlen = String.length txt in
|
|
||||||
if ((txt.[0] = '\001') &&
|
|
||||||
(txt.[tlen - 1] = '\001')) then
|
|
||||||
self#handle_ctcp_request sender args (String.sub txt 1 (tlen - 2))
|
|
||||||
else
|
|
||||||
self#handle_privmsg args sender txt
|
|
||||||
| ["PING"] ->
|
|
||||||
self#handle_ping txt
|
|
||||||
| str :: args ->
|
|
||||||
let numeric =
|
|
||||||
try
|
|
||||||
Some (int_of_string str)
|
|
||||||
with Failure _ ->
|
|
||||||
None
|
|
||||||
in
|
|
||||||
match numeric with
|
|
||||||
| Some n ->
|
|
||||||
self#handle_numeric n sender args txt
|
|
||||||
| None ->
|
|
||||||
self#handle_unknown sender args txt
|
|
||||||
|
|
||||||
|
|
||||||
method handle_privmsg sender args txt =
|
|
||||||
()
|
|
||||||
|
|
||||||
method handle_notice sender args txt =
|
|
||||||
()
|
|
||||||
|
|
||||||
method handle_ctcp_request sender args txt =
|
|
||||||
()
|
|
||||||
|
|
||||||
method handle_ctcp_reply sender args txt =
|
|
||||||
()
|
|
||||||
|
|
||||||
method handle_numeric n sender args txt =
|
|
||||||
()
|
|
||||||
|
|
||||||
method handle_unknown sender args txt =
|
|
||||||
self#log ("Got unknown server message")
|
|
||||||
|
|
||||||
method handle_ping txt =
|
|
||||||
self#send ["PONG"] txt
|
|
||||||
|
|
||||||
(** Public methods *)
|
|
||||||
|
|
||||||
method set_fd fd nick gecos =
|
|
||||||
(* XXX: Clear old junk *)
|
|
||||||
check_output <- Some (Wait_out fd);
|
|
||||||
ues#add_resource g (Wait_in fd, -.1.0);
|
|
||||||
self#send ~now:true ["USER"; nick; "+iw"; nick] gecos;
|
|
||||||
self#send ~now:true ["NICK"; nick] ""
|
|
||||||
|
|
||||||
(** Send a command to the IRC server *)
|
|
||||||
method send ?(now=false) args txt =
|
|
||||||
match check_output with
|
|
||||||
| None -> ()
|
|
||||||
| Some co ->
|
|
||||||
let q = (if now then outq_immediate else outq_throttled) in
|
|
||||||
let cmdstr =
|
|
||||||
(String.concat " " args) ^
|
|
||||||
(if txt = "" then "" else " :") ^
|
|
||||||
txt ^
|
|
||||||
"\n"
|
|
||||||
in
|
|
||||||
Queue.push cmdstr q;
|
|
||||||
ues#add_resource g (co, -.1.0)
|
|
||||||
|
|
||||||
(** Send a private message *)
|
|
||||||
method privmsg ?(now=false) recipient txt =
|
|
||||||
self#send ~now ["PRIVMSG"; recipient] txt
|
|
||||||
|
|
||||||
(** Send a notice *)
|
|
||||||
method notice ?(now=false) recipient txt =
|
|
||||||
self#send ~now ["NOTICE"; recipient] txt
|
|
||||||
|
|
||||||
(** Send a CTCP request *)
|
|
||||||
method ctcp_request ?(now=false) recipient command txt =
|
|
||||||
self#privmsg ~now recipient ("\001" ^ command ^ " " ^ txt ^ "\001")
|
|
||||||
|
|
||||||
(** Send a CTCP reply *)
|
|
||||||
method ctcp_reply ?(now=false) recipient command txt =
|
|
||||||
self#notice ~now recipient ("\001" ^ command ^ " " ^ txt ^ "\001")
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
let main() =
|
|
||||||
let ues = new unix_event_system () in
|
|
||||||
let c = connector (`Socket(`Sock_inet_byname(Unix.SOCK_STREAM,
|
|
||||||
"woozle.org", 6667),
|
|
||||||
default_connect_options
|
|
||||||
)) ues in
|
|
||||||
when_state
|
|
||||||
~is_done:(fun connstat ->
|
|
||||||
match connstat with
|
|
||||||
| `Socket(fd, _) ->
|
|
||||||
let b = new irc ues in
|
|
||||||
b#set_fd fd "plasma" "Plasma Bot"
|
|
||||||
| _ -> assert false
|
|
||||||
)
|
|
||||||
c;
|
|
||||||
Unixqueue.run ues
|
|
||||||
Loading…
Reference in New Issue