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

Merge commit 'origin/master' 

Conflicts:
	cobalt
	cobalt-handler
	firebot
	infobot
This commit is contained in:
Neale Pickett 2011-01-07 13:39:13 -06:00
parent adfcd00d66 878830d39f
commit c2168b714a
22 changed files with 622 additions and 1346 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Makefile
View File

@ -1,28 +1,8 @@
INCLUDES =
OCAMLFLAGS = $(INCLUDES)
OCAMLOPT = ocamlopt
OCAMLC = ocamlc -g
OCAMLDEP = ocamldep $(INCLUDES)
OCAMLLIBS = unix.cma str.cma nums.cma
CFLAGS = -Wall -Werror
TARGETS = dispatch irc
bot: irc.cmo dispatch.cmo process.cmo command.cmo iobuf.cmo bot.cmo
$(OCAMLC) -o $@ $(OCAMLLIBS) $^
all: $(TARGETS)
.PHONY: clean
clean:
rm -f bot *.cm* *.o
%.cmi: %.mli
$(OCAMLC) $(OCAMLFLAGS) -c $<
%.cmx: %.ml
$(OCAMLOPT) $(OCAMLFLAGS) -c $<
%.cmo: %.ml
$(OCAMLC) $(OCAMLFLAGS) -c $<
depend: .depend
.depend: *.mli *.ml
$(OCAMLDEP) $(INCLUDES) $^ > $@
include .depend
rm -f $(TARGETS) *.o

80
README
View File

@ -1,13 +1,85 @@
bot
===
It's a bot with a scheme interpreter in it.
This is a suite of simple programs which allow you to write an IRC bot.
It is based on the Unix principle that one program should do one thing,
and makes extensive use of pipes, child processes, and passing of file
descriptors.
Unless you are a seasoned Unix programmer or are willing to become one,
this is not the bot you're looking for.
Downloading
-----------
dispatch
--------
http://woozle.org/~neale/gitweb.cgi
Reads lines from stdin (or fd 6). Each line causes a fork and exec of a
specified program; the line is sent as the last argument. Any output
from children is passed through to stdout (or fd 7), optionally rate
limited. A fifo can optionally be specified on the command line;
anything written to it is treated identically to child output.
irc
---
Parses its last argument as a line from IRC. Determines prefix,
command, sender, forum (channel or user), and text; then invokes a
specified program with these as arguments. Also responds to server
pings as a convenience.
bot
---
Given nickname $nick, creates $nick.fifo, logs into IRC as $nick, and
passes control to dispatch -> irc -> $nick-handler.
cobalt-handler
--------------
Joins initial channels, responds to invite messages, and tries private
messages with several different handlers in turn.
firebot
-------
A private message handler providing a few handy commands.
infobot
-------
A private message handler providing infobot-like functionality.
notes
-----
A private message handler allowing users to leave notes for each other.
whuffie
-------
A private message handler keeping track of whuffe (also known as karma),
which is really just a meaningless number associated with your nick,
which other people can manipulate but you can't.
Putting it all together
=======================
A full chain of programs would look something like
tcpclient -> bot -> dispatch -> handler
and would be invoked as
$ tcpclient irc.host.org 6667 ./bot cobalt
Author

3
TODO
View File

@ -1,3 +0,0 @@
* Modify Ocs_port to use Buffer instead of String

173
bot.ml
View File

@ -1,173 +0,0 @@
let debug = prerr_endline
let file_descr_of_int (i:int) =
let blob = Marshal.to_string i [] in
(Marshal.from_string blob 0 : Unix.file_descr)
let write iobuf command args text =
let cmd = Command.create None command args text in
Iobuf.write iobuf cmd
let rec msg iobuf recip text =
match text with
| "" -> ()
| _ ->
let tl = String.length text in
let s, rest =
if (tl > 400) then
((Str.string_before text 400) ^ "↩",
"↪" ^ (Str.string_after text 400))
else
(text, "")
in
write iobuf "PRIVMSG" [recip] (Some s);
msg iobuf recip rest
let split = Str.split (Str.regexp "[ \t]*\r?\n")
(** Callback upon completion of the external command helper *)
let extern_callback iobuf sender forum text =
let lines = split text in
let nlines = List.length lines in
let recip =
if (nlines > 5) then begin
if (forum <> sender) then
msg iobuf forum (Format.sprintf "%d lines, sending privately" nlines);
sender
end else
forum
in
let rec f = function
| [] ->
()
| "" :: tl ->
f tl
| line :: tl ->
if line.[0] == '\007' then
(* Interpret as raw IRC commands *)
let ine = Str.string_after line 1 in
let cmd = Command.from_string ine in
Iobuf.write iobuf cmd
else
(* Naive case: send to the recipient *)
msg iobuf recip line;
f tl
in
f lines
let nick_of_nuhost s =
try
Irc.nick (Irc.nuhost_of_string s)
with Not_found ->
s
let handle_command outbuf handle_cmd thisbuf cmd =
let (prefix, command, args, trailing) = Command.as_tuple cmd in
let (sender, forum) =
match (prefix, command, args, trailing) with
| (Some suhost, "PRIVMSG", [target], _)
| (Some suhost, "NOTICE", [target], _) ->
let sender = nick_of_nuhost suhost in
let forum = if Irc.is_channel target then target else sender in
(sender, forum)
(* Here's why the IRC protocol blows: *)
| (Some suhost, "PART", [forum], _)
| (Some suhost, "JOIN", [forum], _)
| (Some suhost, "MODE", forum :: _, _)
| (Some suhost, "INVITE", [_; forum], None)
| (Some suhost, "INVITE", _, Some forum)
| (Some suhost, "TOPIC", forum :: _, _)
| (Some suhost, "KICK", forum :: _, _) ->
(nick_of_nuhost suhost, forum)
| (Some suhost, "JOIN", [], Some chan) ->
(nick_of_nuhost suhost, chan)
| (Some _, "NICK", [sender], _) ->
(sender, sender)
| (Some suhost, "QUIT", _, _)
| (Some suhost, _, _, _) ->
let sender = nick_of_nuhost suhost in
(sender, sender)
| (_, "PING", _, Some text) ->
write outbuf "PONG" [] (Some text);
("", "")
| (None, _, _, _) ->
("", "")
in
let pfx =
match prefix with
| Some txt -> txt
| None -> ""
in
let text =
match trailing with
| Some txt -> txt
| None -> ""
in
let argv =
Array.append
[|handle_cmd; sender; forum; pfx; command|]
(Array.of_list args)
in
Process.create_canned
(Iobuf.dispatcher thisbuf)
text
(extern_callback outbuf sender forum)
handle_cmd
argv
let discard_command iobuf cmd = ()
let handle_error iobuf str =
prerr_endline ("!!! " ^ str)
let main () =
let handler = ref "/bin/true" in
let inputfn = ref "" in
let nick = ref "bot" in
let user = ref "bot" in
let mode = ref "+i" in
let realname = ref "I'm a little printf, short and stdout" in
let connect = ref [||] in
let append_connect s = connect := Array.append !connect [|s|] in
let speclist =
[
("-n", Arg.Set_string nick, "Nickname");
("-u", Arg.Set_string user, "Username");
("-m", Arg.Set_string mode, "Mode");
("-r", Arg.Set_string realname, "Real name");
("-a", Arg.Set_string handler, "IRC message handler");
("-i", Arg.Set_string inputfn, "Command FIFO");
]
in
let usage = "usage: bot [OPTIONS] CONNECT-COMMAND [ARGS ...]" in
Arg.parse speclist append_connect usage;
if (Array.length !connect) < 1 then begin
prerr_endline "Error: must specify connect command.";
prerr_endline "";
prerr_endline "Run with --help for usage information.";
exit 64 (* EX_USAGE *)
end;
let dispatcher = Dispatch.create () in
let conn_out, conn_in = Process.spawn (!connect).(0) !connect in
let iobuf_out = Iobuf.create dispatcher conn_out "out"
discard_command
handle_error
in
let _ = Iobuf.create dispatcher conn_in "in"
(handle_command iobuf_out !handler)
handle_error
in
write iobuf_out "NICK" [!nick] None;
write iobuf_out "USER" [!user; !mode; "merf"] (Some !realname);
Dispatch.run dispatcher
let _ =
main ()

7
cobalt
View File

@ -1,9 +1,6 @@
#! /bin/sh
while true; do
./bot \
-n cobalt \
-u cobalt \
-a ./cobalt-handler \
socat STDIO OPENSSL:woozle.org:6697,verify=0
tcpclient woozle.org 6667 ./bot cobalt
sleep 5
done

37
cobalt-handler
View File

@ -1,24 +1,30 @@
#! /bin/sh
pfx=$1; export pfx; shift
command=$1; export command; shift
sender=$1; export sender; shift
forum=$1; export forum; shift
prefix=$1; export prefix; shift
command=$1; export command; shift
text=$1; export text; shift
# $* is now args
# Remeber, read discards leading whitespace. If that's not okay, use
# text=$(cat)
read -r text
# Debug output
echo '>>>' ${pfx:+:}$pfx $command "$@" ${text:+:}"$text" 1>&2
raw () {
fmt="\007$1\n"; shift
printf "$fmt" "$@"
}
join () {
printf '\aJOIN %s\n' "$1"
raw "JOIN $1"
}
case $command in
001)
join "#woozle"
join "#foozle"
join "#bot"
join "#cobalt"
;;
433)
raw "NICK bottimus"
;;
PRIVMSG)
case "$forum" in
@ -32,7 +38,16 @@ case $command in
;;
INVITE)
join "$forum"
echo "Thanks for the invitation, $sender."
raw "PRIVMSG %s :Thanks for the invitation, %s." "$forum" "$sender"
;;
esac
esac | while read -r line; do
case "$line" in
*)
printf "%s\r\n" "${line#}"
;;
*)
printf "PRIVMSG %s :%s\r\n" "$forum" "$line"
;;
esac
done

