Skip to content

Instantly share code, notes, and snippets.

@hiredman
Created November 22, 2008 03:18
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save hiredman/27733 to your computer and use it in GitHub Desktop.
irc bot for #clojure
;;
;; Thus spake the master programmer:
;; "Though a program be but three lines long, someday it will have to be
;; maintained."
;;
;;
;; [01:30] <uhelp> lexxan: Since Mon May 2 17:22:46 2005,
;; there have been 0 modifications and 0 questions.
;; I have been awake for 7 minutes and 36 seconds
;; this session, and currently reference 19
;; factoids. Addressing is in optional mode.
;java -server -ms16m -mx64m -Xss128m
(ns hiredman.clojurebot
(:import (org.jibble.pircbot PircBot)
(java.util.concurrent FutureTask TimeUnit TimeoutException)))
;; set up the namespace for the sandbox
(binding [*ns* (create-ns 'foo)]
(clojure.core/refer 'clojure.core)
(import '(java.util Date)))
(def nick "clojurebot")
(def channel "#clojure")
(def net "chat.us.freenode.net")
(def *bot*) ;this will be the bot object
(def *execution-timeout* 10) ;time out for sandbox exec
(def start-date (java.util.Date.))
;; dictionaries for storing relationships
;; 'are' dict is not used right now.
(def dict-is (ref {}))
(def dict-are (ref {}))
;url is for storing urls, must figure out something to do with this
(def url (ref {}))
(def svn-rev-cache (ref []))
(def url-regex #"[A-Za-z]+://[^ ^/]+\.[^ ^/]+[^ ]+")
;; this struct is used to pass around messages
(defstruct junks :this :channel :sender :login :hostname :message)
(defn randth
"random item from sequence"
[se]
(let [s (seq se)]
(first (drop (rand-int (count se)) se))))
;; responses that can be randomly selected from
(def input-accepted ["'Sea, mhuise." "In Ordnung" "Ik begrijp" "Alles klar" "Ok." "Roger." "You don't have to tell me twice." "Ack. Ack." "c'est bon!"])
(def befuddl ["Titim gan éirí ort." "Gabh mo leithscéal?" "No entiendo" "excusez-moi" "Excuse me?" "Huh?" "I don't understand." "Pardon?" "It's greek to me."])
(defn ok []
(randth input-accepted))
(defn befuddled []
(randth befuddl))
(defn inits
"this is Chouser's fault"
[s]
(map first
(take-while second
(map split-at
(iterate inc 0)
(repeat (lazy-cat s [nil]))))))
(defn strip-is
"return a string with everything up to the end of the
first \"is\" removed"
[string]
(.trim (.substring string (+ 3 (.indexOf string " is ")))))
(defn term
"returns the part of a string before the first occurence
of \"is\""
[string]
(first (.split string " is ")))
(defn doc-lookup?
"is this a well formed doc-string lookup?"
[msg]
(re-find #"^\(doc " msg))
(defn d?op
"if string ends in a question mark return
the string without the question mark"
[x]
(if (= \? (.charAt x (dec (count x))))
(subs x 0 (dec (count x)))
x))
(defn symbol-to-var-doc
"this returns the doc metadata from a var in the
clojure ns or a befuddled response"
[symb]
(let [a (meta (find-var (symbol "clojure.core" symb)))
x (:doc a)
y (:arglists a)]
(if x
(str x "; arglists " y)
(befuddled))))
(defmacro async
"just do this, I don't care"
[& x]
`(send-off (agent nil) (fn [& _#] ~@x )))
(defn sendMsg
"send a message to a recv, a recv is a channel name or a nick"
[this recv msg]
(.sendMessage this recv (.replace (str msg) \newline \ )))
(defmacro sendMsg-who [pojo msg]
`(sendMsg (:this ~pojo) (who ~pojo) ~msg))
(defn cache-svn-rev
"puts an svn rev into the cache"
[rev]
(dosync (commute svn-rev-cache conj rev)))
(defn term-lists
"generates permutions of the words in string"
[msg]
(let [x (re-seq #"\w+" msg)
ignore #(not (contains? #{"a" "where" "what" "is" "who" "are" (str nick ": ")} %))]
(filter ignore
(apply concat
(map (fn [x]
(map (fn [y]
(reduce #(str % " " %2) y)) x))
(map #(reverse (filter identity (inits (drop % x))))
(take (count x) (iterate inc 0))))))))
(defn rlookup
"look up terms from a seq until you find a defi"
[terms]
(loop [t terms]
(if t
(if (@dict-is (first t))
(first t)
(recur (rest t))))))
(defn fuzzy-lookup
"look up based on permutation"
[message]
(rlookup (term-lists message)))
(defn fuzzy-key-lookup
"look up based on match part of a term"
[term]
(randth (filter #(when (> (.lastIndexOf % term) -1) true) (keys @dict-is))))
(defn who
"am I talking to someonein a privmsg, or in a channel?"
[pojo]
(if (:channel pojo)
(:channel pojo)
(:sender pojo)))
(defn addressed?
"is this message prefixed with clojurebot: "
[pojo]
(when (or (re-find #"^clojurebot:" (:message pojo)) (nil? (:channel pojo)))
pojo))
(def svn-command "svn -v --xml --limit 5 log http://clojure.googlecode.com/svn/")
(defn svn-summaries
"takes output of clojure.xml/parse on svn's xml log, returns
a vector of [rev-number commit-message]"
[tag-map]
(map (fn [x]
[(Integer/parseInt (:revision (:attrs x)))
(first
(:content
(first
(filter #(= (:tag %) :msg)
(:content x)))))])
(:content tag-map)))
(defn get-last-svn-rev []
(Integer/parseInt (@dict-is "latest")))
(defn filter-newer-svn-revs [revs]
(filter #(> (first %) (get-last-svn-rev))
revs))
(defn send-svn-revs [revs]
(dorun
(map #(sendMsg *bot*
channel
(str "svn rev " (first %) "; " (last %)))
revs)))
(defn svn-message
"takes a seq of vectors containing [rev msg]
sends out messages about new revs. updates \"latest\"
to latest rev"
[summaries]
(let [newrevs (filter-newer-svn-revs (reverse summaries))]
(when newrevs
(do
(send-svn-revs newrevs)
(dosync
(commute dict-is
assoc
"latest"
(str (first (first summaries)))))
;don't want to see the whole hash in the repl
nil))))
(defn svn-xml-stream
"get the xml stream from svn"
[cmd]
(.getInputStream (.. Runtime getRuntime (exec cmd))))
(defn is
"add a new definition to a term in dict-is"
[term defi]
(if (@dict-is term)
(let [old (@dict-is term)
v (if (vector? old)
(conj old defi)
[old defi])]
(dosync (commute dict-is assoc term v)))
(dosync (commute dict-is assoc term defi))))
(defn is!
"define a term in dict-is, overwriting anything that was there"
[term defi]
(dosync (commute dict-is assoc term defi)))
(defn what-is
"looks up a term in @dict-is"
[term]
(when-let [f (@dict-is term)]
(if (vector? f) (randth f) f)))
(defn enable-security-manager []
(System/setSecurityManager (SecurityManager.)))
;;;;;;;; Chousuke
(defn thunk-timeout [thunk seconds]
(let [task (FutureTask. thunk)
thr (Thread. task)]
(try
(.start thr)
(.get task seconds TimeUnit/SECONDS)
(catch TimeoutException e
(.cancel task true)
(.stop thr (Exception. "Thread stopped!")) "Execution timed out"))))
(defn wrap-exceptions [f]
(try (f) (catch Exception e (str :EXCEPTION (.getMessage e)))))
;;;;;;;;;;;
(defn sandbox [func]
(let [perms (java.security.Permissions.)
domain (java.security.ProtectionDomain.
(java.security.CodeSource. nil
(cast java.security.cert.Certificate nil))
perms)
context (java.security.AccessControlContext. (into-array [domain]))
pA (proxy [java.security.PrivilegedAction] [] (run [] (func)))]
(java.security.AccessController/doPrivileged
pA context)))
(defn dispatch
"this function does dispatch for responder"
[pojo]
(cond
(doc-lookup? (:message pojo))
:doc-lookup
(re-find #"^,\(" (:message pojo))
:code-sandbox
(and (addressed? pojo) (re-find #"how much do you know?" (:message pojo)))
:know
(and (addressed? pojo) (re-find #" is " (:message pojo)) (not= \? (last (:message pojo))))
:define-is
(and (addressed? pojo) (re-find #" literal " (:message pojo)))
:literal
(re-find #"^\([\+ / \- \*] [ 0-9]+\)" (:message pojo))
:math
(re-find #"^svn rev [0-9]+$" (:message pojo))
:svn-rev-lookup
(addressed? pojo)
:lookup
(re-find url-regex (:message pojo))
:url
:else
nil))
(defmulti #^{:doc "currently all messages are routed though this function"} responder dispatch)
(defn naughty-forms? [strang]
(let [nf #{"catch" "finally" "clojure.asm" "hiredman.clojurebot"}]
(some #(not= -1 %) (map #(.lastIndexOf strang %) nf))))
(defn find-or-create-ns [n]
(if-let [s (find-ns n)] s (create-ns n)))
(defmethod responder :code-sandbox [pojo]
(println (str (:sender pojo) " " (:message pojo)))
(if (and (not (naughty-forms? (:message pojo))) (not= "karmazilla" (:sender pojo)))
(let [_ (println "accepted")
form (-> (.replaceAll (:message pojo) "^," "")
java.io.StringReader.
java.io.PushbackReader.
read)
; http://malde.org/~ketil/Hazard_lambda.svg
thunk1 #(eval form)
thunk2 #(binding [*ns* (find-or-create-ns 'foo)
*out* (java.io.StringWriter.)]
[(wrap-exceptions thunk1) (str *out*)])
thunk3 #(sandbox thunk2)]
(let [o (thunk-timeout thunk3 *execution-timeout*)]
(if (vector? o)
(doseq [i (reverse o)] (sendMsg-who pojo i))
(sendMsg-who pojo o))))
(sendMsg-who pojo (befuddled))))
(defmethod responder :math [pojo]
(let [[op & num-strings] (re-seq #"[\+\/\*\-0-9]+" (:message pojo))
nums (map #(Integer/parseInt %) num-strings)]
(sendMsg-who pojo
(let [out (apply (find-var (symbol "clojure.core" op)) nums)]
(if (> out 4)
"*suffusion of yellow*"
out)))))
(defmethod responder :doc-lookup [pojo]
(sendMsg-who pojo
(symbol-to-var-doc (subs (:message pojo)
5
(dec (count (:message pojo)))))))
(defmethod responder :define-is [pojo]
(let [a (.trim (.replaceFirst (:message pojo) "^clojurebot:" " "))
term (term a)
x (strip-is a)
defi (.replaceFirst x "^also " "")]
(if (re-find #"^also " x)
(is term defi)
(is! term defi))
(sendMsg-who pojo (ok))))
(defn prep-reply [sender term defi]
(.replaceAll (if (re-find #"^<reply>" defi)
(.trim (.replaceFirst (str defi) "^<reply>" ""))
(str term " is " defi))
"#who"
sender))
(defmethod responder :lookup [pojo]
(let [msg (d?op (.trim (.replaceFirst (:message pojo) (str "^" nick ":") "")))
result (what-is msg)]
(cond
result,
(sendMsg-who pojo
(.replaceAll (if (re-find #"^<reply>" result)
(.trim (.replaceFirst (str result) "^<reply>" ""))
(str msg " is " result))
"#who"
(:sender pojo)))
(fuzzy-lookup msg),
(let [x (fuzzy-lookup msg)
r (what-is x)]
(sendMsg-who pojo (prep-reply (:sender pojo) term defi)))
(fuzzy-key-lookup msg),
(let [term (fuzzy-key-lookup msg)
defi (what-is term)]
(sendMsg-who pojo (prep-reply (:sender pojo) term defi)))
:else,
(sendMsg-who pojo (befuddled)))))
(defmethod responder :know [pojo]
(sendMsg-who pojo (str "I know " (+ (count (deref dict-is)) (count (deref dict-are))) " things")))
(defmethod responder :url [pojo]
(dosync (commute url
assoc
(re-find url-regex (:message pojo)) (java.util.Date.)))
(prn (str (:sender pojo) ", " (:message pojo))))
(defmethod responder :literal [pojo]
(let [q (.replaceFirst (:message pojo) (str "^" nick ": literal ") "")]
(prn q)))
(defmethod responder :svn-rev-lookup [pojo]
(let [r (Integer/parseInt (re-find #"[0-9]+" (:message pojo)))
t (filter #(= (first %) r) @svn-rev-cache)]
(if (not= 0 (count t))
(send-svn-revs t)
(let [cmd (.replace svn-command "--limit 5" (str "-r " r))
b (svn-summaries (clojure.xml/parse (svn-xml-stream cmd)))]
(do
(send-svn-revs b)
(dorun (map cache-svn-rev b)))))))
(defn user-watch []
(let [cur (count (.getUsers *bot* "#clojure"))
pre (Integer/parseInt (what-is "max people"))]
(when (> cur pre)
(is! "max people" (str cur)))))
(defn handleMessage [this channel sender login hostname message]
(responder (struct junks this channel sender login
hostname message)))
(defn handlePrivateMessage [this sender login hostname message]
(handleMessage this nil sender login hostname message))
(defn pircbot []
(proxy [PircBot] []
(onJoin [channel sender login hostname]
(user-watch))
(onMessage [channel sender login hostname message]
(handleMessage this channel sender login hostname message))
(onPrivateMessage [sender login hostname message]
(handlePrivateMessage this sender login hostname message))))
(defn dumpdicts []
(map (fn [[rel rels]]
(binding [*out* (-> (str "clojurebot." rel)
java.io.File.
java.io.FileWriter.)]
(prn @rels)
(.close *out*)))
[["is" dict-is] ["are" dict-are]]))
(defn svn-notifier-thread []
(send-off (agent nil)
(fn this [& _]
(let [m (svn-summaries (clojure.xml/parse (svn-xml-stream svn-command)))]
(svn-message m)
(map cache-svn-rev m))
(Thread/sleep (* 5 60000))
(send-off *agent* this))))
;(svn-message (svn-summaries (clojure.xml/parse (svn-xml-stream))))
(defn load-dicts []
(dosync
(ref-set dict-is
(eval
(binding [*in* (-> "clojurebot.is"
java.io.File.
java.io.FileReader.
java.io.PushbackReader.)]
(let [a (read)]
(.close *in*)
a))))))
(defn dump-thread []
(send-off (agent nil)
(fn this [& _]
(binding [*out* (-> "clojurebot.is"
java.io.File.
java.io.FileWriter.)]
(prn @dict-is)
(.close *out*))
(Thread/sleep (* 10 60000))
(send-off *agent* this))))
(def *bot* (pircbot))
(enable-security-manager)
(.connect *bot* net)
(.changeNick *bot* nick)
(.joinChannel *bot* channel)
(load-dicts)
(svn-notifier-thread)
(dump-thread)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment