C version

This commit is contained in:
Neale Pickett 2011-01-06 21:08:21 -07:00
parent a07c3e9f7b
commit 73f7afea73
22 changed files with 561 additions and 1354 deletions

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

8
README
View File

@ -1,13 +1,7 @@
bot
===
It's a bot with a scheme interpreter in it.
Downloading
-----------
http://woozle.org/~neale/gitweb.cgi
If djb ever wrote an IRC bot, it might look something like this.
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 ()

9
cobalt
View File

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

View File

@ -1,21 +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
text=$(cat)
# 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
@ -29,7 +38,17 @@ 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
echo $line 1>&2
case "$line" in
*)
printf "%s\r\n" "${line#}"
;;
*)
printf "PRIVMSG %s :%s\r\n" "$forum" "$line"
;;
esac
done

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

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;
}

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

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

35
firebot
View File

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

View File

@ -63,6 +63,7 @@ EOF
;;
*)
resp=$(lookup "$text" | shuf -n 1 | sed "s/\$sender/$sender/")
echo "resp: $resp" 1>&2
case "$resp" in
"")
exit 1

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

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

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])