78
command.ml
View File

@ -1,78 +0,0 @@
type t = {sender: string option;
name: string;
args: string list;
text: string option}
let create sender name args text =
{sender = sender;
name = name;
args = args;
text = text}
let anon = create None
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, name :: args) ->
(* End of line, no text part *)
create sender (String.uppercase name) args 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 ':', name :: args) ->
(* Not first word, starts with ':' *)
create sender (String.uppercase name) args (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
View File

@ -1,11 +0,0 @@
type t
val create : string option -> string -> string list -> string option -> 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

351
dispatch.c Normal file
View File

@ -0,0 +1,351 @@
#include <stdio.h>
#include <unistd.h>
#include <stdarg.h>
#include <sysexits.h>
#include <stdlib.h>
#include <signal.h>
#include <time.h>
#include <fcntl.h>
#include <errno.h>
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/wait.h>
#include <sys/select.h>
#include <sys/time.h>
#include "dump.h"
#define MAX_ARGS 50
#define MAX_SUBPROCS 50
#define TARGET_MAX 20
#define max(a,b) ((a)>(b)?(a):(b))
struct subproc {
int fd; /* File descriptor */
char buf[4000]; /* Read buffer */
size_t buflen; /* Buffer length */
};
struct subproc subprocs[MAX_SUBPROCS] = {{0}};
/* Things set by argv parser */
char *handler = NULL;
char **handler_args;
struct timeval output_interval = {0};
struct timeval output_last = {0};
int fifoin = -1;
int fifoout = -1;
void
dispatch(const char *buf,
size_t buflen)
{
int subout[2];
struct subproc *s = NULL;
int i;
char text[512];
if (buflen > sizeof(text)) {
fprintf(stderr, "Ignoring message: too long (%d bytes)\n", buflen);
return;
}
memcpy(text, buf, buflen-1); /* omit newline */
text[buflen-1] = '\0';
for (i = 0; i < MAX_SUBPROCS; i += 1) {
if (0 == subprocs[i].fd) {
s = &subprocs[i];
break;
}
}
if (! s) {
fprintf(stderr, "Ignoring message: too many subprocesses\n");
return;
}
if (-1 == pipe(subout)) {
perror("pipe");
return;
}
if (0 == fork()) {
/* Child */
char *argv[MAX_ARGS + 5];
int null;
int i;
if ((-1 == (null = open("/dev/null", O_RDONLY))) ||
(-1 == dup2(null, 0)) ||
(-1 == dup2(subout[1], 1))) {
perror("fd setup");
exit(EX_OSERR);
}
/* We'll be good citizens about this and only close file descriptors
we opened. */
close(fifoout);
close(null);
close(subout[0]);
close(subout[1]);
for (i = 0; i < MAX_SUBPROCS; i += 1) {
if (subprocs[i].fd) {
close(subprocs[i].fd);
}
}
i = 0;
argv[i++] = handler;
for (; handler_args[i-1]; i += 1) {
argv[i] = handler_args[i-1];
}
argv[i++] = text;
argv[i] = NULL;
execvp(handler, argv);
perror("exec");
exit(0);
}
s->fd = subout[0];
close(subout[1]);
}
void
delay_output()
{
struct timeval now, diff;
gettimeofday(&now, NULL);
timersub(&now, &output_last, &diff);
if (timercmp(&diff, &output_interval, <)) {
struct timeval delay;
struct timespec ts;
int ret;
timersub(&output_interval, &diff, &delay);
ts.tv_sec = (time_t)delay.tv_sec;
ts.tv_nsec = (long)(delay.tv_usec * 1000);
do {
ret = nanosleep(&ts, &ts);
} while ((-1 == ret) && (EINTR == errno));
gettimeofday(&output_last, NULL);
} else {
output_last = now;
}
}
/** Writes all of buf to stdout, possibly blocking. */
void
output(const char *buf,
size_t count)
{
if (timerisset(&output_interval)) {
delay_output();
}
while (count) {
ssize_t len;
do {
len = write(1, buf, count);
} while ((-1 == len) && (EINTR == errno));
if (-1 == len) {
perror("stdout");
exit(EX_IOERR);
}
count -= len;
buf += len;
}
}
void
call_with_lines(char *buf,
size_t *len,
void (*func)(const char *, size_t))
{
char *b = buf;
char *p;
size_t l = *len;
while ((p = memchr(b, '\n', l))) {
size_t n = p - b + 1;
size_t buflen = n;
if ('\r' == *(p-1)) buflen -= 1;
func(b, buflen);
l -= n;
b += n;
}
memmove(buf, b, l);
*len = l;
}
char inbuf[8000];
size_t inbuflen = 0;
void
handle_input()
{
ssize_t len;
do {
len = read(0, inbuf + inbuflen, sizeof(inbuf) - inbuflen);
} while ((-1 == len) && (EINTR == errno));
if (0 == len) {
exit(0);
}
inbuflen += len;
call_with_lines(inbuf, &inbuflen, dispatch);
}
void
handle_subproc(struct subproc *s)
{
ssize_t len;
do {
len = read(s->fd, s->buf + s->buflen, sizeof(s->buf) - s->buflen);
} while ((-1 == len) && (EINTR == errno));
if (-1 == len) {
perror("subprocess read error");
} else {
s->buflen += len;
call_with_lines(s->buf, &s->buflen, output);
}
if (sizeof(s->buf) == s->buflen) {
fprintf(stderr, "subprocess buffer full, killing and discarding buffer.\n");
len = 0;
}
/* Recycle this subproc unless something was read */
if (0 >= len) {
if (s->buflen) {
fprintf(stderr, "warning: discarding %d characters from subprocess buffer\n",
s->buflen);
}
close(s->fd);
s->fd = 0;
s->buflen = 0;
}
}
void
loop()
{
int i, ret;
int nfds = 0;
fd_set rfds;
FD_ZERO(&rfds);
FD_SET(0, &rfds);
for (i = 0; i < MAX_SUBPROCS; i += 1) {
if (subprocs[i].fd) {
FD_SET(subprocs[i].fd, &rfds);
nfds = max(nfds, subprocs[i].fd);
}
}
do {
ret = select(nfds+1, &rfds, NULL, NULL, NULL);
} while ((-1 == ret) && (EINTR == errno));
if (-1 == ret) {
perror("select");
exit(EX_IOERR);
}
if (FD_ISSET(0, &rfds)) {
handle_input();
}
for (i = 0; i < MAX_SUBPROCS; i += 1) {
if (subprocs[i].fd && FD_ISSET(subprocs[i].fd, &rfds)) {
handle_subproc(&subprocs[i]);
}
}
}
void
sigchld(int signum)
{
while (0 < waitpid(-1, NULL, WNOHANG));
}
void
usage(char *self)
{
fprintf(stderr, "Usage: %s [OPTIONS] handler [ARGS ...]\n", self);
fprintf(stderr, "\n");
fprintf(stderr, "-f FIFO Also dispatch messages from FIFO.\n");
fprintf(stderr, "-i INTERVAL Wait at least INTERVAL microseconds between\n");
fprintf(stderr, " sending each line.\n");
}
int
main(int argc, char *argv[])
{
/* Parse command line */
while (! handler) {
switch (getopt(argc, argv, "hf:i:")) {
case -1:
if (optind >= argc) {
fprintf(stderr, "error: must specify handler script.\n");
usage(argv[0]);
return EX_USAGE;
}
if (argc - optind - 10 > MAX_ARGS) {
fprintf(stderr, "error: too many arguments to helper.\n");
return EX_USAGE;
}
handler = argv[optind];
handler_args = argv + (optind + 1);
break;
case 'f':
if ((-1 == (fifoin = open(optarg, O_RDONLY | O_NONBLOCK))) ||
(-1 == (fifoout = open(optarg, O_WRONLY)))) {
perror("open fifo");
return EX_IOERR;
}
subprocs[0].fd = fifoin;
break;
case 'i':
{
char *end;
long long int interval;
interval = strtoll(optarg, &end, 10);
if (*end) {
fprintf(stderr, "error: not an integer number: %s\n", optarg);
return EX_USAGE;
}
output_interval.tv_sec = interval / 1000000;
output_interval.tv_usec = interval % 1000000;
}
break;
case 'h':
usage(argv[0]);
return 0;
default:
fprintf(stderr, "error: unknown option.\n");
usage(argv[0]);
return EX_USAGE;
}
}
/* tcpclient uses fds 6 and 7. If these aren't open, we keep the
original fds 0 and 1. */
if (-1 != dup2(6, 0)) close(6);
if (-1 != dup2(7, 1)) close(7);
signal(SIGCHLD, sigchld);
while (1) {
loop();
}
return 0;
}

138
dispatch.ml
View File

@ -1,138 +0,0 @@
type event = Input | Output | Exception
type timer_handler = float -> unit
type fd_handler = Unix.file_descr -> event -> unit
module Timer =
Set.Make (struct
type t = (float * timer_handler)
let compare (time, handler) (time', handler') = compare time time'
end)
module Fd_map =
Map.Make (struct
type t = Unix.file_descr
let compare = compare
end)
type t = {
read_fds : Unix.file_descr list ref;
write_fds : Unix.file_descr list ref;
except_fds : Unix.file_descr list ref;
handlers : fd_handler Fd_map.t ref;
timers : Timer.t ref;
}
let create () =
{read_fds = ref [];
write_fds = ref [];
except_fds = ref [];
handlers = ref Fd_map.empty;
timers = ref Timer.empty}
let destroy d =
(* Explicitly unreference fds and timers, in case d sticks around *)
d.handlers := Fd_map.empty;
d.timers := Timer.empty
let get_fds d event =
match event with
| Input -> d.read_fds
| Output -> d.write_fds
| Exception -> d.except_fds
let modify d fd events =
let add_event event =
let l = get_fds d event in
let nl = (List.filter ((<>) fd) !l) in
if List.mem event events then
l := fd :: nl
else
l := nl
in
if Fd_map.mem fd !(d.handlers) then
List.iter add_event [Input; Output; Exception]
else
raise Not_found
let set_handler d fd handler =
d.handlers := Fd_map.add fd handler !(d.handlers)
let add d fd handler events =
set_handler d fd handler;
modify d fd events
let delete d fd =
let del_event event =
let l = get_fds d event in
l := (List.filter ((<>) fd) !l)
in
d.handlers := Fd_map.remove fd !(d.handlers);
List.iter del_event [Input; Output; Exception]
let add_timer d handler time =
d.timers := Timer.add (time, handler) !(d.timers)
let delete_timer d time =
let may_remain (time', _) =
time' <> time
in
d.timers := Timer.filter may_remain !(d.timers)
let rec dispatch_timers d now =
if not (Timer.is_empty !(d.timers)) then
let (time, handler) = Timer.min_elt !(d.timers) in
if now < time then
()
else begin
handler time;
d.timers := Timer.remove (time, handler) !(d.timers);
dispatch_timers d now
end
let rec dispatch_results d (read_ready, write_ready, except_ready) =
let rec dispatch event fd_list =
match fd_list with
| [] ->
()
| fd :: tl ->
let handler = Fd_map.find fd !(d.handlers) in
handler fd event;
dispatch event tl
in
dispatch Input read_ready;
dispatch Output write_ready;
dispatch Exception except_ready
let once d =
(* You might think it'd work better to use the timeout of select().
Not so! select() waits *at most* timeout ms. Doing things
this way results in a tight loop as the timer approaches. *)
let interval =
try
let (next, _) = Timer.min_elt !(d.timers) in
let delta = (next -. (Unix.gettimeofday ())) in
max delta 0.0
with Not_found ->
0.0
in
let s = { Unix.it_interval = interval; Unix.it_value = 0.0 } in
let _ = Sys.set_signal Sys.sigalrm Sys.Signal_ignore in
let _ = Unix.setitimer Unix.ITIMER_REAL s in
try
let result =
Unix.select !(d.read_fds) !(d.write_fds) !(d.except_fds) (-1.0)
in
dispatch_results d result;
dispatch_timers d (Unix.gettimeofday ())
with Unix.Unix_error (Unix.EINTR, _, _) ->
()
let rec run d =
if (Fd_map.is_empty !(d.handlers)) && (Timer.is_empty !(d.timers)) then
()
else begin
once d;
run d
end

48
dispatch.mli
View File

@ -1,48 +0,0 @@
type t
(** The type of event dispatchers *)
type event = Input | Output | Exception
(** An event associated with a file descriptor *)
type fd_handler = Unix.file_descr -> event -> unit
(** [fd_handler fd evt] handles event [evt] from file descriptor [fd] *)
type timer_handler = float -> unit
(** [timer_handler d when] is called at or after [when] *)
val create : unit -> t
(** Create a new event dispatcher. *)
val destroy : t -> unit
(** Destroy an event dispatcher *)
val add : t -> Unix.file_descr -> fd_handler -> event list -> unit
(** [add d fd handler events] begins listening for [events] on file
descriptor [fd], calling [handler] when an event occurs. *)
val modify : t -> Unix.file_descr -> event list -> unit
(** [modify d fd events] changes the events to pay attention to on [fd] *)
val set_handler : t -> Unix.file_descr -> fd_handler -> unit
(** [set_handler d fd handler] changes the handler to be invoked for
events on [fd] *)
val delete : t -> Unix.file_descr -> unit
(** [delete d fd] stops [d] paying attention to events on file
descriptor [fd] *)
val add_timer : t -> timer_handler -> float -> unit
(** [add_timer d time handler] will cause dispatcher [d] to invoke
[handler d time] at or after [time] *)
val delete_timer : t -> float -> unit
(** [delete_timer d time] prevents dispatcher from invoking any
handlers added for [time] *)
val once : t -> unit
(** [once d] will dispatch one event (or set of simultaneous events)
added to [d]. *)
val run : t -> unit
(** [run d] will dispatch events from [d] until all file descriptors
have been removed and all timers have run or been removed *)

19
dump.h Normal file
View File

@ -0,0 +1,19 @@
#ifndef __DUMP_H__
#define __DUMP_H__
#include <stdio.h>
/* Some things I use for debugging */
#ifdef NODUMP
# define DUMPf(fmt, args...)
#else
# define DUMPf(fmt, args...) fprintf(stderr, "%s:%s:%d " fmt "\n", __FILE__, __FUNCTION__, __LINE__, ##args)
#endif
#define DUMP() DUMPf("")
#define DUMP_d(v) DUMPf("%s = %d", #v, v)
#define DUMP_x(v) DUMPf("%s = 0x%x", #v, v)
#define DUMP_s(v) DUMPf("%s = %s", #v, v)
#define DUMP_c(v) DUMPf("%s = '%c' (0x%02x)", #v, v, v)
#define DUMP_p(v) DUMPf("%s = %p", #v, v)
#endif

17
firebot
View File

@ -1,23 +1,18 @@
#! /bin/sh
cmd=${1%% *}
args=${1#* }
[ "$cmd" = "$1" ] || args=${1#* }
case $cmd in
calc)
.calc)
printf "%s = " "$args"
printf "%s\n" "$args" | bc -l
echo "$args" | bc -l
;;
units)
src=${args% ->*}
dst=${args#*-> }
.units)
src=$(printf "%s" "$args" | sed 's/ ->.*//')
dst=$(printf "%s" "$args" | sed 's/.*-> //')
units -1 -v -- "$src" "$dst"
;;
*)
exit 1
;;
esac

