Add scheme interpreter, move away from omake

This commit is contained in:
Neale Pickett 2009-03-02 23:26:04 -07:00
parent 341d20ad8d
commit 18491d1314
6 changed files with 119 additions and 77 deletions

42
Makefile Normal file
View File

@ -0,0 +1,42 @@
OCS_VERSION = 1.0.3
OCS_DIR = ocs-$(OCS_VERSION)
INCLUDES = -I $(OCS_DIR)/src
OCAMLFLAGS = $(INCLUDES)
OCAMLOPT = ocamlopt
OCAMLC = ocamlc
OCAMLDEP = ocamldep $(INCLUDES)
OCAMLLIBS = unix.cma str.cma nums.cma
bot: irc.cmo dispatch.cmo command.cmo iobuf.cmo cdb.cmo bot.cmo
bot: $(OCS_DIR)/src/ocs.cma
$(OCAMLC) -o $@ $(OCAMLLIBS) $^
$(OCS_DIR)/src/ocs.cma $(OCS_DIR)/src/ocs.cmxa: $(OCS_DIR)
cd $(OCS_DIR)/src && make
$(OCS_DIR): ocs-$(OCS_VERSION).tar.gz
tar xzf $<
ocs-$(OCS_VERSION).tar.gz:
wget http://will.iki.fi/software/ocs/files/$@
.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

View File

@ -1,33 +0,0 @@
OCAMLPACKS[] =
unix
str
OCAMLCFLAGS += -g
.DEFAULT: bot
OCamlProgram(bot, bot irc command iobuf dispatch cdb)
section
OCAMLPACKS[] +=
oUnit
NATIVE_ENABLED = false
tests.cmx:
tests.cmi:
tests.cmo:
tests$(EXT_OBJ):
dispatch_tests.cmx:
dispatch_tests.cmi:
dispatch_tests.cmo:
dispatch_tests$(EXT_OBJ):
OCamlProgram(tests, tests dispatch irc command iobuf client channel)
.PHONY: test
test: tests
./tests
.PHONY: clean
clean:
rm $(filter-proper-targets $(ls R, .))

View File

@ -1,17 +0,0 @@
open build/C
open build/OCaml
USE_OCAMLFIND = true
NATIVE_ENABLED = true
BYTE_ENABLED = true
#
# The command-line variables are defined *after* the
# standard configuration has been loaded.
#
DefineCommandVars()
#
# Include the OMakefile in this directory.
#
.SUBDIRS: .

20
README
View File

@ -1,17 +1,19 @@
Pretty Good IRC Daemon
======================
bot
===
This is a feature-stripped IRC daemon similar to the now-defunct iacd.
It provides an additional set of commands to allow clients to intercept
all channel activity. This allows a whole new range of possibilites for
bots: including something as simple as rot13-encoding all channel
discussions, to something as complex as a full MUD or MOO.
It's a bot with a scheme interpreter in it.
Downloading
-----------
If you can read this, I forgot to update the README! Please mail
neale@woozle.org and I'll publish a URL for a download.
http://woozle.org/~neale/gitweb.cgi
Author
------
Neale Pickett <neale@woozle.org>

1
TODO Normal file
View File

@ -0,0 +1 @@
*

77
bot.ml
View File

@ -16,17 +16,50 @@ let write iobuf command args text =
print_endline ("--> " ^ (Command.as_string cmd));
Iobuf.write iobuf cmd
let handle_command iobuf cmd =
print_endline ("<-- " ^ (Command.as_string cmd));
match Command.as_tuple cmd with
| (_, "PING", _, text) ->
write iobuf "PONG" [] text
| (_, "001", _, _) ->
write iobuf "JOIN" ["#bot"] None
| (Some who, "JOIN", [], Some chan) ->
write iobuf "PRIVMSG" [chan] (Some "hi asl")
| (Some who, "PRIVMSG", [target], Some text) ->
if target.[0] = '#' then
let rec string_of_sval = function
| Ocs_types.Snull -> "()"
| Ocs_types.Seof -> "#<eof>"
| Ocs_types.Strue -> "#t"
| Ocs_types.Sfalse -> "#f"
| Ocs_types.Sstring s -> s
| Ocs_types.Ssymbol s -> s
| Ocs_types.Sint i -> (string_of_int i)
| Ocs_types.Sreal r -> (Ocs_numstr.string_of_real r)
| Ocs_types.Scomplex z -> (Ocs_numstr.string_of_complex z)
| Ocs_types.Sbigint b -> (Big_int.string_of_big_int b)
| Ocs_types.Srational r -> (Ratio.string_of_ratio r)
| Ocs_types.Schar c -> String.make 1 c
| Ocs_types.Spair l -> "#<it's a pair>"
| Ocs_types.Svector v -> "#<it's a vector>"
| Ocs_types.Sport _ -> "#<port>"
| Ocs_types.Sproc _ -> "#<procedure>"
| Ocs_types.Sprim { Ocs_types.prim_fun = _; Ocs_types.prim_name = n } ->
"#<primitive:" ^ n ^ ">"
| Ocs_types.Spromise _ -> "#<promise>"
| Ocs_types.Sesym (_, s) -> string_of_sval s
| Ocs_types.Swrapped _ -> "#<wrapped>"
| Ocs_types.Sunspec -> "#<unspecified>"
| _ -> "#<unknown>"
let scheme_eval str =
let thread = Ocs_top.make_thread () in
let env = Ocs_top.make_env () in
let inport = Ocs_port.string_input_port str in
let lexer = Ocs_lex.make_lexer inport "interactive" in
let v = Ocs_read.read_expr lexer in
let c = Ocs_compile.compile env v in
let buf = Buffer.create 20 in
let printer v =
Buffer.add_string buf (string_of_sval v)
in
try
Ocs_eval.eval thread printer c;
Buffer.contents buf
with Ocs_error.Error msg ->
msg
let handle_privmsg iobuf sender target text =
try
let factoid = get_one text in
let response =
@ -36,13 +69,27 @@ let handle_command iobuf cmd =
| '\\' ->
Str.string_after factoid 1
| _ ->
Printf.sprintf "Gosh, %s, I think %s is %s" who text factoid
Printf.sprintf "Gosh, %s, I think %s is %s" sender text factoid
in
write iobuf "PRIVMSG" [target] (Some response)
with Not_found ->
()
else
()
if text.[0] == '(' then
let result = scheme_eval text in
write iobuf "PRIVMSG" [target] (Some result)
let handle_command iobuf cmd =
print_endline ("<-- " ^ (Command.as_string cmd));
match Command.as_tuple cmd with
| (_, "PING", _, text) ->
write iobuf "PONG" [] text
| (_, "001", _, _) ->
write iobuf "JOIN" ["#bot"] None
| (Some sender, "JOIN", [], Some chan) ->
write iobuf "PRIVMSG" [chan] (Some "hi asl")
| (Some sender, "PRIVMSG", [target], Some text) ->
if target.[0] = '#' then
handle_privmsg iobuf sender target text
| _ ->
()