From 73f7afea731cb8f095f077f6f92d723f11cf51fc Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Thu, 6 Jan 2011 21:08:21 -0700 Subject: [PATCH 1/5] C version --- Makefile | 28 +-- README | 8 +- TODO | 3 - bot.ml | 173 ------------------- cobalt | 9 +- cobalt-handler | 37 +++- command.ml | 78 --------- command.mli | 11 -- dispatch.c | 351 +++++++++++++++++++++++++++++++++++++ dispatch.ml | 138 --------------- dispatch.mli | 48 ------ dump.h | 19 ++ firebot | 35 ++-- infobot | 1 + iobuf.ml | 115 ------------- iobuf.mli | 12 -- irc.c | 137 +++++++++++++++ irc.ml | 65 ------- irc.mli | 17 -- obj.h | 74 -------- process.ml | 99 ----------- tests.ml | 457 ------------------------------------------------- 22 files changed, 561 insertions(+), 1354 deletions(-) delete mode 100644 TODO delete mode 100644 bot.ml delete mode 100644 command.ml delete mode 100644 command.mli create mode 100644 dispatch.c delete mode 100644 dispatch.ml delete mode 100644 dispatch.mli create mode 100644 dump.h delete mode 100644 iobuf.ml delete mode 100644 iobuf.mli create mode 100644 irc.c delete mode 100644 irc.ml delete mode 100644 irc.mli delete mode 100644 obj.h delete mode 100644 process.ml delete mode 100644 tests.ml diff --git a/Makefile b/Makefile index 023f39c..d2cc6a3 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/README b/README index 39aafbf..fb7ba96 100644 --- a/README +++ b/README @@ -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 diff --git a/TODO b/TODO deleted file mode 100644 index 45c7921..0000000 --- a/TODO +++ /dev/null @@ -1,3 +0,0 @@ -* Modify Ocs_port to use Buffer instead of String - - diff --git a/bot.ml b/bot.ml deleted file mode 100644 index 3a99e25..0000000 --- a/bot.ml +++ /dev/null @@ -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 () diff --git a/cobalt b/cobalt index 4967985..8b5819c 100755 --- a/cobalt +++ b/cobalt @@ -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 diff --git a/cobalt-handler b/cobalt-handler index a7fe010..c146825 100755 --- a/cobalt-handler +++ b/cobalt-handler @@ -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 diff --git a/command.ml b/command.ml deleted file mode 100644 index 1aa287f..0000000 --- a/command.ml +++ /dev/null @@ -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 diff --git a/command.mli b/command.mli deleted file mode 100644 index d8e1fd7..0000000 --- a/command.mli +++ /dev/null @@ -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 diff --git a/dispatch.c b/dispatch.c new file mode 100644 index 0000000..f38140c --- /dev/null +++ b/dispatch.c @@ -0,0 +1,351 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#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; +} diff --git a/dispatch.ml b/dispatch.ml deleted file mode 100644 index 975b71f..0000000 --- a/dispatch.ml +++ /dev/null @@ -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 - diff --git a/dispatch.mli b/dispatch.mli deleted file mode 100644 index 6e07529..0000000 --- a/dispatch.mli +++ /dev/null @@ -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 *) diff --git a/dump.h b/dump.h new file mode 100644 index 0000000..b122fe0 --- /dev/null +++ b/dump.h @@ -0,0 +1,19 @@ +#ifndef __DUMP_H__ +#define __DUMP_H__ + +#include + +/* 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 diff --git a/firebot b/firebot index 845ab66..85cac26 100755 --- a/firebot +++ b/firebot @@ -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 diff --git a/infobot b/infobot index 591480f..b91eebe 100755 --- a/infobot +++ b/infobot @@ -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 diff --git a/iobuf.ml b/iobuf.ml deleted file mode 100644 index 260daa7..0000000 --- a/iobuf.ml +++ /dev/null @@ -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 diff --git a/iobuf.mli b/iobuf.mli deleted file mode 100644 index 3c0e225..0000000 --- a/iobuf.mli +++ /dev/null @@ -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 diff --git a/irc.c b/irc.c new file mode 100644 index 0000000..6889050 --- /dev/null +++ b/irc.c @@ -0,0 +1,137 @@ +#include +#include +#include +#include +#include + +#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; +} diff --git a/irc.ml b/irc.ml deleted file mode 100644 index 90a850d..0000000 --- a/irc.ml +++ /dev/null @@ -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 diff --git a/irc.mli b/irc.mli deleted file mode 100644 index fadde39..0000000 --- a/irc.mli +++ /dev/null @@ -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 diff --git a/obj.h b/obj.h deleted file mode 100644 index de2eca0..0000000 --- a/obj.h +++ /dev/null @@ -1,74 +0,0 @@ -#ifndef __OBJ_H__ -#define __OBJ_H__ - -#include -#include - -/* 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 diff --git a/process.ml b/process.ml deleted file mode 100644 index 6847b15..0000000 --- a/process.ml +++ /dev/null @@ -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) - diff --git a/tests.ml b/tests.ml deleted file mode 100644 index 07da2f9..0000000 --- a/tests.ml +++ /dev/null @@ -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]) From f2eea13f8ee498b98b4635788964218a4231024b Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Thu, 6 Jan 2011 21:17:16 -0700 Subject: [PATCH 2/5] Fix infobot \factoid bug --- cobalt-handler | 1 - infobot | 3 +-- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/cobalt-handler b/cobalt-handler index c146825..85d42d5 100755 --- a/cobalt-handler +++ b/cobalt-handler @@ -41,7 +41,6 @@ case $command in raw "PRIVMSG %s :Thanks for the invitation, %s." "$forum" "$sender" ;; esac | while read -r line; do - echo $line 1>&2 case "$line" in *) printf "%s\r\n" "${line#}" diff --git a/infobot b/infobot index b91eebe..e3e46c6 100755 --- a/infobot +++ b/infobot @@ -63,7 +63,6 @@ EOF ;; *) resp=$(lookup "$text" | shuf -n 1 | sed "s/\$sender/$sender/") - echo "resp: $resp" 1>&2 case "$resp" in "") exit 1 @@ -72,7 +71,7 @@ EOF echo "Someone's up to no good!" ;; \\*) - printf "%s" "${resp#\\}" + printf "%s\n" "${resp#\\}" ;; :*) printf '\001ACTION %s\001\n' "${resp#:}" From 5dde54f056e0d6fb74677d16d9fafa5112ab87c8 Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Thu, 6 Jan 2011 22:08:00 -0700 Subject: [PATCH 3/5] Modify debug output --- cobalt-handler | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cobalt-handler b/cobalt-handler index 85d42d5..3375144 100755 --- a/cobalt-handler +++ b/cobalt-handler @@ -8,7 +8,7 @@ text=$1; export text; shift # $* is now args # Debug output -echo ${pfx:+:}$pfx $command "$@" ${text:+:}"$text" 1>&2 +echo '>>>' ${pfx:+:}$pfx $command "$@" ${text:+:}"$text" 1>&2 raw () { fmt="\007$1\n"; shift From f4f4ec9aebb385c4250e3a508d71f000fe932cdb Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Thu, 6 Jan 2011 22:21:32 -0700 Subject: [PATCH 4/5] Update README a little --- README | 46 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/README b/README index fb7ba96..b21dfd9 100644 --- a/README +++ b/README @@ -1,7 +1,51 @@ bot === -If djb ever wrote an IRC bot, it might look something like this. +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. + + +dispatch +-------- + +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. + + +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 From 878830d39f261d4ab081fd19931b9ea030b4c12f Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Thu, 6 Jan 2011 22:25:02 -0700 Subject: [PATCH 5/5] A little more in README --- README | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/README b/README index b21dfd9..d74b424 100644 --- a/README +++ b/README @@ -36,6 +36,40 @@ 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 =======================