2
infobot
View File

@ -69,7 +69,7 @@ EOF
echo "Someone's up to no good!"
;;
'\'*)
printf "%s" "${resp#\\}"
printf "%s\n" "${resp#\\}"
;;
:*)
printf '\001ACTION %s\001\n' "${resp#:}"

115
iobuf.ml
View File

@ -1,115 +0,0 @@
(* **************************************
* IRC Command I/O buffers
* **************************************)
type t = {d: Dispatch.t;
fd: Unix.file_descr;
outq: Command.t Queue.t;
unsent: string ref;
ibuf: string;
ibuf_len: int ref;
name: string;
handle_command: command_handler ref;
handle_error: error_handler ref;
alive: bool ref}
and command_handler = t -> Command.t -> unit
and error_handler = t -> string -> unit
let ibuf_max = 4096
let max_outq = 2000
let obuf_max = 4096
let name iobuf = iobuf.name
let dispatcher iobuf = iobuf.d
let crlf = Str.regexp "\r?\n"
let handle_input iobuf =
let buf = Str.string_before iobuf.ibuf !(iobuf.ibuf_len) in
let lines = Str.split_delim crlf buf in
let rec loop l =
match l with
| [] ->
()
| [leftover] ->
iobuf.ibuf_len := (String.length leftover);
String.blit leftover 0 iobuf.ibuf 0 !(iobuf.ibuf_len)
| line :: tl ->
let parsed = Command.from_string line in
!(iobuf.handle_command) iobuf parsed;
loop tl
in
loop lines
let close iobuf message =
!(iobuf.handle_error) iobuf message;
iobuf.alive := false;
Dispatch.modify iobuf.d iobuf.fd [Dispatch.Input; Dispatch.Output]
let write iobuf cmd =
match Queue.length iobuf.outq with
| a when a = max_outq ->
close iobuf "Max outq exceeded"
| len ->
Queue.add cmd iobuf.outq;
if ((len = 0) && (!(iobuf.unsent) = "")) then
Dispatch.modify iobuf.d iobuf.fd [Dispatch.Input; Dispatch.Output]
let handle_event iobuf fd event =
match event with
| Dispatch.Input ->
let size = ibuf_max - !(iobuf.ibuf_len) in
(match Unix.read fd iobuf.ibuf !(iobuf.ibuf_len) size with
| 0 ->
close iobuf "Hangup"
| len ->
iobuf.ibuf_len := !(iobuf.ibuf_len) + len;
handle_input iobuf;
if (!(iobuf.ibuf_len) = ibuf_max) then
(* No newline found, and the buffer is full *)
close iobuf "Input buffer overrun")
| Dispatch.Output ->
let buf = Buffer.create obuf_max in
Buffer.add_string buf !(iobuf.unsent);
while (((Buffer.length buf) < obuf_max) &&
(not (Queue.is_empty iobuf.outq))) do
let cmd = Queue.pop iobuf.outq in
Buffer.add_string buf (Command.as_string cmd);
Buffer.add_string buf "\r\n"
done;
let bufstr = Buffer.contents buf in
let buflen = Buffer.length buf in
let n = Unix.single_write fd bufstr 0 buflen in
if n < buflen then begin
iobuf.unsent := Str.string_after bufstr n;
end else if Queue.is_empty iobuf.outq then
if !(iobuf.alive) then begin
(* We're out of data to send *)
Dispatch.modify iobuf.d fd [Dispatch.Input];
end else begin
(* Close dead connection after all output has despooled *)
Dispatch.delete iobuf.d iobuf.fd;
Unix.close iobuf.fd
end
| Dispatch.Exception ->
let s = String.create 4096 in
ignore (Unix.recv fd s 0 4096 [Unix.MSG_OOB])
let bind iobuf handle_command handle_error =
iobuf.handle_command := handle_command;
iobuf.handle_error := handle_error
let create d fd name handle_command handle_error =
let iobuf = {d = d;
fd = fd;
outq = Queue.create ();
unsent = ref "";
ibuf = String.create ibuf_max;
ibuf_len = ref 0;
name = name;
handle_command = ref handle_command;
handle_error = ref handle_error;
alive = ref true} in
Dispatch.add d fd (handle_event iobuf) [Dispatch.Input];
iobuf

12
iobuf.mli
View File

@ -1,12 +0,0 @@
type t
type command_handler = t -> Command.t -> unit
type error_handler = t -> string -> unit
val create : Dispatch.t -> Unix.file_descr -> string -> command_handler -> error_handler -> t
val close: t -> string -> unit
val name : t -> string
val dispatcher : t -> Dispatch.t
val write : t -> Command.t -> unit
val bind : t -> command_handler -> error_handler -> unit

137
irc.c Normal file
View File

@ -0,0 +1,137 @@
#include <stdio.h>
#include <ctype.h>
#include <string.h>
#include <unistd.h>
#include <sysexits.h>
#include "dump.h"
#define MAX_ARGS 50
#define MAX_OUTARGS 60
#define MAX_PARTS 20
int
main(int argc, char *argv[])
{
char *parts[20] = {0};
int nparts;
char snick[20];
char *cmd;
char *text = NULL;
char *prefix = NULL;
char *sender = NULL;
char *forum = NULL;
int i;
if (argc < 3) {
fprintf(stderr, "Usage: %s HANDLER [ARGV ...] LINE\n", argv[0]);
fprintf(stderr, "\n");
fprintf(stderr, "Parses LINE (an IRC message) into:\n");
fprintf(stderr, " PREFIX Prefix part of message\n");
fprintf(stderr, " COMMAND IRC command\n");
fprintf(stderr, " SENDER Nickname of message's sender\n");
fprintf(stderr, " FORUM Forum of message\n");
fprintf(stderr, " TEXT Text part of message\n");
fprintf(stderr, " ARGS... Arguments of message\n");
fprintf(stderr, "\n");
fprintf(stderr, "After parsing, exec()s\n");
fprintf(stderr, " HANDLER ARGV... PREFIX COMMAND SENDER FORUM TEXT ARGS...\n");
return EX_USAGE;
} else if (argc > MAX_ARGS) {
fprintf(stderr, "%s: too many arguments\n", argv[0]);
return EX_USAGE;
}
/* Tokenize IRC line */
{
char *line = argv[argc-1];
nparts = 0;
if (':' == *line) {
prefix = line + 1;
} else {
parts[nparts++] = line;
}
while (*line) {
if (' ' == *line) {
*line++ = '\0';
if (':' == *line) {
text = line+1;
break;
} else {
parts[nparts++] = line;
}
} else {
line += 1;
}
}
}
/* Set command, converting to upper case */
cmd = parts[0];
for (i = 0; cmd[i]; i += 1) {
cmd[i] = toupper(cmd[i]);
}
/* Extract prefix nickname */
for (i = 0; prefix && (prefix[i] != '!'); i += 1) {
if (i == sizeof(snick) - 1) {
i = 0;
break;
}
snick[i] = prefix[i];
}
snick[i] = '\0';
if (i) {
sender = snick;
}
/* Determine forum */
if ((0 == strcmp(cmd, "PRIVMSG")) ||
(0 == strcmp(cmd, "NOTICE")) ||
(0 == strcmp(cmd, "PART")) ||
(0 == strcmp(cmd, "MODE")) ||
(0 == strcmp(cmd, "TOPIC")) ||
(0 == strcmp(cmd, "KICK"))) {
forum = parts[1];
} else if (0 == strcmp(cmd, "JOIN")) {
if (0 == nparts) {
forum = text;
text = NULL;
} else {
forum = parts[1];
}
} else if (0 == strcmp(cmd, "INVITE")) {
forum = text?text:parts[2];
text = NULL;
} else if (0 == strcmp(cmd, "NICK")) {
sender = parts[1];
forum = sender;
} else if (0 == strcmp(cmd, "PING")) {
dprintf(1, "PONG :%s\r\n", text);
}
{
int _argc;
char *_argv[MAX_OUTARGS + 1];
_argc = 0;
for (i = 1; i < argc-1; i += 1) {
_argv[_argc++] = argv[i];
}
_argv[_argc++] = prefix?prefix:"";
_argv[_argc++] = cmd;
_argv[_argc++] = sender?sender:"";
_argv[_argc++] = forum?forum:"";
_argv[_argc++] = text?text:"";
for (i = 1; (i < nparts) && (_argc < MAX_OUTARGS); i += 1) {
_argv[_argc++] = parts[i];
}
_argv[_argc] = NULL;
execvp(_argv[0], _argv);
perror(_argv[0]);
}
return 0;
}

65
irc.ml
View File

@ -1,65 +0,0 @@
type nuhost = (string * string * string)
let name = ref "irc.test"
let version = "0.1"
let start_time = Unix.gettimeofday ()
let dbg msg a =
prerr_endline ("[" ^ msg ^ "]");
a
let is_channel str =
if str == "" then
false
else
match str.[0] with
| '#' | '+' | '&' -> true
| _ -> false
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
let truncate s len =
let slen = String.length s in
if len >= slen then
s
else
Str.string_before s (min slen len)
let nuhost_re = Str.regexp "\\(.*\\)!\\(.*\\)@\\(.*\\)"
let nuhost_of_string str =
if Str.string_match nuhost_re str 0 then
(Str.matched_group 1 str,
Str.matched_group 2 str,
Str.matched_group 3 str)
else
raise Not_found
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

17
irc.mli
View File

@ -1,17 +0,0 @@
(** (Nickname, username, hostname) tuple *)
type nuhost = (string * string * string)
val name : string ref
val version : string
val start_time : float
val is_channel : string -> bool
val uppercase : string -> string
val lowercase : string -> string
val truncate : string -> int -> string
val nuhost_of_string : string -> nuhost
val string_of_nuhost : nuhost -> string
val nick : nuhost -> string
val user : nuhost -> string
val host : nuhost -> string

74
obj.h
View File

@ -1,74 +0,0 @@
#ifndef __OBJ_H__
#define __OBJ_H__
#include <stdio.h>
#include <stdlib.h>
/* obj.h: objecty and exceptiony stuff
*
* Some macros to make C a bit more like C++, but without bringing in
* all of C++'s crapola.
*/
/* Here's an example:
*
* int
* foo()
* {
* struct bar *b = NULL;
* FILE *f = NULL;
*
* attempt {
* b = new(struct bar);
* if (! b) fail;
*
* f = fopen("foo", "r");
* if (! f) fail;
*
* (void)fgets(b->baz, 10, f);
* }
*
* if (f) {
* (void)fclose(f);
* }
*
* recover {
* if (b) {
* free(b);
* }
* return -1;
* }
*
* return 0;
* }
*/
/** Exception-type things
*
* These allow you to have pseudo-exceptions. It looks kludgy and it
* is, but it's only that way so you can have nice pretty code.
*/
static int __obj_passed = 0;
#define attempt for (__obj_passed = 0; !__obj_passed; __obj_passed = 1)
#define fail break
#define succeed continue
#define recover if (__obj_passed ? (__obj_passed = 0) : 1)
#define new(type) (type *)calloc(1, sizeof(type))
/* Some things I use for debugging */
#ifdef NODUMP
# define DUMPf(fmt, args...)
#else
# define DUMPf(fmt, args...) fprintf(stderr, "%s:%s:%d " fmt "\n", __FILE__, __FUNCTION__, __LINE__, ##args)
#endif
#define DUMP() DUMPf("")
#define DUMP_d(v) DUMPf("%s = %d", #v, v)
#define DUMP_x(v) DUMPf("%s = 0x%x", #v, v)
#define DUMP_s(v) DUMPf("%s = %s", #v, v)
#define DUMP_c(v) DUMPf("%s = '%c' (0x%02x)", #v, v, v)
#define DUMP_p(v) DUMPf("%s = %p", #v, v)
#endif

99
process.ml
View File

@ -1,99 +0,0 @@
let spawn prog args =
let fd0_exit, fd0_entr = Unix.pipe () in
let fd1_exit, fd1_entr = Unix.pipe () in
match (Unix.fork ()) with
| 0 -> (* Child *)
Unix.dup2 fd0_exit Unix.stdin;
Unix.close fd0_entr;
Unix.close fd0_exit;
Unix.dup2 fd1_entr Unix.stdout;
Unix.close fd1_entr;
Unix.close fd1_exit;
Unix.execvp prog args
| pid -> (* Parent *)
Unix.close fd0_exit;
Unix.close fd1_entr;
(fd0_entr, fd1_exit)
let create d text input_handler output_handler prog args =
let child_stdin, child_stdout = spawn prog args in
Dispatch.add d child_stdin output_handler [Dispatch.Output];
Dispatch.add d child_stdout input_handler [Dispatch.Input]
(** Canned process: sends a string on stdin, collects stdout and stderr,
and calls a callback when everything's finished. *)
type canned = {
finished : string -> unit;
stdin : string;
stdout : string;
stderr : string;
mutable stdin_pos : int;
mutable stdout_pos : int;
mutable stderr_pos : int;
}
let canned_handler d p fd event =
match event with
| Dispatch.Input ->
let len =
Unix.read fd p.stdout p.stdout_pos
((String.length p.stdout) - p.stdout_pos)
in
if (len > 0) then
p.stdout_pos <- p.stdout_pos + len
else begin
Dispatch.delete d fd;
p.finished (String.sub p.stdout 0 p.stdout_pos)
end
| Dispatch.Output ->
let len =
Unix.write fd p.stdin p.stdin_pos
((String.length p.stdin) - p.stdin_pos)
in
p.stdin_pos <- p.stdin_pos + len;
if (p.stdin_pos == String.length p.stdin) then begin
Unix.close fd;
Dispatch.delete d fd
end
| Dispatch.Exception ->
()
let create_canned d text finished prog args =
let p =
{
finished=finished;
stdin=text; stdin_pos=0;
stdout=String.create 8192; stdout_pos=0;
stderr=String.create 8192; stderr_pos=0;
}
in
let handler = (canned_handler d p)
in
create d text handler handler prog args
(** Zombie reapin' mayhem *)
let rec sigchld s =
try
match Unix.waitpid [Unix.WNOHANG] (-1) with
| (0, _) ->
()
| _ ->
sigchld s
with Unix.Unix_error (Unix.ECHILD, _, _) ->
()
let _ =
Sys.set_signal Sys.sigchld (Sys.Signal_handle sigchld)

457
tests.ml
View File

@ -1,457 +0,0 @@
open OUnit
let dump x =
Printf.ksprintf (fun str -> prerr_string str; flush stderr) x
(* Return true iff 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
(* ***************************************************
* Epoll stuff
* ***************************************************)
let int_of_file_descr fd = (Obj.magic fd) + 0
let rec epollevents_as_list events =
match events with
| [] ->
[]
| Epoll.In :: tl ->
"POLLIN" :: (epollevents_as_list tl)
| Epoll.Priority :: tl ->
"POLLPRI" :: (epollevents_as_list tl)
| Epoll.Out :: tl ->
"POLLOUT" :: (epollevents_as_list tl)
| Epoll.Error :: tl ->
"POLLERR" :: (epollevents_as_list tl)
| Epoll.Hangup :: tl ->
"POLLHUP" :: (epollevents_as_list tl)
let rec epollfds_as_list pfds =
match pfds with
| [] ->
[]
| (fd, events) :: tl ->
(Printf.sprintf "{fd=%d; events=%s}"
(int_of_file_descr fd)
(String.concat "|" (epollevents_as_list events))) ::
epollfds_as_list tl
let epollfds_as_string pfds =
"[" ^ (String.concat ", " (epollfds_as_list pfds)) ^ "]"
let epollfd_as_string pfd =
epollfds_as_string [pfd]
let epoll_expect e ?(n=3) l =
let m = Epoll.wait e n 0 in
assert_equal
~printer:epollfds_as_string
(List.sort compare l)
(List.sort compare m)
(* ***************************************************
* Chat script stuff
* ***************************************************)
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 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 a [Dispatch.fd_handler] function to run script [s] *)
let chat d fd s =
let script = ref s in
(* Add some amount, dependent on fd, to the timeout value, so peers won't obliterate it *)
let timer = (Unix.time ()) +. 1.0 +. (0.01 *. (float_of_int (int_of_file_descr fd))) in
let obuf = Buffer.create 4096 in
let ibuf = Buffer.create 4096 in
let handle_timer _ =
failwith (Printf.sprintf "fd=%d timeout waiting for %s"
(int_of_file_descr fd)
(string_of_chat_event (List.hd !script)))
in
let nomatch got =
failwith (Printf.sprintf "fd=%d\nexpecting %s\n got %s"
(int_of_file_descr fd)
(string_of_chat_event (List.hd !script))
(String.escaped got))
in
let rec run_script fd =
match !script with
| [] ->
if ((Buffer.length obuf) = 0) then begin
Dispatch.delete_timer d timer;
(try
Dispatch.delete d fd
with (Failure _) ->
());
Unix.close fd
end
| Send buf :: tl ->
Buffer.add_string obuf buf;
Dispatch.modify d fd [Dispatch.Input; Dispatch.Output];
script := tl;
run_script fd
| Recv buf :: tl ->
let buf_len = String.length buf in
let ibuf_str = Buffer.contents ibuf in
if ((Buffer.length ibuf) >= buf_len) then begin
if startswith ibuf_str buf then begin
script := tl;
Buffer.clear ibuf;
Buffer.add_substring
ibuf
ibuf_str
buf_len
((String.length ibuf_str) - buf_len);
run_script fd
end else
nomatch ibuf_str
end else
()
| Regex buf :: tl ->
let ibuf_str = Buffer.contents ibuf in
let matched = Str.string_match (Str.regexp buf) ibuf_str 0 in
if (Buffer.length ibuf > 0) then
if matched then
let match_len = Str.match_end () in
script := tl;
Buffer.clear ibuf;
Buffer.add_substring
ibuf
ibuf_str
match_len
((String.length ibuf_str) - match_len);
run_script fd
else
nomatch ibuf_str
else
()
in
let rec handler fd events =
match events with
| [] ->
()
| Dispatch.Input :: tl ->
let s = String.create 4096 in
let n = Unix.read fd s 0 4096 in
Buffer.add_substring ibuf s 0 n;
run_script fd;
handler fd tl
| Dispatch.Output :: tl ->
begin
if ((Buffer.length obuf) = 0) then
Dispatch.modify d fd [Dispatch.Input]
else
let ostr = Buffer.contents obuf in
let olen = Buffer.length obuf in
let n = Unix.write fd ostr 0 olen in
Buffer.clear obuf;
Buffer.add_substring obuf ostr n (olen - n)
end;
handler fd tl
| Dispatch.Hangup :: tl ->
(* Stop listening to this fd, it will always return Hangup *)
(try
Dispatch.delete d fd
with (Failure _) ->
())
| _ ->
failwith "Unexpected event"
in
Dispatch.add_timer d handle_timer timer;
Dispatch.add d fd handler [Dispatch.Input];
run_script fd
(* ***************************************************
* The tests
* ***************************************************)
let unit_tests =
"Unit tests" >::: [
"Epoll" >::
(fun () ->
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let e = Epoll.create 1 in
let expect = epoll_expect e in
Epoll.ctl e Epoll.Add (a, [Epoll.Out; Epoll.In]);
expect [(a, [Epoll.Out])];
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]);
expect [];
Epoll.ctl e Epoll.Add (b, [Epoll.Out; Epoll.In]);
expect [(b, [Epoll.Out])];
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
assert_equal
1
(List.length (Epoll.wait e 1 0));
Epoll.ctl e Epoll.Modify (a, [Epoll.Out; Epoll.In]);
expect [(a, [Epoll.Out]); (b, [Epoll.Out])];
assert_equal
2
(Unix.write a "hi" 0 2);
expect [(a, [Epoll.Out]); (b, [Epoll.In; Epoll.Out])];
Epoll.ctl e Epoll.Delete (a, []);
expect [(b, [Epoll.In; Epoll.Out])];
assert_raises
(Failure "ocaml_epoll_ctl: No such file or directory")
(fun () ->
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
assert_raises
(Failure "ocaml_epoll_ctl: File exists")
(fun () ->
Epoll.ctl e Epoll.Add (b, [Epoll.In; Epoll.Priority]));
expect [(b, [Epoll.In; Epoll.Out])];
Unix.close a;
expect [(b, [Epoll.In; Epoll.Out; Epoll.Hangup])];
assert_raises
(Failure "ocaml_epoll_ctl: Bad file descriptor")
(fun () ->
Epoll.ctl e Epoll.Modify (a, [Epoll.In; Epoll.Priority]));
Unix.close b;
Epoll.destroy e
);
"Dispatch" >::
(fun () ->
let d = Dispatch.create 3 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let last_event = ref (a, []) in
let rec handle fd events =
last_event := (fd, events)
in
let last_timer = ref 0.0 in
let handle_timer time =
last_timer := time
in
let s = String.create 4096 in
assert_equal 8 (Unix.write a "dispatch" 0 8);
Dispatch.add d b handle [Dispatch.Input; Dispatch.Output];
Dispatch.once d;
assert_equal (b, [Dispatch.Input; Dispatch.Output]) !last_event;
assert_equal 8 (Unix.read b s 0 4096);
assert_equal "dispatch" (Str.string_before s 8);
(let time = ((Unix.gettimeofday ()) +. 0.01) in
Dispatch.add_timer d handle_timer time;
Dispatch.add_timer d handle_timer ((Unix.gettimeofday ()) +. 10.0);
assert_equal ~printer:string_of_float 0.0 !last_timer;
Dispatch.once d;
assert_equal ~printer:string_of_float 0.0 !last_timer;
Dispatch.modify d b [Dispatch.Input];
Dispatch.once d;
if (!last_timer = 0.0) then
(* Give it one chance *)
Dispatch.once d;
assert_equal ~printer:string_of_float time !last_timer;
Dispatch.modify d b [Dispatch.Input; Dispatch.Output];
assert_equal 6 (Unix.write a "gnarly" 0 6);
Dispatch.once d;
assert_equal (b, [Dispatch.Input; Dispatch.Output]) !last_event;
assert_equal 6 (Unix.read b s 0 4096);
assert_equal ~printer:string_of_float time !last_timer);
Dispatch.once d;
assert_equal (b, [Dispatch.Output]) !last_event;
Dispatch.destroy d;
Unix.close a;
Unix.close b
);
"command_of_string" >::
(fun () ->
assert_equal
~printer:Command.as_string
(Command.create None "NICK" ["name"] None)
(Command.from_string "NICK name");
assert_equal
~printer:Command.as_string
(Command.create None "NICK" ["name"] None)
(Command.from_string "nick name");
assert_equal
~printer:Command.as_string
(Command.create (Some "foo") "NICK" ["name"] None)
(Command.from_string ":foo NICK name");
assert_equal
~printer:Command.as_string
(Command.create (Some "foo.bar") "PART" ["#foo"; "#bar"]
(Some "ta ta"))
(Command.from_string ":foo.bar PART #foo #bar :ta ta");
);
"Chat test" >::
(fun () ->
let d = Dispatch.create 3 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
chat d a
[Send "banner";
Recv "hi";
Send "ehlo there, pleased to meet you"];
chat d b
[Recv "banner";
Send "hi";
Regex "ehlo .* you"];
Dispatch.run d;
);
]
let do_login nick =
[
Send ("USER " ^ nick ^ " +iw " ^ nick ^ " :gecos\r\n");
Send ("NICK " ^ nick ^ "\r\n");
Recv (":testserver.test 001 " ^ nick ^ " :Welcome to IRC.\r\n");
Recv (":testserver.test 002 " ^ nick ^ " :I am testserver.test Running version " ^ Irc.version ^ "\r\n");
Recv (":testserver.test 003 " ^ nick ^ " :This server was created " ^ (string_of_float Irc.start_time) ^ "\r\n");
Recv (":testserver.test 004 " ^ nick ^ " :testserver.test 0.1 l aimnqpsrtklb\r\n");
]
let regression_tests =
"Regression tests" >:::
[
"Simple connection" >::
(fun () ->
let script =
(do_login "nick") @
[
Send "BLARGH\r\n";
Recv ":testserver.test 421 nick BLARGH :Unknown or misconstructed command\r\n";
Send "MOTD\r\n";
Recv ":testserver.test 422 nick :MOTD File is missing\r\n";
Send "TIME\r\n";
Regex ":testserver\\.test 391 nick testserver\\.test :[-0-9]+T[:0-9]+Z\r\n";
Send "VERSION\r\n";
Recv ":testserver.test 351 nick 0.1 testserver.test :\r\n";
Send "PING snot\r\n";
Recv ":testserver.test PONG testserver.test :snot\r\n";
Send "PING :snot\r\n";
Recv ":testserver.test PONG testserver.test :snot\r\n";
Send "PONG snot\r\n";
Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 nick :nick\r\n";
Send "ISON otherguy thirdguy\r\n";
Recv ":testserver.test 303 nick :\r\n";
Send "PRIVMSG nick :hello\r\n";
Recv ":nick!nick@UDS PRIVMSG nick :hello\r\n";
Send "NOTICE nick :hello\r\n";
Recv ":nick!nick@UDS NOTICE nick :hello\r\n";
Send "PRIVMSG otherguy :hello\r\n";
Recv ":testserver.test 401 nick otherguy :No such nick/channel\r\n";
Send "AWAY :eating biscuits\r\n";
Recv ":testserver.test 306 nick :You have been marked as being away\r\n";
Send "AWAY\r\n";
Recv ":testserver.test 305 nick :You are no longer marked as being away\r\n";
Send "ERROR :I peed my pants\r\n";
Recv ":testserver.test NOTICE nick :Bummer.\r\n";
Send "INFO\r\n";
Recv (":testserver.test 371 nick :pgircd v" ^ Irc.version ^ "\r\n");
Recv (Printf.sprintf ":testserver.test 371 nick :Running since %f\r\n" Irc.start_time);
Recv ":testserver.test 374 nick :End of INFO list\r\n";
]
in
let d = Dispatch.create 2 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Client.handle_connection d a (Unix.getpeername a);
chat d b script;
Dispatch.run d);
"Second connection" >::
(fun () ->
let script =
(do_login "otherguy") @
[
Send "ISON nick otherguy\r\n";
Recv ":testserver.test 303 otherguy :otherguy\r\n";
]
in
let d = Dispatch.create 2 in
let a,b = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Client.handle_connection d a (Unix.getpeername a);
chat d b script;
Dispatch.run d);
"Simultaneous connections" >::
(fun () ->
let script1 =
(do_login "alice") @
[
Send "ISON bob\r\n";
Recv ":testserver.test 303 alice :bob\r\n";
Send "PRIVMSG #foo :snot\r\n";
Recv ":testserver.test 403 alice #foo :No such channel\r\n";
Send "NOTICE #foo :snot\r\n";
Recv ":testserver.test 403 alice #foo :No such channel\r\n";
Send "JOIN #foo\r\n";
Recv ":alice!alice@UDS JOIN #foo\r\n";
Send "PRIVMSG bob :Come to #foo\r\n";
Recv ":bob!bob@UDS JOIN #foo\r\n";
Send "PRIVMSG #foo :hello bob\r\n";
Recv ":bob!bob@UDS NOTICE #foo :hello alice\r\n";
Send "QUIT :foo\r\n";
Recv ":testserver.test ERROR :So long\r\n";
]
in
let script2 =
(do_login "bob") @
[
Send "ISON alice charlie\r\n";
Recv ":testserver.test 303 bob :alice\r\n";
Recv ":alice!alice@UDS PRIVMSG bob :Come to #foo\r\n";
Send "JOIN #foo\r\n";
Recv ":bob!bob@UDS JOIN #foo\r\n";
Recv ":alice!alice@UDS PRIVMSG #foo :hello bob\r\n";
Send "NOTICE #foo :hello alice\r\n";
Send "QUIT :foo\r\n";
Recv ":testserver.test ERROR :So long\r\n";
]
in
let d = Dispatch.create 4 in
let aa,ab = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
let ba,bb = Unix.socketpair Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Client.handle_connection d aa (Unix.getpeername aa);
Client.handle_connection d ba (Unix.getpeername ba);
chat d ab script1;
chat d bb script2;
Dispatch.run d);
]
let _ =
Irc.name := "testserver.test";
run_test_tt_main (TestList [unit_tests; regression_tests])