import("std/list"). import("std/str"). import("std/http"). import("config"). -- the lexical environment that $eval uses EVAL_ENV = [("id", id), ("loop", loop), ("repr", repr), ("itos", itos), ("globals", globals), ("locals", locals), ("list", list)]. irc_eval(code, chan, nick) -> do eval_watchdog = \_ -> do value = ref!(false); f = \_ -> do ret = eval(code, EVAL_ENV); setRef!(value, (ret,)) end; thread = thread!(f); sleep!(3000); -- wait 3 seconds val = readRef!(value); if val == false then do kill!(thread); say(chan, nick + ": time limit exceeded") end else do (ret,) = val; say(chan, nick + ": " + repr(ret)) end end; thread!(eval_watchdog) end. fst((x, _)) -> x. -- maybe stuff is_just(("just", _)) -> true. is_just(_) -> false. is_nothing(("nothing",)) -> true. is_nothing(_) -> false. unwrap_maybe(("just", x)) -> x. -- association list -- insert a pair into a map map_insert(assoc, key, value) -> (key, value) :: assoc. -- lookup by key map_lookup([], _) -> ("nothing",). map_lookup((k,v)::xs, key) -> if k == key then ("just", v) else map_lookup(xs, key). -- remove a key from a map map_remove([], key) -> []. map_remove((k,v)::xs, key) -> if k == key then xs else (k,v) :: map_remove(xs, key). -- dead simple XML tag line parser tag_contents("<"::xs, tag) -> do len = list\length(tag); if str\takeS(len, xs) == tag then do _ :: rest = str\dropWhileS(\c -> c != ">", xs); ("just", str\takeUntilS(\c -> c == "<", rest)) end else tag_contents(str\dropS(len+1, xs), tag) end. tag_contents(_::xs, tag) -> tag_contents(xs, tag). tag_contents(_, tag) -> ("nothing",). -- assert? -- irc stuff -- Splits a string by spaces, or until it encounters a :, whereby the following is considered one element. splitirc'("", stracc, acc) -> acc + [stracc]. splitirc'(" "::xs, stracc, acc) -> do splitirc'(xs, "", acc + [stracc]) end. -- prefix message splitirc'(":"::xs, _, acc) -> acc + [xs]. splitirc'(x::xs, stracc, acc) -> splitirc'(xs, stracc + x, acc). -- helper function splitirc(str) -> splitirc'(str, "", []). -- (result, rest) takeUntilSpace'("", acc) -> (acc, ""). -- no spaces takeUntilSpace'(" "::xs, acc) -> (acc, xs). takeUntilSpace'(x::xs, acc) -> takeUntilSpace'(xs, acc + x). takeUntilSpace(str) -> takeUntilSpace'(str, ""). -- takes x!y and returns x ircnick'("!"::xs, acc) -> acc. ircnick'(x::xs, acc) -> ircnick'(xs, acc + x). ircnick(str) -> ircnick'(str, ""). isAdmin(nick) -> list\memberOf?(config\ADMINS, nick). -- state getters getFactoids(state) -> do (factoids,) = state; factoids end. -- state setters setFactoids(state, factoids) -> do (factoids,) end. -- factoid serialization -- basic "key value" (space-separated) format saveFactoids(factoids) -> do file = fopen("factoids.txt", "w"); list\map(\(k,v) -> fputstr(file, k + " " + v + "\n"), factoids); fclose(file) end. loadFactoids() -> do file = fopen("factoids.txt", "r"); fact = loop(\pairs -> if feof(file) != true then do line = fgetline(file); pair = takeUntilSpace(line); pair :: pairs end else false, []); fclose(file); fact end. -- event handling say(chan, msg) -> fputstr(sock, "PRIVMSG " + chan + " :" + msg + "\r\n"). handleMessage(s, nick, chan, "$factoids") -> do factoids = list\map(fst, getFactoids(s)); say(chan, nick + ": " + list\intercalate(" ", factoids)); s end. handleMessage(s, nick, chan, "$defact "::line) -> do (k,v) = takeUntilSpace(line); factoids = getFactoids(s); say(chan, nick + ": defined " + k); setFactoids(s, map_insert(factoids, k, v)) end. handleMessage(s, nick, chan, "$savefacts") -> do if isAdmin(nick) then do saveFactoids(getFactoids(s)); say(chan, "factoids saved.") end else say(chan, nick + ": you are not an admin"); s end. handleMessage(s, nick, chan, "$eval "::line) -> do irc_eval(line, chan, nick); s end. handleMessage(s, nick, chan, "$np "::lastfm_user) -> do http\async_http_get("http://ws.audioscrobbler.com/2.0/?method=user.getrecenttracks&user=" + lastfm_user + "&api_key=" + config\LASTFM_API_KEY + "&limit=1", \resp -> do ("ok", xml) = resp; ("just", artist) = tag_contents(xml, "artist"); ("just", album) = tag_contents(xml, "album"); ("just", title) = tag_contents(xml, "name"); say(chan, nick + ": " + lastfm_user + " is listening to " + artist + " - " + title + " (from " + album + ")") end); s end. handleMessage(s, nick, chan, "$join "::j) -> do if isAdmin(nick) then do fputstr(sock, "JOIN " + j + "\r\n"); s end else s end. handleMessage(s, nick, chan, "$ping") -> do say(chan, nick + ": pong"); s end. handleMessage(s, nick, chan, "$quit") -> do if isAdmin(nick) then do say(chan, "bye!"); fputstr(sock, "QUIT\r\n"); fclose(sock) end else say(chan, nick + ": you are not an admin"); s end. handleMessage(s, nick, chan, "$at "::line) -> do (toNick, fact) = takeUntilSpace(line); factoids = getFactoids(s); factoid = map_lookup(factoids, fact); if is_just(factoid) then do say(chan, toNick + ": " + unwrap_maybe(factoid)); s end else do say(chan, nick + ": No such factoid: " + fact); s end end. -- unknown command, search factoids handleMessage(s, nick, chan, "$"::line) -> do (fact, rest) = takeUntilSpace(line); if rest != "" then s -- it had spaces after it, might not want a factoid else do factoids = getFactoids(s); factoid = map_lookup(factoids, fact); if is_just(factoid) then do say(chan, unwrap_maybe(factoid)); s end else s end end. handleMessage(s, nick, chan, msg) -> s. -- handleCommand(source, cmd, args) handleCommand(s, _, "PING", [ping]) -> do putstrln("ping: " + ping); fputstr(sock, "PONG :" + ping + "\r\n"); s end. handleCommand(s, user, "JOIN", [chan]) -> do putstrln("nick " + ircnick(user) + " joins " + chan); s end. handleCommand(s, user, "PRIVMSG", [recipient, msg]) -> do nick = ircnick(user); target = if recipient != config\NICK then recipient else nick; putstrln(target + " " + "<" + nick + "> " + msg); handleMessage(s, nick, target, msg) end. -- nick list handleCommand(s, _, "353", _::"="::chan::[nicks]) -> do -- nicks is space-separated putstrln("nicks in " + chan + ": " + nicks); s end. handleCommand(s, _, "372", [_,msg]) -> do putstrln("MOTD: " + msg); s end. handleCommand(s, _, "422", [_,msg]) -> do putstrln(msg); s end. -- MOTD is missing handleCommand(s, _, "251", _) -> s. -- There are X users and Y services on Z server(s) handleCommand(s, _, "331", _) -> s. -- No topic is set handleCommand(s, _, "366", _) -> s. -- End of NAMES list handleCommand(s, src, cmd, args) -> do putstrln("Unhandled command: " + cmd + ", with args: " + repr(args) + " from " + src); s end. handleLine(s, ":" :: line) -> do -- sourced message (source, rest) = takeUntilSpace(line); command::args = splitirc(rest); handleCommand(s, source, command, args) end. handleLine(s, line) -> do -- non-sourced message command::args = splitirc(line); handleCommand(s, "", command, args) end. -- now for our actual program! -- build our socket and connect to the server sock = sockopen(config\HOST, config\PORT). -- send introduction fputstr(sock, "PASS " + config\NICK + "\r\n"). fputstr(sock, "NICK " + config\NICK + "\r\n"). fputstr(sock, "USER " + config\NICK + " 0 * :Lamb Da. Bot\r\n"). -- note: workaround for issue #19 (passing lambdas to modules in the global scope is incorrect) joinChans() -> list\map(\chan -> fputstr(sock, "JOIN " + chan + "\r\n"), config\CHANS). joinChans(). -- loop receiving lines mainloop(state) -> if feof(sock) != true then do line = fgetline(sock); handleLine(state, line) end else false. -- EOF, stop looping putstrln("initializing"). initialState = (loadFactoids(),). putstrln("beginning mainloop"). loop(mainloop, initialState). fclose(sock). putstrln("done").