mirror of https://github.com/nealey/irc-bot
Merge commit 'origin/master'
Conflicts: cobalt cobalt-handler firebot infobot
This commit is contained in:
commit
c2168b714a
28
Makefile
28
Makefile
|
|
@ -1,28 +1,8 @@
|
||||||
INCLUDES =
|
CFLAGS = -Wall -Werror
|
||||||
OCAMLFLAGS = $(INCLUDES)
|
TARGETS = dispatch irc
|
||||||
OCAMLOPT = ocamlopt
|
|
||||||
OCAMLC = ocamlc -g
|
|
||||||
OCAMLDEP = ocamldep $(INCLUDES)
|
|
||||||
OCAMLLIBS = unix.cma str.cma nums.cma
|
|
||||||
|
|
||||||
bot: irc.cmo dispatch.cmo process.cmo command.cmo iobuf.cmo bot.cmo
|
all: $(TARGETS)
|
||||||
$(OCAMLC) -o $@ $(OCAMLLIBS) $^
|
|
||||||
|
|
||||||
.PHONY: clean
|
.PHONY: clean
|
||||||
clean:
|
clean:
|
||||||
rm -f bot *.cm* *.o
|
rm -f $(TARGETS) *.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
|
|
||||||
|
|
|
||||||
80
README
80
README
|
|
@ -1,13 +1,85 @@
|
||||||
bot
|
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
|
Author
|
||||||
|
|
|
||||||
173
bot.ml
173
bot.ml
|
|
@ -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
7
cobalt
|
|
@ -1,9 +1,6 @@
|
||||||
#! /bin/sh
|
#! /bin/sh
|
||||||
|
|
||||||
while true; do
|
while true; do
|
||||||
./bot \
|
tcpclient woozle.org 6667 ./bot cobalt
|
||||||
-n cobalt \
|
sleep 5
|
||||||
-u cobalt \
|
|
||||||
-a ./cobalt-handler \
|
|
||||||
socat STDIO OPENSSL:woozle.org:6697,verify=0
|
|
||||||
done
|
done
|
||||||
|
|
|
||||||
|
|
@ -1,24 +1,30 @@
|
||||||
#! /bin/sh
|
#! /bin/sh
|
||||||
|
|
||||||
|
pfx=$1; export pfx; shift
|
||||||
|
command=$1; export command; shift
|
||||||
sender=$1; export sender; shift
|
sender=$1; export sender; shift
|
||||||
forum=$1; export forum; shift
|
forum=$1; export forum; shift
|
||||||
prefix=$1; export prefix; shift
|
text=$1; export text; shift
|
||||||
command=$1; export command; shift
|
|
||||||
# $* is now args
|
# $* is now args
|
||||||
|
|
||||||
# Remeber, read discards leading whitespace. If that's not okay, use
|
# Debug output
|
||||||
# text=$(cat)
|
echo '>>>' ${pfx:+:}$pfx $command "$@" ${text:+:}"$text" 1>&2
|
||||||
read -r text
|
|
||||||
|
raw () {
|
||||||
|
fmt="\007$1\n"; shift
|
||||||
|
printf "$fmt" "$@"
|
||||||
|
}
|
||||||
|
|
||||||
join () {
|
join () {
|
||||||
printf '\aJOIN %s\n' "$1"
|
raw "JOIN $1"
|
||||||
}
|
}
|
||||||
|
|
||||||
case $command in
|
case $command in
|
||||||
001)
|
001)
|
||||||
join "#woozle"
|
join "#cobalt"
|
||||||
join "#foozle"
|
;;
|
||||||
join "#bot"
|
433)
|
||||||
|
raw "NICK bottimus"
|
||||||
;;
|
;;
|
||||||
PRIVMSG)
|
PRIVMSG)
|
||||||
case "$forum" in
|
case "$forum" in
|
||||||
|
|
@ -32,7 +38,16 @@ case $command in
|
||||||
;;
|
;;
|
||||||
INVITE)
|
INVITE)
|
||||||
join "$forum"
|
join "$forum"
|
||||||
echo "Thanks for the invitation, $sender."
|
raw "PRIVMSG %s :Thanks for the invitation, %s." "$forum" "$sender"
|
||||||
|
;;
|
||||||
|
esac | while read -r line; do
|
||||||
|
case "$line" in
|
||||||
|
*)
|
||||||
|
printf "%s\r\n" "${line#}"
|
||||||
|
;;
|
||||||
|
*)
|
||||||
|
printf "PRIVMSG %s :%s\r\n" "$forum" "$line"
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
|
done
|
||||||
|
|
||||||
|
|
|
||||||
78
command.ml
78
command.ml
|
|
@ -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
11
command.mli
|
|
@ -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
|
|
||||||
|
|
@ -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
138
dispatch.ml
|
|
@ -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
48
dispatch.mli
|
|
@ -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 *)
|
|
||||||
|
|
@ -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
17
firebot
|
|
@ -1,23 +1,18 @@
|
||||||
#! /bin/sh
|
#! /bin/sh
|
||||||
|
|
||||||
cmd=${1%% *}
|
cmd=${1%% *}
|
||||||
args=${1#* }
|
[ "$cmd" = "$1" ] || args=${1#* }
|
||||||
case $cmd in
|
case $cmd in
|
||||||
calc)
|
.calc)
|
||||||
printf "%s = " "$args"
|
printf "%s = " "$args"
|
||||||
printf "%s\n" "$args" | bc -l
|
echo "$args" | bc -l
|
||||||
;;
|
;;
|
||||||
units)
|
.units)
|
||||||
src=${args% ->*}
|
src=$(printf "%s" "$args" | sed 's/ ->.*//')
|
||||||
dst=${args#*-> }
|
dst=$(printf "%s" "$args" | sed 's/.*-> //')
|
||||||
units -1 -v -- "$src" "$dst"
|
units -1 -v -- "$src" "$dst"
|
||||||
;;
|
;;
|
||||||
*)
|
*)
|
||||||
exit 1
|
exit 1
|
||||||
;;
|
;;
|
||||||
esac
|
esac
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
2
infobot
2
infobot
|
|
@ -69,7 +69,7 @@ EOF
|
||||||
echo "Someone's up to no good!"
|
echo "Someone's up to no good!"
|
||||||
;;
|
;;
|
||||||
'\'*)
|
'\'*)
|
||||||
printf "%s" "${resp#\\}"
|
printf "%s\n" "${resp#\\}"
|
||||||
;;
|
;;
|
||||||
:*)
|
:*)
|
||||||
printf '\001ACTION %s\001\n' "${resp#:}"
|
printf '\001ACTION %s\001\n' "${resp#:}"
|
||||||
|
|
|
||||||
115
iobuf.ml
115
iobuf.ml
|
|
@ -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
12
iobuf.mli
|
|
@ -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
|
|
||||||
|
|
@ -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
65
irc.ml
|
|
@ -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
17
irc.mli
|
|
@ -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
74
obj.h
|
|
@ -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
99
process.ml
|
|
@ -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
457
tests.ml
|
|
@ -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])
|
|
||||||
Loading…
Reference in New Issue