From 18491d1314a701d050547e1577f5aa3e82992a10 Mon Sep 17 00:00:00 2001 From: Neale Pickett Date: Mon, 2 Mar 2009 23:26:04 -0700 Subject: [PATCH] Add scheme interpreter, move away from omake --- Makefile | 42 ++++++++++++++++++++++++++++ OMakefile | 33 ---------------------- OMakeroot | 17 ------------ README | 20 ++++++++------ TODO | 1 + bot.ml | 83 +++++++++++++++++++++++++++++++++++++++++++------------ 6 files changed, 119 insertions(+), 77 deletions(-) create mode 100644 Makefile delete mode 100644 OMakefile delete mode 100644 OMakeroot create mode 100644 TODO diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..b625dc8 --- /dev/null +++ b/Makefile @@ -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 diff --git a/OMakefile b/OMakefile deleted file mode 100644 index a6364f3..0000000 --- a/OMakefile +++ /dev/null @@ -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, .)) diff --git a/OMakeroot b/OMakeroot deleted file mode 100644 index 8044cb8..0000000 --- a/OMakeroot +++ /dev/null @@ -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: . diff --git a/README b/README index 0a63d99..39aafbf 100644 --- a/README +++ b/README @@ -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 + diff --git a/TODO b/TODO new file mode 100644 index 0000000..a767caf --- /dev/null +++ b/TODO @@ -0,0 +1 @@ +* diff --git a/bot.ml b/bot.ml index b48ed40..18db4f0 100644 --- a/bot.ml +++ b/bot.ml @@ -16,6 +16,68 @@ let write iobuf command args text = print_endline ("--> " ^ (Command.as_string cmd)); Iobuf.write iobuf cmd +let rec string_of_sval = function + | Ocs_types.Snull -> "()" + | Ocs_types.Seof -> "#" + | 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 -> "#" + | Ocs_types.Svector v -> "#" + | Ocs_types.Sport _ -> "#" + | Ocs_types.Sproc _ -> "#" + | Ocs_types.Sprim { Ocs_types.prim_fun = _; Ocs_types.prim_name = n } -> + "#" + | Ocs_types.Spromise _ -> "#" + | Ocs_types.Sesym (_, s) -> string_of_sval s + | Ocs_types.Swrapped _ -> "#" + | Ocs_types.Sunspec -> "#" + | _ -> "#" + +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 = + match factoid.[0] with + | ':' -> + "\001ACTION " ^ (Str.string_after factoid 1) ^ "\001" + | '\\' -> + Str.string_after factoid 1 + | _ -> + Printf.sprintf "Gosh, %s, I think %s is %s" sender text factoid + in + write iobuf "PRIVMSG" [target] (Some response) + with Not_found -> + 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 @@ -23,26 +85,11 @@ let handle_command iobuf cmd = write iobuf "PONG" [] text | (_, "001", _, _) -> write iobuf "JOIN" ["#bot"] None - | (Some who, "JOIN", [], Some chan) -> + | (Some sender, "JOIN", [], Some chan) -> write iobuf "PRIVMSG" [chan] (Some "hi asl") - | (Some who, "PRIVMSG", [target], Some text) -> + | (Some sender, "PRIVMSG", [target], Some text) -> if target.[0] = '#' then - try - let factoid = get_one text in - let response = - match factoid.[0] with - | ':' -> - "\001ACTION " ^ (Str.string_after factoid 1) ^ "\001" - | '\\' -> - Str.string_after factoid 1 - | _ -> - Printf.sprintf "Gosh, %s, I think %s is %s" who text factoid - in - write iobuf "PRIVMSG" [target] (Some response) - with Not_found -> - () - else - () + handle_privmsg iobuf sender target text | _ -> ()