├── clojurebot-irc ├── resources │ ├── config.clj │ └── logback.xml ├── README.md ├── .gitignore ├── project.clj └── src │ └── clojurebot │ └── irc.clj ├── clojurebot-facts ├── resources │ ├── config.clj │ ├── en-sent.bin │ ├── en-token.bin │ ├── en-pos-maxent.bin │ ├── manifest.properties │ └── logback.xml ├── .gitignore ├── README.md ├── src │ └── clojurebot │ │ ├── triples.clj │ │ ├── facts.clj │ │ ├── infer.clj │ │ ├── triples │ │ ├── postgres.clj │ │ └── derby.clj │ │ └── factoids.clj └── project.clj ├── clojurebot-eval ├── resources │ ├── config.clj │ └── example.policy ├── .gitignore ├── README.md ├── project.clj └── src │ └── clojurebot │ ├── eval.clj │ └── sandbox.clj ├── .gitignore ├── src ├── clojurebot │ ├── json.clj │ ├── launch.clj │ ├── github.clj │ ├── plugin.clj │ ├── dice.clj │ ├── epigrams.clj │ ├── conduit.clj │ ├── seenx.clj │ ├── eval.clj │ ├── feed.clj │ ├── coreII.clj │ └── core.clj └── hiredman │ ├── clojurebot │ ├── edit.clj │ ├── karma.clj │ ├── forget.clj │ ├── javadoc.clj │ ├── latex.clj │ ├── tinyurl.clj │ ├── stock_quote.clj │ ├── simplyscala.clj │ ├── noise.clj │ ├── clojars.clj │ ├── shutup.clj │ ├── google.clj │ ├── translate.clj │ ├── tao.clj │ ├── delicious.clj │ ├── github.clj │ ├── ticket.clj │ ├── factoids.clj │ ├── code_lookup.clj │ └── core.clj │ ├── pqueue.clj │ ├── horizon.clj │ ├── schedule.clj │ ├── words.clj │ └── utilities.clj ├── resources ├── logback.xml └── example.policy ├── example-config.clj ├── project.clj ├── setup.sh ├── README.md └── derby-to-postgres.clj /clojurebot-irc/resources/config.clj: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /clojurebot-facts/resources/config.clj: -------------------------------------------------------------------------------- 1 | {} 2 | -------------------------------------------------------------------------------- /clojurebot-eval/resources/config.clj: -------------------------------------------------------------------------------- 1 | {:clojure-jar "/tmp/clojure.jar"} 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | classes/ 3 | lib/ 4 | *.jar 5 | derby.log 6 | checkouts/ 7 | target/ 8 | -------------------------------------------------------------------------------- /clojurebot-facts/resources/en-sent.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiredman/clojurebot/HEAD/clojurebot-facts/resources/en-sent.bin -------------------------------------------------------------------------------- /clojurebot-facts/resources/en-token.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiredman/clojurebot/HEAD/clojurebot-facts/resources/en-token.bin -------------------------------------------------------------------------------- /clojurebot-facts/resources/en-pos-maxent.bin: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hiredman/clojurebot/HEAD/clojurebot-facts/resources/en-pos-maxent.bin -------------------------------------------------------------------------------- /clojurebot-facts/resources/manifest.properties: -------------------------------------------------------------------------------- 1 | /Users/hiredman/src/opennlp/opennlp-tools/src/main/java/opennlp/tools/util/model/BaseModel.java 2 | -------------------------------------------------------------------------------- /clojurebot-irc/README.md: -------------------------------------------------------------------------------- 1 | # clojurebot-irc 2 | 3 | A Clojure library designed to ... well, that part is up to you. 4 | 5 | ## Usage 6 | 7 | FIXME 8 | -------------------------------------------------------------------------------- /src/clojurebot/json.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.json 2 | (:require [cheshire.core :as json])) 3 | 4 | (defn decode-from-str [json] 5 | (json/decode json true)) 6 | -------------------------------------------------------------------------------- /src/clojurebot/launch.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.launch 2 | (:gen-class)) 3 | 4 | (defn -main [& [config-file]] 5 | (require 'clojurebot.core) 6 | ((resolve 'clojurebot.core/-main) config-file)) 7 | -------------------------------------------------------------------------------- /clojurebot-eval/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | .lein-deps-sum 10 | .lein-failures 11 | .lein-plugins 12 | .lein-repl-history 13 | -------------------------------------------------------------------------------- /clojurebot-facts/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | .lein-deps-sum 10 | .lein-failures 11 | .lein-plugins 12 | .lein-repl-history 13 | -------------------------------------------------------------------------------- /clojurebot-irc/.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | .lein-deps-sum 10 | .lein-failures 11 | .lein-plugins 12 | .lein-repl-history 13 | -------------------------------------------------------------------------------- /clojurebot-facts/README.md: -------------------------------------------------------------------------------- 1 | # clojurebot-facts 2 | 3 | ... 4 | 5 | ## Usage 6 | 7 | java -Xmx200m -Dfile.encoding=utf8 -Dclojurebot.db=/clojurebot.db -jar 8 | jetty-runner-8.1.9.v20130131.jar --port 3236 9 | clojurebot-facts-1.1.0-SNAPSHOT-standalone.war 10 | 11 | -------------------------------------------------------------------------------- /clojurebot-eval/README.md: -------------------------------------------------------------------------------- 1 | # clojurebot-eval 2 | 3 | clojurebot's sandbox as a rest service 4 | 5 | ## Usage 6 | 7 | ``` 8 | lein ring uberjar 9 | 10 | java -Xmx100m -jar jetty\-runner\-7.4.2.v20110526.jar --port 3235 11 | clojurebot-eval-0.1.0-SNAPSHOT-standalone.war 12 | ``` 13 | 14 | then add :evaluator "http://localhost:3235/eval" to your clojurebot config 15 | 16 | -------------------------------------------------------------------------------- /src/clojurebot/github.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.github 2 | (:use [clojurebot.feed :only [atom-pull*]])) 3 | 4 | (def url "https://github.com/%s/commits/master.atom") 5 | 6 | (defn commits [project] 7 | (->> (format url project) 8 | atom-pull* 9 | (take 5) 10 | (map (fn [{:keys [link title author date]}] 11 | (format "[%s] %s - %s (%s) %s" project title author date link))) 12 | (reduce #(str % %2 "\n") nil))) 13 | -------------------------------------------------------------------------------- /clojurebot-irc/resources/logback.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/edit.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.edit 2 | (:require [hiredman.clojurebot.core :as core])) 3 | 4 | (core/defresponder ::edit 0 5 | (core/dfn (and (:addressed? (meta msg)) 6 | (re-find #"^.* = s/.*/.*/" (core/extract-message bot msg)))) ;; 7 | (let [m (core/extract-message bot msg) 8 | [_ original replacement] (.split (re-find #"s/.*/.*/" m) "/")] 9 | (prn [original replacement]))) 10 | 11 | (core/remove-dispatch-hook ::edit) 12 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/karma.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.karma 2 | (:use (hiredman.clojurebot core))) 3 | 4 | (defn increment-karma [name bot] 5 | (send (:store bot) 6 | update-in [:karma name] inc)) 7 | 8 | (defn decrement-karma [name bot] 9 | (send (:store bot) 10 | update-in [:karma name] dec)) 11 | 12 | (defn get-karma [name bot] 13 | (let [k (-> bot :store deref :karma (get name))] 14 | (if k k 0))) 15 | 16 | (defn setup-karma [bot] 17 | (send (:store bot) assoc :karma {})) 18 | -------------------------------------------------------------------------------- /resources/logback.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /clojurebot-facts/src/clojurebot/triples.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.triples) 2 | 3 | (declare create-store 4 | store-triple 5 | query 6 | delete) 7 | 8 | (defn ^{::ignore true} load-impl [ns] 9 | (require ns) 10 | (doseq [[n v] (ns-publics 'clojurebot.triples) 11 | :when (not (::ignore (meta v)))] 12 | (intern 'clojurebot.triples n (deref (ns-resolve ns n))))) 13 | 14 | (load-impl (symbol (or (System/getProperty "factoid.storage") 15 | "clojurebot.triples.derby"))) 16 | -------------------------------------------------------------------------------- /clojurebot-facts/resources/logback.xml: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | %d{HH:mm:ss.SSS} [%thread] %-5level %logger{36} - %msg%n 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 16 | 17 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/forget.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.forget 2 | (:use (hiredman.clojurebot core))) 3 | 4 | (defmethod responder ::forget [bot junks] 5 | (dosync 6 | (alter dict-is dissoc (.trim (.replaceAll (extract-message bot junks) "^forget (.*)" "$1")))) 7 | (sendMsg-who bot junks (str "I forgot " (.trim (.replaceAll (extract-message bot junks) "^forget (.*)" "$1"))))) 8 | 9 | (add-dispatch-hook (dfn (and (addressed? bot msg) 10 | (re-find #"^forget " (extract-message bot msg)))) ::forget) 11 | -------------------------------------------------------------------------------- /clojurebot-eval/project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojurebot-eval "1.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.4.0"] 7 | [ring "1.1.8"] 8 | [org.clojure/tools.logging "0.2.4"] 9 | [sonian/carica "1.0.2"]] 10 | :plugins [[lein-ring "0.8.2"]] 11 | :ring {:handler clojurebot.eval/handler 12 | :init clojurebot.eval/init}) 13 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/javadoc.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.javadoc 2 | (:use (hiredman.clojurebot core)) 3 | (:use (hiredman utilities))) 4 | 5 | (def doc-url "http://www.docjar.com/docs/api/") 6 | 7 | (defn make-ur [class] 8 | (str doc-url (.replaceAll (if (.contains class ".") class (str "java.lang." class) ) "\\." "/") ".html")) 9 | 10 | (defmethod responder ::javadoc [bot msg] 11 | (let [message (extract-message bot msg) 12 | thing (second (.split #^String message " "))] 13 | (send-out :notice bot (who msg) (str (make-ur thing))))) 14 | 15 | (add-dispatch-hook (dfn (and (addressed? bot msg) 16 | (re-find #"^(jdoc|javadoc) " (extract-message bot msg)))) ::javadoc) 17 | -------------------------------------------------------------------------------- /resources/example.policy: -------------------------------------------------------------------------------- 1 | /* Grant all for the REPL; the sandbox created will "throw away" these permissions, 2 | * but they are still needed for clojurebot to start up properly. 3 | 4 | You will need to start the java virtual machine with the following extra args: 5 | 6 | -Djava.security.manager -Djava.security.policy="file:///path/to/this.policy" 7 | 8 | With this grant-all setup, clojurebot can also be run from SLIME. 9 | */ 10 | 11 | grant { 12 | permission java.security.AllPermission; 13 | }; 14 | 15 | /* Untested, more specific grant. Would not work with SLIME or a repl. 16 | grant codeBase "file:///Users/oranenj/koodi/VCS/clojurebot/" { 17 | permission java.security.AllPermission; 18 | }; 19 | */ 20 | -------------------------------------------------------------------------------- /clojurebot-eval/resources/example.policy: -------------------------------------------------------------------------------- 1 | /* Grant all for the REPL; the sandbox created will "throw away" these permissions, 2 | * but they are still needed for clojurebot to start up properly. 3 | 4 | You will need to start the java virtual machine with the following extra args: 5 | 6 | -Djava.security.manager -Djava.security.policy="file:///path/to/this.policy" 7 | 8 | With this grant-all setup, clojurebot can also be run from SLIME. 9 | */ 10 | 11 | grant { 12 | permission java.security.AllPermission; 13 | }; 14 | 15 | /* Untested, more specific grant. Would not work with SLIME or a repl. 16 | grant codeBase "file:///Users/oranenj/koodi/VCS/clojurebot/" { 17 | permission java.security.AllPermission; 18 | }; 19 | */ 20 | -------------------------------------------------------------------------------- /src/hiredman/pqueue.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.pqueue 2 | (:refer-clojure :exclude [first conj seq pop peek empty]) 3 | (:require [clojure.core :as cc])) 4 | 5 | (def empty clojure.lang.PersistentQueue/EMPTY) 6 | 7 | (defn seq 8 | "returns a lazy sequence of the items in the priority queue" 9 | [pq] 10 | (cc/seq (map second pq))) 11 | 12 | (defn peek [pq] 13 | (cc/first (cc/peek pq))) 14 | 15 | (defn pop [pq] 16 | (pop pq)) 17 | 18 | (defn first 19 | "returns the first item in a priority queue" 20 | [pq] 21 | (peek pq)) 22 | 23 | (defn conj 24 | [que & values] 25 | (let [entries (cc/seq (apply hash-map values)) 26 | s (concat entries (cc/seq que))] 27 | (into empty (sort-by #(if-let [x (cc/first %)] x 0) s)))) 28 | -------------------------------------------------------------------------------- /src/clojurebot/plugin.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.plugin 2 | (:use [clojure.java.io :only [file]]) 3 | (:import [java.net URLClassLoader] 4 | [clojure.lang Compiler])) 5 | 6 | (defn load-from [directory namespaces] 7 | (push-thread-bindings {Compiler/LOADER (URLClassLoader. 8 | (into-array 9 | (map 10 | #(.toURL %) 11 | (file-seq (file directory)))))}) 12 | (try 13 | (doseq [namespace (set namespaces)] 14 | (try 15 | (require namespace) 16 | (catch Exception e 17 | (.printStackTrace e)))) 18 | (finally 19 | (pop-thread-bindings)))) 20 | -------------------------------------------------------------------------------- /src/clojurebot/dice.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.dice) 2 | 3 | (defn roll-die [sides] 4 | (first (shuffle (range 1 (inc sides))))) 5 | 6 | (defn dice-roll? [{:keys [message]}] 7 | (and message 8 | (re-find #"^[0-9]+d[0-9]+" message))) 9 | 10 | (defn roll-some-dice [{:keys [message]}] 11 | (let [dice-count (Integer/parseInt (re-find #"[0-9]+" message)) 12 | dice-type (Integer/parseInt (.replaceAll (re-find #"d[0-9]+" message) "[a-zA-z]" "")) 13 | modifier (try (Integer/parseInt (.replaceAll (re-find #"[+-][0-9]+" message) "[+-]" "")) 14 | (catch Exception e 0))] 15 | (str 16 | (+ modifier 17 | (reduce + 18 | (map (fn [_] (roll-die dice-type)) 19 | (range 1 (inc dice-count)))))))) 20 | -------------------------------------------------------------------------------- /clojurebot-irc/project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojurebot-irc "0.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.5.1"] 7 | [clj-http "0.7.2"] 8 | [sonian/carica "1.0.2"] 9 | [net.intensivesystems/conduit "0.7.0-SNAPSHOT"] 10 | [org.clojure/tools.logging "0.2.6"]] 11 | :profiles {:dev {:exclusions [commons-logging] 12 | :dependencies [[ch.qos.logback/logback-classic "1.0.9"] 13 | [ch.qos.logback/logback-core "1.0.9"] 14 | [org.slf4j/jcl-over-slf4j "1.7.2"]]}}) 15 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/latex.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.latex 2 | (:use [hiredman.clojurebot.core :only (defresponder2 extract-message new-send-out)] 3 | [hiredman.utilities :only (tinyurl)]) 4 | (:import (java.net URLEncoder))) 5 | 6 | (defn chart-url [latex] 7 | (format "http://chart.apis.google.com/chart?cht=tx&chf=bg,s,FFFFFFFF&chco=000000&chl=%s" 8 | (URLEncoder/encode latex))) 9 | 10 | (defresponder2 11 | {:name ::latex 12 | :priority 0 13 | :dispatch (fn [bot msg] 14 | (re-find #"^latex " (extract-message bot msg))) 15 | :body (fn [bot msg] 16 | (let [m (.replaceAll (extract-message bot msg) 17 | "^latex " 18 | "")] 19 | (new-send-out bot :notice msg (tinyurl (chart-url m)))))}) 20 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/tinyurl.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.tinyurl 2 | (:use (hiredman.clojurebot core))) 3 | 4 | (def url-reg #"[A-Za-z]+://[^ ^/]+\.[^ ^/]+[^ ]+") 5 | 6 | (defn get-tiny-url [url] 7 | (with-open [pt (.getContent (java.net.URL. (str "http://tinyurl.com/api-create.php?url=" (java.net.URLEncoder/encode url)))) 8 | dis (java.io.DataInputStream. pt)] 9 | (.readLine dis))) 10 | 11 | (def get-tiny-url-cached (memoize get-tiny-url)) 12 | 13 | (defmethod responder ::tiny-url [bot pojo] 14 | (let [url (re-find url-reg (:message pojo))] 15 | (when (> (count url) 60) 16 | (try (.sendNotice (:this bot) (who pojo) (get-tiny-url-cached url)) (catch Exception e (println e)))))) 17 | 18 | 19 | (add-dispatch-hook 20 (dfn (re-find url-reg (:message msg))) ::tiny-url) 20 | -------------------------------------------------------------------------------- /src/hiredman/horizon.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.horizon) 2 | 3 | (declare *fails* *succeeds* *exits*) 4 | (def *horizon* nil) 5 | 6 | (defmacro when-hrz [which & forms] 7 | `(do 8 | (when (not *horizon*) (throw (RuntimeException. "Naked Singularity"))) 9 | (swap! 10 | ~(condp = which :fails 'hiredman.horizon/*fails* :succeeds 'hiredman.horizon/*succeeds* :exits 'hiredman.horizon/*exits*) 11 | conj (fn [] ~@forms)))) 12 | 13 | (defmacro horizon [& body] 14 | `(binding [*horizon* true 15 | *fails* (atom (list)) 16 | *succeeds* (atom (list)) 17 | *exits* (atom (list))] 18 | (try 19 | (let [y# (do ~@body)] (dorun (map (fn[x#](x#)) @*succeeds*)) y#) 20 | (catch Exception e# (dorun (map (fn[x#] (x#)) @*fails*)) 21 | (throw e#)) 22 | (finally 23 | (dorun (map (fn[x#] (x#)) @*exits*)))))) 24 | -------------------------------------------------------------------------------- /src/hiredman/schedule.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.schedule 2 | (:import (java.util.concurrent ScheduledThreadPoolExecutor TimeUnit))) 3 | 4 | (def unit {:minutes TimeUnit/MINUTES :seconds TimeUnit/SECONDS :hours TimeUnit/HOURS}) 5 | 6 | (def tasks (ref {})) 7 | 8 | (def #^{:doc "ScheduledThreadPoolExecutor for scheduling repeated/delayed tasks"} 9 | task-runner (ScheduledThreadPoolExecutor. (+ 1 (.availableProcessors (Runtime/getRuntime))))) 10 | 11 | (defn fixedrate 12 | ([{:keys [name task start-delay rate unit]}] 13 | (fixedrate name task start-delay rate unit)) 14 | ([name task t1 t2 tu] 15 | (let [ft (.scheduleAtFixedRate task-runner #^Callable task (long t1) (long t2) tu)] 16 | (dosync (alter tasks assoc name ft))))) 17 | 18 | (defn cancel [name] 19 | (.cancel (get @tasks name) true) 20 | (dosync 21 | (alter tasks dissoc name))) 22 | 23 | ;; example usage 24 | ;; (fixedrate 25 | ;; {:task #(dump-dict-is config) :start-delay 1 :rate 10 :unit (:minutes unit)}) 26 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/stock_quote.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.stock-quote 2 | (:require [hiredman.clojurebot.core :as core] 3 | [hiredman.utilities :as util] 4 | [clojurebot.json :as json])) 5 | 6 | (def url "http://www.google.com/finance/info?q=") 7 | 8 | (defn stock-quote [symbol] 9 | (json/decode-from-str (apply str (butlast (drop 4 (util/get-url (.concat url symbol))))))) 10 | 11 | (defn format-quote [{:keys [l t c cp]}] 12 | (format "%s; %s" t c)) 13 | 14 | (core/defresponder ::stock-quote 0 15 | (core/dfn (and (:addressed? (meta msg)) 16 | (re-find #"^ticker [A-Z]+" (core/extract-message bot msg)))) ;; 17 | (core/send-out :msg bot msg (try 18 | (format-quote (stock-quote (.replaceAll (core/extract-message bot msg) "^ticker " ""))) 19 | (catch java.io.IOException e 20 | (.toString e))))) 21 | 22 | ;(core/remove-dispatch-hook ::stock-quote) 23 | -------------------------------------------------------------------------------- /src/hiredman/words.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.words) 2 | 3 | (defn drop-nth [s n] 4 | (lazy-seq 5 | (if (zero? n) 6 | (rest s) 7 | (cons (first s) (drop-nth (rest s) (dec n)))))) 8 | 9 | (defn permute [items] 10 | (cond 11 | (> 2 (count items)) 12 | list 13 | (= 2 (count items)) 14 | (let [[a b] items] (list (list a b) (list b a))) 15 | :else 16 | (mapcat (fn [idx] 17 | (map (partial cons (nth items idx)) (permute (drop-nth items idx)))) 18 | (range (count items))))) 19 | 20 | (defn word-seq [sentence] 21 | (seq (set (re-seq #"\w+" sentence)))) 22 | 23 | (defn chunk-words [words] 24 | (take-while (comp not empty?) (iterate rest words))) 25 | 26 | (defn word-seq->sentence [ws] 27 | (apply str (interpose " " ws))) 28 | 29 | (defn sentence-permutations [sentence] 30 | (-> sentence word-seq permute ((partial mapcat chunk-words)) 31 | set 32 | ((partial map word-seq->sentence)) 33 | ((partial sort-by count)) reverse)) 34 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/simplyscala.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.simplyscala 2 | (:use [hiredman.clojurebot.core :only (defresponder2 new-send-out extract-message)]) 3 | (:require [hiredman.utilities :as util]) 4 | (:import (java.net URLEncoder ))) 5 | 6 | 7 | (def scala-the-easy-way "http://www.simplyscala.com/interp?bot=irc&code=") 8 | 9 | (defn scala-eval [code] 10 | (-> code URLEncoder/encode ((partial str scala-the-easy-way)) 11 | util/get-url (.split "res0: ") rest ((partial apply str)))) 12 | 13 | (defresponder2 14 | {:priority 0 15 | :name ::scala 16 | :dispatch (fn [bot msg] 17 | (and (:addressed? (meta msg)) 18 | (.startsWith (extract-message bot msg) "scala"))) 19 | :body (fn [bot msg] 20 | (new-send-out bot :msg msg 21 | (scala-eval 22 | (let [m (extract-message bot msg)] 23 | (if (.startsWith m "scala") 24 | (.replaceAll m "^scala" "") 25 | (.substring m 1))))))}) 26 | -------------------------------------------------------------------------------- /example-config.clj: -------------------------------------------------------------------------------- 1 | {:nick "clojurebotIII" 2 | :irc {"irc.freenode.net" ["#clojurebot"]} 3 | :database "/tmp/bot.db" 4 | :threads 4 5 | :cron [{:task hiredman.clojurebot.clojars/go 6 | :rate 3600 7 | :targets [[:irc "clojurebotIII" "irc.freenode.net" "#clojurebot"]]} 8 | {:task clojurebot.github/commits 9 | :rate 3000 10 | :targets [[:irc "clojurebotIII" "irc.freenode.net" "#clojurebot"]] 11 | :arguments ["clojure/clojure"]} 12 | {:task clojurebot.github/commits 13 | :rate 3000 14 | :targets [[:irc "clojurebotIII" "irc.freenode.net" "#clojurebot"]] 15 | :arguments ["clojure/clojure-contrib"]}] 16 | :plugin-directory "/Users/hiredman/src/clojurebot/" 17 | #_ ( :addressed-plugins [[clojurebot.indexing search? search]]) 18 | #_( :logging-plugins #{clojurebot.indexing/index}) 19 | :on-invite :join 20 | :clojure-jar "/Users/hiredman/src/clojure/clojure.jar" 21 | :swank 8888 22 | :evaluator "http://localhost:3235/eval" 23 | :facts-service "http://localhost:3236/facts" 24 | } 25 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/noise.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.noise 2 | (:require [hiredman.clojurebot.core :as core] 3 | [hiredman.utilities :as util])) 4 | 5 | (def lookup (fn [] (second (first (filter #(= (first %) :hiredman.clojurebot.factoids/lookup) (.getMethodTable core/responder)))))) 6 | 7 | (def wheel 500) 8 | 9 | (core/defresponder2 10 | {:name ::noise 11 | :priority 100 12 | :dispatch (fn [& _] (= 1 (rand-int wheel))) 13 | :body (fn [bot msg] 14 | (when (not (= (:message msg) "")) 15 | (binding [core/befuddled (constantly nil)] 16 | ((lookup) bot msg))))}) 17 | 18 | #_(core/remove-dispatch-hook ::noise) 19 | 20 | (core/defresponder2 21 | {:name ::question 22 | :priority 80 23 | :dispatch (fn [bot msg] 24 | (let [m (core/extract-message bot msg) 25 | x (count(.split m " "))] 26 | (and (> 2 x) (.endsWith m "?")))) 27 | :body (fn [bot msg] 28 | (when (not (= (:message msg) "")) 29 | (binding [core/befuddled (constantly nil)] 30 | ((lookup) bot msg))))}) 31 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojurebot "1.1.0-SNAPSHOT" 2 | :repositories {"sonatype-snapshots" 3 | "https://oss.sonatype.org/content/repositories/snapshots/"} 4 | :description "An IRC bot written in Clojure" 5 | :exclusions [commons-logging] 6 | :dependencies [[org.clojure/clojure "1.2.1"] 7 | [org.clojure/tools.logging "0.2.6"] 8 | [conduit-irc "2.0.1-SNAPSHOT"] 9 | [org.ccil.cowan.tagsoup/tagsoup "1.2"] 10 | [cheshire "5.0.2"] 11 | [clj-http "0.7.2" 12 | :exclude [commons-logging]] 13 | [swank-clojure "1.3.2"] 14 | [com.thelastcitadel/apropos "0.0.1"] 15 | [ring "1.1.8"] 16 | [compojure "1.1.5"] 17 | ;; logging 18 | [ch.qos.logback/logback-classic "1.0.9"] 19 | [ch.qos.logback/logback-core "1.0.9"] 20 | [org.slf4j/jcl-over-slf4j "1.7.2"]] 21 | :main clojurebot.launch 22 | :clean-non-project-classes false 23 | :min-lein-version "2.0.0") 24 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/clojars.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.clojars 2 | (:use [hiredman.utilities :only (get-url)] 3 | [clojure.set :only (difference)]) 4 | (:require [hiredman.clojurebot.core :as core] 5 | [hiredman.utilities :as util] 6 | [hiredman.schedule :as sched])) 7 | 8 | (def recent (ref #{})) 9 | 10 | (defn startparse-tagsoup [s ch] 11 | (let [p (org.ccil.cowan.tagsoup.Parser.)] 12 | (.setContentHandler p ch) 13 | (.parse p s))) 14 | 15 | (defn zip-soup [url] 16 | (clojure.zip/xml-zip (clojure.xml/parse url startparse-tagsoup))) 17 | 18 | (defn get-recent [] 19 | (-> "http://clojars.org" zip-soup first 20 | ((partial tree-seq map? (comp seq :content))) 21 | ((partial filter #(= :ul (:tag %)))) last :content 22 | ((partial map (comp first :content first :content))) set)) 23 | 24 | 25 | (defn go [] 26 | (let [r (get-recent) 27 | new (difference r @recent)] 28 | (dosync (ref-set recent r)) 29 | (when (not (empty? new)) 30 | (str "recently on clojars.org: " (pr-str new))))) 31 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/shutup.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.shutup 2 | (:use (hiredman.clojurebot core)) 3 | (:import (java.util.concurrent TimeUnit))) 4 | 5 | (def mute (ref {})) 6 | 7 | (defn muted? [channel] 8 | (@mute channel)) 9 | 10 | (defmethod responder ::mute [bot msg] 11 | (when (not (muted? (:channel msg))) 12 | #(responder bot (assoc msg ::ignore true)))) 13 | 14 | (add-dispatch-hook (- (first (first @*dispatchers*)) 10) 15 | (dfn (nil? (::ignore msg))) ::mute) 16 | 17 | (defn mute-in [channel] 18 | (dosync 19 | (alter mute assoc channel true)) 20 | (println "Mute in " channel)) 21 | 22 | (defn unmute-in [channel] 23 | (dosync 24 | (alter mute assoc channel nil)) 25 | (println "Unmute in " channel)) 26 | 27 | (defmethod responder ::shutup [bot msg] 28 | (mute-in (:channel msg)) 29 | (.schedule task-runner 30 | #(unmute-in (:channel msg)) 31 | 1 32 | TimeUnit/MINUTES)) 33 | 34 | (add-dispatch-hook (dfn (and (addressed? bot msg) (re-find #"shut up$" (:message msg)))) ::shutup) 35 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/google.clj: -------------------------------------------------------------------------------- 1 | ;; DEPENDS clojure-json 2 | (ns hiredman.clojurebot.google 3 | (:use (hiredman.clojurebot core)) 4 | (:use (hiredman utilities)) 5 | (:require [clojurebot.json :as json])) 6 | 7 | (def lmgtfy "http://lmgtfy.com/?q=") 8 | 9 | (def wheel 100) 10 | 11 | (defn google [term] 12 | (json/decode-from-str (get-url (str "http://ajax.googleapis.com/ajax/services/search/web?v=1.0&q=" (java.net.URLEncoder/encode term))))) 13 | 14 | (defn cull [result-set] 15 | [(:estimatedResultCount (:cursor (:responseData result-set))) 16 | (first (:results (:responseData result-set)))]) 17 | 18 | (defn google-search? [{:keys [message]}] 19 | (and message 20 | (re-find #"^google " message))) 21 | 22 | (defn google-search [{:keys [message]}] 23 | (let [term (.trim (.replaceFirst message "^google " ""))] 24 | (if (= 0 (rand-int wheel)) 25 | (str lmgtfy (java.net.URLEncoder/encode term)) 26 | (let [[num result] (cull (google term))] 27 | (format "%s\n%s\n%s" 28 | (str "First, out of " num " results is:") 29 | (:titleNoFormatting result) 30 | (:unescapedUrl result)))))) 31 | -------------------------------------------------------------------------------- /src/clojurebot/epigrams.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.epigrams) 2 | 3 | (defn startparse-tagsoup [s ch] 4 | (let [p (org.ccil.cowan.tagsoup.Parser.)] 5 | (.setContentHandler p ch) 6 | (.parse p s))) 7 | 8 | (defn zip-soup [url] 9 | (clojure.zip/xml-zip (clojure.xml/parse url startparse-tagsoup))) 10 | 11 | (def url "http://www.cs.yale.edu/quotes.html") 12 | 13 | (defn find-tag [tag top] 14 | (->> top :content (filter #(= tag (:tag %))) first)) 15 | 16 | (defonce eps 17 | (->> url 18 | zip-soup 19 | first 20 | (find-tag :body) 21 | :content 22 | second 23 | :content 24 | (filter #(= :p (:tag %))) 25 | (map :content) 26 | (map first) 27 | (remove nil?) 28 | (map #(.replaceAll % "\n" " ")) 29 | (map #(.trim %)) 30 | vec 31 | delay)) 32 | 33 | (defn epigram-query? [{:keys [message]}] 34 | (and message 35 | (re-find #"^#\d+" message) 36 | (> 121 (Integer/parseInt (apply str (rest message))) 0))) 37 | 38 | (defn lookup-epigram [{:keys [message]}] 39 | (let [n (dec (Integer/parseInt (apply str (rest message))))] 40 | (str (nth @eps n) 41 | " -- Alan J. Perlis"))) 42 | -------------------------------------------------------------------------------- /clojurebot-facts/project.clj: -------------------------------------------------------------------------------- 1 | (defproject clojurebot-facts "1.1.0-SNAPSHOT" 2 | :description "FIXME: write description" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.5.1"] 7 | [ring "1.1.8"] 8 | [org.clojure/tools.logging "0.2.6"] 9 | [org.apache.derby/derby "10.8.1.2"] 10 | [org.clojure/java.jdbc "0.2.3"] 11 | [factual/fnparse "2.3.0"] 12 | [postgresql/postgresql "9.1-901.jdbc4"] 13 | [clj-http "0.6.4" :exclude [cheshire]] 14 | [clojure-opennlp "0.1.9"] 15 | [org.clojure/core.logic "0.8.3"] 16 | [org.clojure/tools.nrepl "0.2.3"] 17 | ;; logging 18 | [ch.qos.logback/logback-classic "1.0.9"] 19 | [ch.qos.logback/logback-core "1.0.9"] 20 | [org.slf4j/jcl-over-slf4j "1.7.2"] 21 | [com.thelastcitadel/m29 "0.1.0"]] 22 | :plugins [[lein-ring "0.8.2"]] 23 | :ring {:handler clojurebot.facts/handler 24 | :init clojurebot.facts/init}) 25 | -------------------------------------------------------------------------------- /setup.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # setup a chroot for clojurebot on an ec2 instance 4 | 5 | outside() { 6 | 7 | ubuntu=`lsb_release -a|grep Codename:|awk '{print $2}'` 8 | location="/var/chroot/" 9 | 10 | apt-get install dchroot debootstrap tmux 11 | 12 | if [ ! -e $HOME/.tmux.conf ]; then 13 | cat >> $HOME/.tmux.conf <> /etc/schroot/schroot.conf < #'handler* 36 | wrap-params)) 37 | 38 | (defn init [] 39 | (when (empty? (System/getProperty "java.security.policy")) 40 | (System/setProperty 41 | "java.security.policy" 42 | (str (.getResource (class #'init) "/example.policy"))))) 43 | -------------------------------------------------------------------------------- /src/clojurebot/seenx.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.seenx 2 | (:use [hiredman.clojurebot.core :only [befuddled]]) 3 | (:import (java.util Date))) 4 | 5 | (defonce user-db (atom {})) 6 | 7 | (defn log-user [{:keys [message sender channel target type]}] 8 | (let [target (or channel sender target)] 9 | (swap! user-db 10 | update-in [target sender] 11 | (constantly 12 | [type (Date.) message])))) 13 | 14 | (defn last-seen-str [nick channel [type time message]] 15 | (println "@last-seen-str") 16 | (println nick channel type time message) 17 | (let [now (java.util.Date.) 18 | minutes (int (/ (/ (- (.getTime now) (.getTime (or time now))) 1000) 60))] 19 | (condp = type 20 | :join 21 | (str nick " was last seen joining " channel ", " minutes " minutes ago" ) 22 | :part 23 | (str nick " was last seen parting " channel ", " minutes " minutes ago") 24 | :quit 25 | (str nick " was last seen quiting IRC, " minutes " minutes ago") 26 | :message 27 | (str nick " was last seen in " channel ", " minutes " minutes ago saying: " message)))) 28 | 29 | (defn seen-user [{:keys [message sender channel bot]}] 30 | (println message sender channel bot) 31 | (if channel 32 | (let [who (.replaceAll 33 | (.trim (.replaceAll message "^seen " "")) 34 | "\\?$" "") 35 | last (get-in @user-db [channel who])] 36 | (cond 37 | (= who (.getNick bot)) 38 | "of course I've seen myself" 39 | 40 | (seq last) 41 | (last-seen-str who channel last) 42 | 43 | :else 44 | (befuddled))) 45 | (befuddled))) 46 | 47 | (defn seenx-query? [{:keys [message]}] 48 | (and message 49 | (re-find #"seen .*[^ ]" message))) 50 | -------------------------------------------------------------------------------- /src/clojurebot/eval.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.eval 2 | (:require [clj-http.client :as http] 3 | [hiredman.clojurebot.core :as cc] 4 | [clojure.tools.logging :as log] 5 | [hiredman.utilities :as u])) 6 | 7 | (defn naughty-forms? [strang] 8 | (let [nf #{"catch" "finally" "clojure.asm" "hiredman.clojurebot" 9 | "java.lang.Thread."}] 10 | (some #(not= -1 %) (map #(.lastIndexOf strang %) nf)))) 11 | 12 | (defn eval-request? [{:keys [message]}] 13 | (and message (re-find #"^," (.trim message)))) 14 | 15 | (defn eval-message [{:keys [message sender config] :as bag}] 16 | (if (and (not (naughty-forms? message)) 17 | (not= sender "itistoday") 18 | (not= sender "Lajla") 19 | (not= sender "Lajjla")) 20 | (try 21 | (u/with-breaker 20 22 | (let [{:keys [body] :as result} (http/get (config :evaluator) 23 | {:query-params {:expression (.replaceAll message "^," "") 24 | :befuddled (pr-str ::befuddled)} 25 | ;; 10 seconds 26 | :socket-timeout (* 1000 10) 27 | :conn-timeout (* 1000 10)}) 28 | {:keys [stdout stderr result]} (read-string body)] 29 | (if (or (= result (pr-str ::befuddled)) 30 | (= result (prn-str ::befuddled))) 31 | (cc/befuddled) 32 | [stdout stderr result]))) 33 | (catch Throwable t 34 | (log/info t "eval request failed") 35 | "eval service is offline")) 36 | (str sender ": " (cc/befuddled)))) 37 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/tao.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.tao 2 | (:use [clojure.set :only [difference]]) 3 | (:import (java.io ByteArrayInputStream) 4 | (clojure.lang PersistentQueue)) 5 | (:require [hiredman.clojurebot.core :as core] 6 | [hiredman.schedule :as sched] 7 | [hiredman.utilities :as util])) 8 | 9 | (def thetao "https://twitter.com/statuses/user_timeline/200313960.rss") 10 | 11 | (defn get-entries [] 12 | (->> thetao util/get-url .getBytes ByteArrayInputStream. clojure.xml/parse 13 | (tree-seq map? (comp seq :content)) 14 | (filter #(= :item (:tag %))) 15 | (hash-map :content) 16 | (tree-seq map? (comp seq :content)) 17 | (filter #(= :title (:tag %))) 18 | (map :content) 19 | (map first) 20 | (map #(.replaceAll % "^WonderTao: " "")))) 21 | 22 | (defn go [bot channel n] 23 | (let [seen-entries (atom #{}) 24 | Q (ref PersistentQueue/EMPTY)] 25 | (letfn [(enqueue [string] 26 | (dosync (alter Q conj string))) 27 | (de-enqueue [] 28 | (dosync 29 | (let [item (peek (ensure Q))] 30 | (alter Q pop) 31 | item)))] 32 | (sched/fixedrate 33 | {:task (fn [] 34 | (let [entries (get-entries) 35 | new-entries (difference (set entries) @seen-entries) 36 | ordered-new-entries (reverse (filter new-entries entries))] 37 | (reset! seen-entries (set new-entries)) 38 | (doseq [i ordered-new-entries] 39 | (enqueue i)))) 40 | :start-delay 1 41 | :rate 60 42 | :unit (:minutes sched/unit)}) 43 | (sched/fixedrate 44 | {:task (fn [] 45 | (Thread/sleep (* (rand-int 3) 1000 60 (rand-int 5))) 46 | (when-let [msg (de-enqueue)] 47 | (.sendMessage (:this bot) channel msg))) 48 | :start-delay 1 49 | :rate n 50 | :unit (:minutes sched/unit)})))) 51 | 52 | 53 | -------------------------------------------------------------------------------- /src/hiredman/utilities.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.utilities 2 | (:use (hiredman horizon)) 3 | (:import (java.net URL URLEncoder) 4 | (java.io BufferedReader InputStreamReader OutputStreamWriter) 5 | (java.text SimpleDateFormat ParsePosition) 6 | (sun.misc BASE64Encoder))) 7 | 8 | (defn get-url [x] 9 | (with-open [a (-> (doto (-> x URL. .openConnection) 10 | (.setRequestProperty "User-Agent" "clojurebot") 11 | (.setRequestProperty "Accept" "application/xml")) 12 | .getInputStream InputStreamReader. BufferedReader.)] 13 | (loop [buf (StringBuilder.) line (.readLine a)] 14 | (if line 15 | (recur (doto buf (.append line)) (.readLine a)) 16 | (.toString buf))))) 17 | 18 | (defmacro mk-interface [class fn] 19 | (let [x (map #(list (symbol (.getName %)) 20 | ['& 'x] 21 | (list 'let ['method (keyword (.getName %))] fn)) (.getMethods (eval class)))] 22 | `(proxy [~class] [] ~@x))) 23 | 24 | (defn scoped-get-url [x] 25 | (let [t (-> x URL. .getContent InputStreamReader. BufferedReader.)] 26 | (hiredman.horizon/when-hrz :exits #(.close t)) 27 | t)) 28 | 29 | (defn shell [cmd] 30 | (.. Runtime getRuntime (exec cmd))) 31 | 32 | ;; (defn tinyurl [url] 33 | ;; (-> "http://is.gd/api.php?longurl=%s" (format (URLEncoder/encode url)) 34 | ;; get-url)) 35 | 36 | (defn tinyurl [url] 37 | (-> (format "http://tinyurl.com/api-create.php?url=%s" (URLEncoder/encode url)) 38 | get-url)) 39 | 40 | (def tinyurl (memoize tinyurl)) 41 | 42 | (defn- base64encode [string] 43 | (.trim (.encode (BASE64Encoder.) (.getBytes string)))) 44 | 45 | (defn date [string format] 46 | (.parse (SimpleDateFormat. format) string (ParsePosition. 0))) 47 | 48 | (defmacro with-breaker [seconds & body] 49 | `(let [f# (future 50 | ~@body)] 51 | (try 52 | (.get f# ~seconds java.util.concurrent.TimeUnit/SECONDS) 53 | (catch Throwable t# 54 | (future-cancel f#) 55 | (throw t#))))) 56 | -------------------------------------------------------------------------------- /derby-to-postgres.clj: -------------------------------------------------------------------------------- 1 | (let [pom-uber-jar 2 | (str "http://thelibraryofcongress.s3.amazonaws.com/" 3 | "pomegranate-0.0.13-SNAPSHOT-jar-with-dependencies.jar") 4 | cl (java.net.URLClassLoader. (into-array [(java.net.URL. pom-uber-jar)])) 5 | cx (.getContextClassLoader (Thread/currentThread))] 6 | (push-thread-bindings {clojure.lang.Compiler/LOADER cl}) 7 | (.setContextClassLoader (Thread/currentThread) cl) 8 | (try 9 | (require '[cemerick.pomegranate :as pom]) 10 | (finally 11 | (.setContextClassLoader (Thread/currentThread) cx) 12 | (pop-thread-bindings)))) 13 | 14 | (pom/add-dependencies :coordinates '[[postgresql/postgresql "9.1-901.jdbc4"] 15 | [org.apache.derby/derby "10.8.1.2"] 16 | [org.clojure/java.jdbc "0.2.3"]] 17 | :repositories (merge cemerick.pomegranate.aether/maven-central 18 | {"clojars" "http://clojars.org/repo"})) 19 | 20 | (def derby-db 21 | {:classname "org.apache.derby.jdbc.EmbeddedDriver" 22 | :subname (first *command-line-args*) 23 | :subprotocol "derby"}) 24 | 25 | (def postgres-db 26 | (second *command-line-args*)) 27 | 28 | (def postgres-table (last *command-line-args*)) 29 | 30 | (require '[clojure.java.jdbc :as jdbc]) 31 | 32 | (jdbc/with-connection postgres-db 33 | (try 34 | (jdbc/do-commands "CREATE EXTENSION \"uuid-ossp\"") 35 | (catch Exception _)) 36 | (jdbc/create-table 37 | postgres-table 38 | [:id :uuid "PRIMARY KEY" "DEFAULT uuid_generate_v4()"] 39 | [:subject "varchar(32670)"] 40 | [:predicate "varchar(32670)"] 41 | [:object "varchar(32670)"] 42 | [:upper_subject "varchar(32670)"] 43 | [:created_at :timestamp "NOT NULL" "DEFAULT CURRENT_TIMESTAMP"]) 44 | (apply jdbc/insert-records 45 | postgres-table 46 | (map #(dissoc % :id) 47 | (jdbc/with-connection derby-db 48 | (jdbc/with-query-results results 49 | ["SELECT * FROM triples"] 50 | (doall results)))))) 51 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/delicious.clj: -------------------------------------------------------------------------------- 1 | ;; posts lines containing urls to a delicious account 2 | (ns hiredman.clojurebot.delicious 3 | (:use [hiredman.clojurebot.core :only (defresponder2)]) 4 | (:require [hiredman.clojurebot.core :as core] 5 | [hiredman.utilities :as util]) 6 | (:import (java.net URLEncoder URL))) 7 | 8 | (def url-reg #"[A-Za-z]+://[^ ^/]+\.[^ ^/]+[^ ]+") 9 | 10 | (def pastebins 11 | #"(fpaste\.org|dpaste\.*|gist\.github\.com|paste.lisp.org/display|.*pastebin\.com|p\.hagelb\.org|pastebin\.org|paste\.pocoo\.org/show|pastie\.org|sprunge\.us)") 12 | 13 | ;;#"(\w+://.*?)[.>]*(?: |$)" 14 | 15 | (defn post 16 | "posts a url to the delicious account of [user pass]" 17 | [[user pass] url descr tag] 18 | (util/shell (str "fetch -o /dev/null https://" user ":" pass "@api.del.icio.us/v1/posts/add?url=" (URLEncoder/encode url) "&description=" (URLEncoder/encode descr) "&tags=" (URLEncoder/encode tag)))) 19 | 20 | ;;(core/defresponder ::delicious 21 21 | ;; (core/dfn (and (re-find url-reg (:message msg)) 22 | ;; (:channel msg))) ;; 23 | ;; (let [url (re-find url-reg (:message msg)) 24 | ;; desc (:message msg) 25 | ;; tag (str (:sender msg) " " (:channel msg) 26 | ;; (when (re-find #"lisppaste" (:sender msg)) (str " " (first (.split desc " "))))) 27 | ;; tag (if (re-find pastebins url) 28 | ;; (str tag " pastbin") 29 | ;; tag)] 30 | ;; (post (:delicious bot) url desc tag))) 31 | 32 | (defresponder2 33 | {:name ::delicious 34 | :priority 21 35 | :dispatch (fn [bot msg] 36 | (and (re-find url-reg (:message msg)) 37 | (:channel msg))) 38 | :body (fn [bot msg] 39 | (let [url (re-find url-reg (:message msg)) 40 | desc (:message msg) 41 | tag (str (:sender msg) " " (:channel msg) 42 | (when (re-find #"lisppaste" (:sender msg)) (str " " (first (.split desc " "))))) 43 | tag (if (re-find pastebins url) 44 | (str tag " pastbin") 45 | tag)] 46 | (post (:delicious bot) url desc tag)))}) 47 | -------------------------------------------------------------------------------- /clojurebot-facts/src/clojurebot/facts.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.facts 2 | (:require [clojure.tools.logging :as log] 3 | [clojurebot.factoids :as f] 4 | [ring.middleware.params :as mw] 5 | [clojure.tools.nrepl.server :as nrepl])) 6 | 7 | (defmulti handler* (fn [m] (get (:params m) "op"))) 8 | 9 | (defmethod handler* "factoid-command?" [req] 10 | {:status 200 11 | :body (pr-str (boolean (f/factoid-command? 12 | {:message (get (:params req) "message") 13 | :sender (get (:params req) "sender")})))}) 14 | 15 | (defmethod handler* "factoid-lookup" [req] 16 | (binding [f/*id* (get (:params req) "id")] 17 | {:status 200 18 | :body (pr-str (f/factoid-lookup 19 | {:message (get (:params req) "message") 20 | :sender (get (:params req) "sender")}))})) 21 | 22 | (defmethod handler* "factoid-lookup-no-fall-back" [req] 23 | (binding [f/*id* (get (:params req) "id")] 24 | {:status 200 25 | :body (pr-str (f/factoid-lookup-no-fall-back 26 | {:message (get (:params req) "message") 27 | :sender (get (:params req) "sender")}))})) 28 | 29 | (defmethod handler* "factoid-command-run" [req] 30 | (binding [f/*id* (get (:params req) "id")] 31 | {:status 200 32 | :body (pr-str (f/factoid-command-run 33 | {:message (get (:params req) "message") 34 | :sender (get (:params req) "sender")}))})) 35 | 36 | (def senders (atom {})) 37 | 38 | (defonce fut (delay 39 | (future 40 | (while true 41 | (Thread/sleep (* 1000 60 5)) 42 | (reset! senders {}))))) 43 | 44 | (defn wrap-record-sender [f] 45 | (fn [req] 46 | (swap! senders update-in [(get (:params req) "sender")] (fnil inc 0)) 47 | (f req))) 48 | 49 | (defn wrap-throttle-sender[f] 50 | (fn [req] 51 | (when (> (or (get @senders (get (:params req) "sender")) 0) 52 | 10) 53 | (assert nil)) 54 | (f req))) 55 | 56 | (defn wrap-log-request [f] 57 | (fn [req] 58 | (log/info req) 59 | (f req))) 60 | 61 | (defn wrap-edn-response [f] 62 | (fn [req] 63 | (let [r (f req)] 64 | (update-in r [:headers] assoc "Content-Type" "application/edn; charset=utf-8")))) 65 | 66 | (def handler (-> #'handler* 67 | wrap-record-sender 68 | wrap-throttle-sender 69 | ((fn [f] 70 | (fn [req] 71 | (if (contains? #{"logic_prog" 72 | "ddellacosta" 73 | "bitemyapp" 74 | "arrdem"} 75 | (get (:params req) "sender")) 76 | (assert nil) 77 | (f req))))) 78 | wrap-log-request 79 | wrap-edn-response 80 | mw/wrap-params)) 81 | 82 | (defn init [] 83 | @fut 84 | (nrepl/start-server :port 5678)) 85 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/github.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.github 2 | (:import (java.text SimpleDateFormat ParsePosition FieldPosition)) 3 | (:require [hiredman.clojurebot.core :as core] 4 | [hiredman.schedule :as sched] 5 | [clojurebot.json :as json] 6 | [hiredman.utilities :as util])) 7 | 8 | (def api-url "http://github.com/api/v2/json/commits/list/richhickey/clojure/master") 9 | 10 | (def commit-url "http://github.com/api/v2/json/commits/show/richhickey/clojure") 11 | 12 | (defn parse-date 13 | "Git Hub Date String -> Java Date Object" 14 | [string] 15 | (.parse (SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ssZ") 16 | (.replaceAll string "(\\d\\d):(\\d\\d)$" "$1$2") 17 | (ParsePosition. 0))) 18 | 19 | (defn deparse-date [date] 20 | (.toString 21 | (.format (SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ssZ") 22 | date 23 | (StringBuffer.) 24 | (FieldPosition. 0)))) 25 | 26 | (defn get-commit 27 | "get the commit message for commit n" 28 | [n] 29 | (-> commit-url (str "/" n) util/get-url json/decode-from-str :commit :message)) 30 | 31 | (core/defresponder ::git-commit 0 32 | (core/dfn (and (re-find #"^git ([^ ])" (core/extract-message bot msg)) 33 | (:addressed? (meta msg)))) ;; 34 | (let [m (.replaceAll (core/extract-message bot msg) (.toString #"^git ([^ ])") "$1")] 35 | (core/new-send-out bot :msg msg (get-commit m)))) 36 | 37 | (defn get-commits 38 | "get list of commits from github" 39 | [] 40 | (-> api-url util/get-url json/decode-from-str :commits 41 | ((partial map #(update-in % [:committed_date] parse-date))) 42 | ((partial map #(update-in % [:authored_date] parse-date))) 43 | ((partial sort-by :commited_date)) 44 | reverse)) 45 | 46 | (defn new-commit? 47 | "is this date after the date of the last commit this bot has a record for?" 48 | [date bot] 49 | (if-let [d (get (deref (:store bot)) "last commit")] 50 | (.before (parse-date d) date) 51 | true)) 52 | 53 | (defn set-commit! 54 | "record this date in this bot's store so we know that commits after this date are new" 55 | [date bot] 56 | (send-off (:store bot) assoc "last commit" (deparse-date date))) 57 | 58 | (defn format-commit 59 | "format commit for sending" 60 | [commit] 61 | (str (:name (:author commit)) ": " (:message commit) 62 | "; " (util/tinyurl (:url commit)))) 63 | 64 | (defn format-and-store 65 | "store date from this commit and then return the commit formated for sending out" 66 | [commit bot] 67 | (set-commit! (:committed_date commit) bot) 68 | (format-commit commit)) 69 | 70 | (defn process-commits 71 | "process commits for bot and send results to channel" 72 | [bot channel] 73 | (println "processing commits") 74 | (doseq [c (filter #(-> % :committed_date (new-commit? bot)) (get-commits))] 75 | (core/new-send-out bot :notice channel (format-and-store c bot)))) 76 | 77 | (defn start-github-watch [bot channel] 78 | (sched/fixedrate {:task #(process-commits bot channel) :start-delay 1 :rate 10 :unit (:minutes sched/unit)})) 79 | -------------------------------------------------------------------------------- /src/clojurebot/feed.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.feed 2 | (:use [clojure.tools.logging :only [info]]) 3 | (:require [clojure.xml :as xml] 4 | [hiredman.utilities :as util] 5 | [clojure.set :as set] 6 | [clj-http.client :as http])) 7 | 8 | (defn stage1 [url] 9 | (filter #(= :entry (:tag %)) 10 | (tree-seq map? (comp seq :content) (xml/parse url)))) 11 | 12 | (defn stage1* [url & [username password]] 13 | (->> (http/get url {:basic-auth [username password]}) 14 | :body 15 | .getBytes 16 | (java.io.ByteArrayInputStream.) 17 | (xml/parse) 18 | (tree-seq map? (comp seq :content)))) 19 | 20 | (defn find-tag [tag top] 21 | (->> top :content (filter #(= tag (:tag %))) first)) 22 | 23 | (defn id [entry] 24 | (->> entry (find-tag :id) :content first)) 25 | 26 | (defn link [entry] 27 | (->> entry (find-tag :link) :attrs :href)) 28 | 29 | (defn title [entry] 30 | (->> entry (find-tag :title) :content first)) 31 | 32 | (defn author [entry] 33 | (->> entry (find-tag :author) (find-tag :name) :content first)) 34 | 35 | (defn updated [entry] 36 | (->> entry (find-tag :updated) :content first)) 37 | 38 | (defn entry->map [entry] 39 | {:id (id entry) 40 | :link (util/tinyurl (link entry)) 41 | :title (title entry) 42 | :author (author entry) 43 | :date (updated entry)}) 44 | 45 | (defn stage2 [entries] 46 | (map entry->map entries)) 47 | 48 | (defn rss-entries [url & [username password]] 49 | (->> (stage1* url username password) 50 | (filter #(= :entry (:tag %))) 51 | (map entry->map))) 52 | 53 | (def last-seen 500) 54 | 55 | (defonce ^{:private true} entry-cache (atom {})) 56 | 57 | (defn atom-pull* 58 | ([url] 59 | (atom-pull* url url)) 60 | ([url key] 61 | (info (format "atom-pull %s %s" url key)) 62 | (let [ids (get @entry-cache key) 63 | seen-ids (set ids) 64 | latest-entries (stage2 (stage1 url)) 65 | new-ids (set/difference (set (map :id latest-entries)) 66 | seen-ids) 67 | new-entries (reverse (filter (comp new-ids :id) latest-entries))] 68 | (swap! entry-cache update-in [key] 69 | (comp set #(take last-seen %) #(into % new-ids) set)) 70 | (println new-entries) 71 | new-entries))) 72 | 73 | (defn atom-pull 74 | ([url] 75 | (atom-pull url url)) 76 | ([url key] 77 | (reduce #(str %1 %2 "\n") nil (take 5 (atom-pull* url key))))) 78 | 79 | (defn rss-pull* [url & [username password]] 80 | (info (format "rss-pull %s" url)) 81 | (let [ids (get @entry-cache url) 82 | seen-ids (set ids) 83 | latest-entries (rss-entries url username password) 84 | new-ids (set/difference (set (map :id latest-entries)) 85 | seen-ids) 86 | new-entries (reverse (filter (comp new-ids :id) latest-entries))] 87 | (swap! entry-cache update-in [url] 88 | (comp set #(take last-seen %) #(into % new-ids) set)) 89 | new-entries)) 90 | 91 | (defn rss-pull [url & [username password]] 92 | (reduce #(str %1 %2 "\n") nil (take 5 (rss-pull* url username password)))) 93 | 94 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/ticket.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.ticket 2 | (:require [hiredman.clojurebot.core :as core] 3 | [hiredman.utilities :as util] 4 | [clojure.xml] 5 | [clojure.zip]) 6 | (:import (java.io StringReader StringBufferInputStream) 7 | (java.net URLEncoder))) 8 | 9 | (def url "http://www.assembla.com/spaces/clojure/tickets/") 10 | (def contrib-url "http://www.assembla.com/spaces/clojure-contrib/tickets/") 11 | (def ready-to-test-url "http://www.assembla.com/spaces/clojure/tickets?tickets_report_id=4") 12 | 13 | (def ticket #"^ticket #(\d)") 14 | (def contrib-ticket #"^contrib ticket #(\d)") 15 | (def search-tickets-pattern #"^ticket search (.*)") 16 | 17 | (defn search [term] 18 | (format "http://www.assembla.com/spaces/clojure/search?q=%s&commit=Go&search[flows]=0&search[wiki]=0&search[tickets]=1&search[tickets]=0&search[documents]=0" (URLEncoder/encode term))) 19 | 20 | (defn parse-str [str] 21 | (-> str StringBufferInputStream. clojure.xml/parse)) 22 | 23 | (defn get-ticket [n] 24 | (-> url (str n) util/get-url parse-str)) 25 | ;(def get-ticket (memoize get-ticket)) 26 | 27 | (defn ticket-nth "get the nth ticket" [n] 28 | (-> n get-ticket :content ((partial filter #(#{:created-on :summary :status :priority} (:tag %)))) 29 | ((partial reduce #(assoc % (:tag %2) (first (:content %2))) {})) 30 | (update-in [:status] {"1" :accepted "0" :new "2" :invalid "3" :fixed "4" :test}) 31 | (update-in [:priority] {"3" :normal "1" :highest "2" :high "4" :low "5" :lowest}) 32 | (update-in [:summary] (fn [s] (.replaceAll s "\\s" " "))))) 33 | 34 | (defn ticket-query? [{:keys [message]}] 35 | (re-find ticket message)) 36 | 37 | (defn get-ticket-n [{:keys [message]}] 38 | (let [n (.replaceAll message (.toString ticket) "$1")] 39 | (pr-str (assoc (ticket-nth n) :url (symbol (util/tinyurl (str url n))))))) 40 | 41 | (declare search-tickets-for) 42 | 43 | (defn contrib-ticket-query? [{:keys [message]}] 44 | (re-find contrib-ticket message)) 45 | 46 | (defn get-contrib-ticket-n [{:keys [message]}] 47 | (let [n (.replaceAll message (.toString contrib-ticket) "$1")] 48 | (prn-str (assoc (binding [url contrib-url] (ticket-nth n)) :url (symbol (util/tinyurl (str contrib-url n))))))) 49 | 50 | (defn startparse-tagsoup [s ch] 51 | (let [p (org.ccil.cowan.tagsoup.Parser.)] 52 | (.setContentHandler p ch) 53 | (.parse p s))) 54 | 55 | (defn zip-soup [url] 56 | (clojure.zip/xml-zip (clojure.xml/parse url startparse-tagsoup))) 57 | 58 | (defn search-tickets-for [term] 59 | (-> term search zip-soup first :content 60 | ((partial filter #(= :body (:tag %)))) first :content 61 | ((partial filter #(= :div (:tag %)))) 62 | ((partial filter #(= "content" ((comp :id :attrs) %)))) 63 | ((partial map :content)) first ((partial map :content)) 64 | ((partial map first)) ((partial filter #(= :ul (:tag %)))) first :content 65 | ((partial map :content)) 66 | ((partial map first)) 67 | ((partial mapcat :content)) 68 | ((partial filter #(= :h4 (:tag %)))) 69 | ((partial mapcat :content)) 70 | ((partial filter #(= :a (:tag %)))) 71 | ((partial mapcat :content)))) 72 | 73 | (defn ticket-search? [{:keys [message]}] 74 | (println message) 75 | (re-find search-tickets-pattern message)) 76 | 77 | (defn search-tickets [{:keys [message]}] 78 | (prn-str 79 | (search-tickets-for 80 | (last (re-find search-tickets-pattern message))))) 81 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/factoids.clj: -------------------------------------------------------------------------------- 1 | (ns hiredman.clojurebot.factoids 2 | (:require [clj-http.client :as http] 3 | [clojure.tools.logging :as log] 4 | [hiredman.utilities :as u]) 5 | (:import (java.util UUID))) 6 | 7 | (create-ns 'clojurebot.core) 8 | (intern 'clojurebot.core 'l) 9 | 10 | (defn factoid-command? [{:keys [message config sender]}] 11 | (u/with-breaker 10 12 | (let [{:keys [body]} (http/get (:facts-service config) 13 | {:query-params {:op "factoid-command?" 14 | :message message 15 | :sender sender}})] 16 | (read-string body)))) 17 | 18 | (defn factoid-lookup [{:keys [message config bot sender] :as bag}] 19 | (let [id (str (UUID/randomUUID))] 20 | (swap! clojurebot.core/l assoc id bot) 21 | (try 22 | (u/with-breaker 60 23 | (let [{:keys [body]} 24 | (http/get (:facts-service config) 25 | {:query-params {:op "factoid-lookup" 26 | :message message 27 | :id (str id) 28 | :sender sender 29 | :befuddled-url "http://localhost:3205/befuddled" 30 | :ok-url "http://localhost:3205/ok" 31 | :randomperson-url 32 | (str "http://localhost:3205/randomperson/" id)}})] 33 | (read-string body))) 34 | (finally 35 | (swap! clojurebot.core/l dissoc id))))) 36 | 37 | (defn factoid-lookup-no-fall-back [{:keys [message config bot sender] :as bag}] 38 | (try 39 | (let [id (str (UUID/randomUUID))] 40 | (swap! clojurebot.core/l assoc id bot) 41 | (try 42 | (u/with-breaker 60 43 | (let [{:keys [body]} 44 | (http/get (:facts-service config) 45 | {:query-params {:op "factoid-lookup-no-fall-back" 46 | :message message 47 | :id (str id) 48 | :sender sender 49 | :befuddled-url "http://localhost:3205/befuddled" 50 | :ok-url "http://localhost:3205/ok" 51 | :randomperson-url 52 | (str "http://localhost:3205/randomperson/" id)}})] 53 | (read-string body))) 54 | (finally 55 | (swap! clojurebot.core/l dissoc id)))) 56 | (catch Throwable t 57 | (log/info t) 58 | nil))) 59 | 60 | (defn factoid-command-run [{:keys [config message bot sender]}] 61 | (let [id (str (UUID/randomUUID))] 62 | (swap! clojurebot.core/l assoc id bot) 63 | (try 64 | (u/with-breaker 60 65 | (let [{:keys [body]} 66 | (http/get (:facts-service config) 67 | {:query-params {:op "factoid-command-run" 68 | :message message 69 | :id (str id) 70 | :sender sender 71 | :befuddled-url "http://localhost:3205/befuddled" 72 | :ok-url "http://localhost:3205/ok" 73 | :randomperson-url 74 | (str "http://localhost:3205/randomperson/" id)}})] 75 | (read-string body))) 76 | (finally 77 | (swap! clojurebot.core/l dissoc id))))) 78 | -------------------------------------------------------------------------------- /clojurebot-facts/src/clojurebot/infer.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.infer 2 | (:refer-clojure :exclude [==]) 3 | (:require [clojure.core.logic.protocols :as lp] 4 | [clojurebot.triples :as trip] 5 | [clojure.core.logic :refer [fresh 6 | == 7 | conde 8 | != 9 | pred 10 | run* 11 | tabled 12 | lvar? 13 | to-stream]])) 14 | 15 | (declare db infer) 16 | 17 | (defn synthesize-forwards [o subject predicate object level] 18 | (fresh [s' p' o'] 19 | (== s' o) 20 | (db s' p' o') 21 | (conde 22 | [(== p' "is")] 23 | [(== p' "are")]) 24 | (conde 25 | [(== object o')] 26 | [(infer s' p' o' subject predicate object (inc level))]))) 27 | 28 | (defn synthesize-backwards [o subject predicate object level] 29 | (fresh [s' p' o'] 30 | (== o' o) 31 | (!= s' subject) 32 | (db s' p' o') 33 | (conde 34 | [(== p' "is")] 35 | [(== p' "are")]) 36 | (conde 37 | [(== object s')] 38 | ;; new "subject", so re-query the db and recurse 39 | [(fresh [s'' p'' o''] 40 | (== s' s'') 41 | (db s'' p'' o'') 42 | (conde 43 | [(== p'' "is")] 44 | [(== p'' "are")]) 45 | (conde 46 | [(== object o'')] 47 | [(infer s'' p'' o'' subject predicate object (inc level))]))]))) 48 | 49 | ;; with a better understanding of the edges of the graph (called the 50 | ;; predicate here) other types of synthesis should be possible 51 | ;; if a > b and b > c then a > c sorts of things 52 | ;; (fresh [a b c] 53 | ;; (db a ">" b) 54 | ;; (db b ">" c) 55 | ;; (== [subject predicate object] [a ">" c])) 56 | (defn infer [s p o subject predicate object level] 57 | (fresh [] 58 | (pred level (partial > 3)) 59 | (conde 60 | ;; walk down the chain 61 | [(synthesize-forwards o subject predicate object level)] 62 | ;; walk up the chain 63 | [(synthesize-backwards o subject predicate object level)] 64 | [(fresh [a b c] 65 | (== a s) 66 | (conde 67 | [(db a ">" b)] 68 | [(db b "<" a)]) 69 | (conde 70 | [(db b ">" c)] 71 | [(db c "<" b)]) 72 | (== [subject predicate object] [a ">" c]))]))) 73 | 74 | (defn respondo [input] 75 | (distinct 76 | (run* [q] 77 | (fresh [subject predicate object inferred p o] 78 | (== q {:subject subject 79 | :predicate predicate 80 | :object object 81 | :infered? inferred}) 82 | (!= subject object) 83 | (== subject input) 84 | (== predicate p) 85 | (db input p o) 86 | (conde 87 | [(== [subject predicate object inferred] 88 | [input p o false])] 89 | [(== inferred true) 90 | (infer input p o subject predicate object 0)]))))) 91 | 92 | (defn db* [subject predicate object] 93 | (letfn [(f [a x] 94 | (let [s (lp/walk a x)] 95 | (if (lvar? s) 96 | (keyword (name (gensym 'x))) 97 | s)))] 98 | (fn [a] 99 | (let [s (f a subject) 100 | p (f a predicate) 101 | o (f a object)] 102 | (assert (or (not (keyword? s)) (not (keyword? o)))) 103 | (to-stream 104 | (for [rec (trip/query s p o)] 105 | (trampoline 106 | (fresh [] 107 | (== (:subject rec) subject) 108 | (== (:predicate rec) predicate) 109 | (== (:object rec) object)) 110 | a))))))) 111 | 112 | (def db 113 | (tabled [subject predicate object] 114 | (db* subject predicate object))) 115 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/code_lookup.clj: -------------------------------------------------------------------------------- 1 | ;; DEPENDS clojure-json 2 | (ns hiredman.clojurebot.code-lookup 3 | (:use (hiredman.clojurebot core)) 4 | (:use (hiredman utilities)) 5 | (:require [clojurebot.json :as json]) 6 | (:import (java.io File InputStreamReader BufferedReader))) 7 | 8 | (def google-code-url "http://code.google.com/p/clojure/source/browse/trunk/src/clj/") 9 | (def google-java-code-url "http://code.google.com/p/clojure/source/browse/trunk/src/jvm/") 10 | ;;http://code.google.com/p/clojure/source/browse/trunk/src/jvm/clojure/lang/Cons.java?r=1334 11 | 12 | (def contrib-url "http://github.com/clojure/clojure-contrib/raw/gh-pages/api-index.json") 13 | 14 | (def contrib 15 | (delay (try (json/decode-from-str (get-url contrib-url)) (catch Exception e nil)))) 16 | 17 | (defn get-rev-number [] 18 | ((comp #(Integer/parseInt %) 19 | second 20 | #(.split % " ") 21 | first 22 | (partial filter #(re-find #"^Revision: " %)) 23 | line-seq 24 | #(BufferedReader. %) 25 | #(InputStreamReader. %) 26 | #(.getInputStream %) 27 | #(.. Runtime getRuntime (exec % %2 %3)));end comp 28 | (into-array ["svn" "info"]) 29 | nil 30 | (File. "/home/hiredman/clojure/"))) 31 | 32 | ;;(def clojurebot-rev (get-rev-number)) 33 | (def clojurebot-rev 1) 34 | 35 | (defn get-sha-number [] 36 | "f128af9d36dfcb268b6e9ea63676cf254c0f1c40" 37 | #_((comp; #(Integer/parseInt %) 38 | second 39 | #(.split % " ") 40 | first 41 | line-seq 42 | #(BufferedReader. %) 43 | #(InputStreamReader. %) 44 | #(.getInputStream %) 45 | #(.. Runtime getRuntime (exec % %2 %3)));end comp 46 | (into-array ["git" "log" "-1"]) 47 | nil 48 | (File. "/home/hiredman/clojure/"))) 49 | 50 | (def clojurebot-rev (get-sha-number)) 51 | 52 | (def foo "http://github.com/clojure/clojure-contrib/blob/7ea70da82e42416864e2f97e3d314aced34af682/src/clojure/contrib/") 53 | (def bar "http://code.google.com/p/clojure-contrib/source/browse/trunk/src/clojure/contrib/") 54 | 55 | (defn google-code->github-url 56 | "transforms a googlecode source url into a github url" 57 | [url project rev] 58 | (-> url 59 | (.replaceAll "http://code.google.com/p/clojure/source/browse/trunk" 60 | (str "https://github.com/clojure/" project "/blob/" rev)) 61 | (.replaceAll "\\?r=(.*)#(\\d+)" "#L$2"))) 62 | 63 | 64 | (defn get-file-and-ln [string] 65 | (let [a (meta (try (resolve (symbol string)) 66 | (catch Exception _ nil)))] 67 | [(:line a) (:file a)])) 68 | 69 | (defn make-url [[line file]] 70 | (let [google (str google-code-url file "?r=" clojurebot-rev "#" line) 71 | google (google-code->github-url google "clojure" clojurebot-rev)] 72 | (tinyurl google))) 73 | 74 | (def make-url-cached (memoize make-url)) 75 | 76 | (def java-code-url (memoize (fn [url] 77 | (get-url 78 | (str "http://tinyurl.com/api-create.php?url=" 79 | (java.net.URLEncoder/encode url)))))) 80 | 81 | (def java-code-url (fn [url] (tinyurl url))) 82 | 83 | (defmulti lookup 84 | (fn [msg thing] 85 | (cond 86 | (re-find #"c\.l\.[a-zA-z]+" thing) :clojure-java 87 | (re-find #"[a-zA-z]+\.[a-zA-z]+\.[a-zA-z]+" thing) :java 88 | :else :clojure))) 89 | 90 | (defmethod lookup :clojure-java [msg thing] 91 | (lookup msg (.replaceAll thing "c\\.l" "clojure.lang"))) 92 | 93 | (defmethod lookup :java [msg thing] 94 | (str thing ": " 95 | (java-code-url 96 | (google-code->github-url 97 | (str google-java-code-url 98 | (.replaceAll thing "\\." "/") ".java?r=" clojurebot-rev) 99 | "clojure" 100 | clojurebot-rev)))) 101 | 102 | (defn contrib-lookup [thing] 103 | (map (comp #(get-url (str "http://tinyurl.com/api-create.php?url=" 104 | (java.net.URLEncoder/encode %))) 105 | ;;#(.replaceAll % "#(\\d)" "#L$1") ;;horrible patching for github 106 | ;;#(.replace % bar foo) 107 | :source-url) 108 | (filter #(= (:name %) thing) (:vars @contrib)))) 109 | 110 | (defmethod lookup :clojure [msg thing] 111 | (println msg thing) 112 | (let [[line file] (get-file-and-ln thing)] 113 | (if (or (nil? file) (nil? line)) 114 | (if-let [results (seq (contrib-lookup thing))] 115 | (reduce #(str % " " %2) (str thing ":") results) 116 | (befuddled)) 117 | (str thing ": " (make-url-cached [line file]))))) 118 | 119 | (defn code-lookup? [{:keys [message]}] 120 | (re-find #"^(def|source) " message)) 121 | 122 | (defn do-code-lookup [{:keys [message channel sender bot]}] 123 | (let [thing (.replaceAll message "^(def|source) " "")] 124 | (lookup message thing))) 125 | -------------------------------------------------------------------------------- /clojurebot-facts/src/clojurebot/triples/postgres.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.triples.postgres 2 | (:require [clojure.java.jdbc :as sql] 3 | [clojure.tools.logging])) 4 | 5 | (defmacro with-c [db & body] 6 | `(sql/with-connection ~db 7 | ~@body)) 8 | 9 | (def pg (delay (read-string (slurp (System/getProperty "postgres"))))) 10 | 11 | (defn create-store 12 | [name] 13 | (with-c (:url @pg) 14 | (try 15 | (sql/do-commands "CREATE EXTENSION \"uuid-ossp\"") 16 | (catch Exception _)) 17 | (sql/create-table 18 | (:table @pg) 19 | [:id :uuid "PRIMARY KEY" "DEFAULT uuid_generate_v4()"] 20 | [:subject "varchar(32670)"] 21 | [:predicate "varchar(32670)"] 22 | [:object "varchar(32670)"] 23 | [:upper_subject "varchar(32670)"] 24 | [:created_at :timestamp "NOT NULL" "DEFAULT CURRENT_TIMESTAMP"]))) 25 | 26 | (defn store-triple [{:keys [s p o]}] 27 | (with-c (:url @pg) 28 | (sql/transaction 29 | (sql/insert-values 30 | (:table @pg) 31 | [:subject :predicate :object :upper_subject] 32 | [(.trim (str s)) (.trim (str p)) (.trim (str o)) 33 | (.toUpperCase (.trim (str s)))])))) 34 | 35 | (defmulti query 36 | (fn [s p o] 37 | (cond 38 | (and (list? s) (keyword? p) (keyword? o)) 39 | ::like_subject-_-_ 40 | (and (not (keyword? s)) (not (keyword? p)) (keyword? o)) 41 | ::subject-predicate-_ 42 | (and (keyword? s) (keyword? p) (not (keyword? o))) 43 | ::_-_-object 44 | (and (keyword? s) (not (keyword? p)) (keyword? o)) 45 | ::_-predicate-_ 46 | (and (not (keyword? s)) (keyword? p) (keyword? o)) 47 | ::subject-_-_ 48 | (and (keyword? s) (keyword? p) (keyword? o)) 49 | ::_-_-_ 50 | (and (keyword? s) (not (keyword? p)) (not (keyword? o))) 51 | ::_-predicate-object 52 | (and (not (keyword? s)) (keyword? p) (not (keyword? o))) 53 | ::subject-_-object 54 | :else 55 | ::subject-predicate-object))) 56 | 57 | (defmethod query ::subject-_-_ [^String s p o] 58 | (try 59 | (with-c (:url @pg) 60 | (sql/with-query-results res 61 | [(format "SELECT * FROM %s WHERE upper_subject = ?" (:table @pg)) 62 | (.toUpperCase s)] 63 | (doall res))) 64 | (catch Exception e 65 | (throw e)))) 66 | 67 | (defmethod query ::like_subject-_-_ [s p o] 68 | (try 69 | (with-c (:url @pg) 70 | (sql/with-query-results res 71 | [(format "SELECT * FROM %s WHERE upper_subject LIKE ?" (:table @pg)) 72 | (.toUpperCase ^String (first s))] 73 | (doall res))) 74 | (catch Exception e 75 | (throw e)))) 76 | 77 | (defmethod query ::_-predicate-_ [s p o] 78 | (with-c (:url @pg) 79 | (sql/with-query-results res 80 | [(format "SELECT * FROM %s WHERE predicate = ?" (:table @pg)) p] 81 | (doall res)))) 82 | 83 | (defmethod query ::subject-predicate-object [^String s p o] 84 | (try 85 | (with-c (:url @pg) 86 | (sql/with-query-results res 87 | [(str "SELECT * FROM " 88 | (:table @pg) 89 | " WHERE " 90 | "predicate = ? AND " 91 | "upper_subject = ? AND " 92 | "object = ?") 93 | p (.toUpperCase s) o] 94 | (doall res))) 95 | (catch Exception e 96 | (throw e)))) 97 | 98 | (defmethod query ::subject-_-object [^String s p o] 99 | (try 100 | (with-c (:url @pg) 101 | (sql/with-query-results res 102 | [(str "SELECT * FROM " 103 | (:table @pg) 104 | " WHERE " 105 | "upper_subject = ? AND " 106 | "object = ?") 107 | (.toUpperCase s) o] 108 | (doall res))) 109 | (catch Exception e 110 | (throw e)))) 111 | 112 | (defmethod query ::subject-predicate-_ [^String s p o] 113 | (clojure.tools.logging/info "QUERY" s p o) 114 | (try 115 | (with-c (:url @pg) 116 | (sql/with-query-results res 117 | [(str "SELECT * FROM " 118 | (:table @pg) 119 | " WHERE " 120 | "predicate = ? AND " 121 | "upper_subject = ?") 122 | p (.toUpperCase s)] 123 | (doall res))) 124 | (catch Exception e 125 | (throw e)))) 126 | 127 | (defmethod query ::_-predicate-object [s p o] 128 | (clojure.tools.logging/info "QUERY" s p o) 129 | (with-c (:url @pg) 130 | (sql/with-query-results res 131 | [(str "SELECT * FROM " 132 | (:table @pg) 133 | " WHERE " 134 | "predicate = ? AND " 135 | "object = ?") 136 | p o] 137 | (doall res)))) 138 | 139 | (defmethod query ::_-_-object [s p o] 140 | (clojure.tools.logging/info "QUERY" s p o) 141 | (with-c (:url @pg) 142 | (sql/with-query-results res 143 | [(str "SELECT * FROM " 144 | (:table @pg) 145 | " WHERE " 146 | "object = ?") 147 | o] 148 | (doall res)))) 149 | 150 | (defmethod query ::_-_-_ [s p o] 151 | (with-c (:url @pg) 152 | (sql/with-query-results res 153 | [(str "SELECT * FROM " (:table @pg))] 154 | (doall res)))) 155 | 156 | (defn delete [s p o] 157 | (doseq [id (map :id (query s p o))] 158 | (with-c (:url @pg) 159 | (sql/delete-rows (:table @pg) ["id = ?" id])))) 160 | -------------------------------------------------------------------------------- /clojurebot-facts/src/clojurebot/triples/derby.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.triples.derby 2 | (:require [clojure.java.jdbc :as sql] 3 | [clojure.tools.logging])) 4 | 5 | (defmacro with-c [db & body] 6 | `(sql/with-connection ~db 7 | ~@body)) 8 | 9 | (defn derby [name] 10 | {:classname "org.apache.derby.jdbc.EmbeddedDriver" 11 | :create true 12 | :subname name 13 | :subprotocol "derby"}) 14 | 15 | (declare db-name) 16 | 17 | (defn create-store 18 | [name] 19 | (with-c (derby (db-name)) 20 | (sql/create-table 21 | :triples 22 | [:id :int "PRIMARY KEY" "GENERATED ALWAYS AS IDENTITY"] 23 | [:subject "varchar(32670)"] 24 | [:predicate "varchar(32670)"] 25 | [:object "varchar(32670)"] 26 | [:upper_subject "varchar(32670)"] 27 | [:created_at :timestamp "NOT NULL" "DEFAULT CURRENT_TIMESTAMP"]))) 28 | 29 | (defn store-triple [{:keys [s p o]}] 30 | (with-c (derby (db-name)) 31 | (sql/transaction 32 | (sql/insert-values 33 | :triples 34 | [:subject :predicate :object :upper_subject] 35 | [(.trim (str s)) (.trim (str p)) (.trim (str o)) 36 | (.toUpperCase (.trim (str s)))])))) 37 | 38 | (defmulti query 39 | (fn [s p o] 40 | (cond 41 | (and (list? s) (keyword? p) (keyword? o)) 42 | ::like_subject-_-_ 43 | (and (not (keyword? s)) (not (keyword? p)) (keyword? o)) 44 | ::subject-predicate-_ 45 | (and (keyword? s) (keyword? p) (not (keyword? o))) 46 | ::_-_-object 47 | (and (keyword? s) (not (keyword? p)) (keyword? o)) 48 | ::_-predicate-_ 49 | (and (not (keyword? s)) (keyword? p) (keyword? o)) 50 | ::subject-_-_ 51 | (and (keyword? s) (keyword? p) (keyword? o)) 52 | ::_-_-_ 53 | (and (keyword? s) (not (keyword? p)) (not (keyword? o))) 54 | ::_-predicate-object 55 | :else 56 | ::subject-predicate-object))) 57 | 58 | (defmethod query ::subject-_-_ [s p o] 59 | (try 60 | (with-c (derby (db-name)) 61 | (sql/with-query-results res 62 | ["SELECT * FROM triples WHERE upper_subject = ?" (.toUpperCase s)] 63 | (doall res))) 64 | (catch Exception e 65 | (println (db-name) s p o) 66 | (throw e)))) 67 | 68 | (defmethod query ::like_subject-_-_ [s p o] 69 | (try 70 | (with-c (derby (db-name)) 71 | (sql/with-query-results res 72 | ["SELECT * FROM triples WHERE upper_subject LIKE ?" 73 | (.toUpperCase (first s))] 74 | (doall res))) 75 | (catch Exception e 76 | (println (db-name) s p o) 77 | (throw e)))) 78 | 79 | (defmethod query ::_-predicate-_ [s p o] 80 | (with-c (derby (db-name)) 81 | (sql/with-query-results res 82 | ["SELECT * FROM triples WHERE predicate = ?" p] 83 | (doall res)))) 84 | 85 | (defmethod query ::subject-predicate-object [s p o] 86 | (try 87 | (with-c (derby (db-name)) 88 | (sql/with-query-results res 89 | [(str "SELECT * FROM triples WHERE " 90 | "predicate = ? AND " 91 | "upper_subject = ? AND " 92 | "object = ?") 93 | p (.toUpperCase s) o] 94 | (doall res))) 95 | (catch Exception e 96 | (println (db-name) s p o) 97 | (throw e)))) 98 | 99 | (defmethod query ::subject-predicate-_ [s p o] 100 | (clojure.tools.logging/info "QUERY" s p o) 101 | (try 102 | (with-c (derby (db-name)) 103 | (sql/with-query-results res 104 | [(str "SELECT * FROM triples WHERE " 105 | "predicate = ? AND " 106 | "upper_subject = ?") 107 | p (.toUpperCase s)] 108 | (doall res))) 109 | (catch Exception e 110 | (println (db-name) s p o) 111 | (throw e)))) 112 | 113 | (defmethod query ::_-predicate-object [s p o] 114 | (clojure.tools.logging/info "QUERY" s p o) 115 | (with-c (derby (db-name)) 116 | (sql/with-query-results res 117 | [(str "SELECT * FROM triples WHERE " 118 | "predicate = ? AND " 119 | "object = ?") 120 | p o] 121 | (doall res)))) 122 | 123 | (defmethod query ::_-_-_ [s p o] 124 | (with-c (derby (db-name)) 125 | (sql/with-query-results res 126 | ["SELECT * FROM triples"] 127 | (doall res)))) 128 | 129 | (defn delete [s p o] 130 | (doseq [id (map :id (query s p o))] 131 | (with-c (derby (db-name)) 132 | (sql/delete-rows :triples ["id = ?" id])))) 133 | 134 | (defn string [{:keys [subject predicate object]}] 135 | (if (.startsWith object "") 136 | (.trim (subs object 7)) 137 | (format "%s %s %s" subject predicate object))) 138 | 139 | (defn import-file [db file] 140 | (binding [*in* (-> file java.io.File. java.io.FileReader. 141 | java.io.PushbackReader.)] 142 | (-> (map (fn [[s o]] {:s s :o o :p "is"}) (read)) 143 | ((partial mapcat 144 | (fn [x] 145 | (if (-> x :o vector?) 146 | (map #(assoc x :o %) (:o x)) 147 | [x])))) 148 | ((partial map #(doto % prn))) 149 | ((partial map (partial store-triple db))) 150 | doall))) 151 | 152 | (defn db-name [] 153 | (let [name (or (System/getProperty "clojurebot.db") 154 | (str (System/getProperty "user.dir") 155 | "/bot.db"))] 156 | (when-not (.exists (java.io.File. name)) 157 | (create-store name)) 158 | name)) 159 | -------------------------------------------------------------------------------- /src/clojurebot/coreII.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.coreII 2 | (:use [clojurebot.eval :only [eval-message]] 3 | [conduit.core] 4 | [clojurebot.conduit :only [a-indirect a-if a-cond null a-when]] 5 | [clojure.tools.logging :only [info]] 6 | [conduit.irc :only [send-notice]]) 7 | (:require [hiredman.schedule :as sched])) 8 | 9 | (defn addressed? 10 | [{:keys [bot config message type] :as bag}] 11 | (and (or (= type :message) 12 | (= type :private-message)) 13 | (or (re-find #"^~" message) 14 | (re-find (re-pattern (str "^" (:nick config) ":")) message) 15 | (re-find (re-pattern (str "^" (:nick config) ",")) message) 16 | (nil? (:channel bag))))) 17 | 18 | (defn remove-nick-prefix-fn [message nick] 19 | (when message 20 | (let [message (.trim message)] 21 | (.trim 22 | (cond 23 | (.startsWith message (str nick ":")) 24 | (.replaceFirst message (str nick ":") "") 25 | 26 | (.startsWith message (str nick ",")) 27 | (.replaceFirst message (str nick ",") "") 28 | 29 | (.startsWith message "~") 30 | (.replaceFirst message "~" "") 31 | 32 | :else 33 | message))))) 34 | 35 | (def-arr remove-nick-prefix [bag] 36 | (prn bag) 37 | (update-in bag [:message] remove-nick-prefix-fn (:nick (:config bag)))) 38 | 39 | (defn question? [{:keys [message]}] 40 | (and message 41 | (> (count (.trim message)) 1) 42 | (= 1 (count (.split message " "))) 43 | (.endsWith message "?"))) 44 | 45 | (def-arr limit-length [x] 46 | (if (string? x) 47 | (let [out (apply str (take 400 x))] 48 | (if (> (count x) 400) 49 | (str out "...") 50 | out)) 51 | x)) 52 | 53 | 54 | (defn replace-newline [st] 55 | (apply str 56 | (for [c st] 57 | (if (= \newline c) 58 | "\\n" 59 | c)))) 60 | 61 | (def clojurebot-eval 62 | (a-comp (a-arr eval-message) 63 | (a-if vector? 64 | (a-arr 65 | (fn [[stdout stderr result]] 66 | (let [stdout (if (empty? stdout) 67 | "" 68 | (replace-newline stdout)) 69 | stderr (if (empty? stderr) 70 | "" 71 | (replace-newline stderr)) 72 | result (when (or (not= "nil" result) 73 | (empty? stdout)) 74 | (replace-newline result))] 75 | (str stdout stderr result)))) 76 | pass-through))) 77 | 78 | (def-arr reconnect [{:keys [server bot config]}] 79 | (letfn [(reconnect-fn [] 80 | (try 81 | (when-not (.isConnected bot) 82 | (info "reconnecting") 83 | (.connect bot server)) 84 | (catch Exception e 85 | (info e "Failed to reconnect") 86 | (info "retrying in 60 seconds") 87 | (Thread/sleep (* 60 1000)) 88 | reconnect-fn)))] 89 | (trampoline reconnect-fn))) 90 | 91 | (def-arr rejoin [{:keys [message bot config]}] 92 | (doseq [c (:channels config)] 93 | (.joinChannel bot c))) 94 | 95 | (def-arr nickserv-id [{:keys [bot config]}] 96 | (when (:nickserv-password config) 97 | (.sendMessage bot 98 | "nickserv" (str "identify " (:nickserv-password config))))) 99 | 100 | (defn doc-lookup? [{:keys [message]}] 101 | (and message 102 | (.startsWith message "(doc "))) 103 | 104 | (def math? (comp #(re-find #"^\([\+ / \- \*] [ 0-9]+\)" %) 105 | str 106 | :message)) 107 | 108 | (def-arr da-math [{:keys [message]}] 109 | (let [[op & num-strings] (re-seq #"[\+\/\*\-0-9]+" message) 110 | nums (map #(Integer/parseInt %) num-strings)] 111 | (let [out (-> (symbol "clojure.core" op) 112 | (find-var) 113 | (apply nums))] 114 | (if (> out 4) 115 | "*suffusion of yellow*" 116 | out)))) 117 | 118 | (def notice (a-arr (partial vector :notice))) 119 | 120 | (defmulti target first) 121 | 122 | (defmethod target :irc [[_ nick server target]] 123 | (a-arr (fn [x] 124 | (when x 125 | (doseq [line (.split x "\n")] 126 | (send-notice target line)))))) 127 | 128 | #_(defmethod target :xmpp [[_ jid-from jid-to]] 129 | (when jid-to 130 | (let [con *xmpp-connection* 131 | roster (.getRoster con) 132 | jid-to (first 133 | (map :from 134 | (map bean 135 | (iterator-seq 136 | (.getPresences 137 | roster jid-to)))))] 138 | (a-arr (fn [body] 139 | (.sendPacket con 140 | (doto (new-message) 141 | (.setTo jid-to) 142 | (.setFrom jid-from) 143 | (.setBody (str body))))))))) 144 | 145 | (defn setup-crons [config] 146 | (doseq [{:keys [task rate targets arguments]} (:cron config) 147 | :let [out (apply a-all (map target targets))]] 148 | (require (symbol (namespace task))) 149 | (info (format "scheduling cron %s %s %s %s" task rate targets arguments)) 150 | (sched/fixedrate 151 | {:task (bound-fn* #(try 152 | (info (format "ran cron %s" task)) 153 | (conduit-map out [(apply @(resolve task) arguments)]) 154 | (catch Exception e 155 | (info e (format "cron exception %s" task))))) 156 | :start-delay (rand-int 300) 157 | :rate rate 158 | :unit (:seconds sched/unit)}))) 159 | -------------------------------------------------------------------------------- /clojurebot-irc/src/clojurebot/irc.clj: -------------------------------------------------------------------------------- 1 | ;; a slight rewrite of conduit-irc 2 | (ns clojurebot.irc 3 | (:require [clj-http.client :as http] 4 | [conduit.core :refer :all] 5 | [clojure.edn :as edn] 6 | [clojure.tools.logging :as log]) 7 | (:import (java.util.concurrent LinkedBlockingQueue) 8 | (java.io Closeable) 9 | (clojure.lang IDeref 10 | Named))) 11 | 12 | (defn url [bits] 13 | (apply str (interpose \/ bits))) 14 | 15 | (def ^{:dynamic true} *pircbot* nil) 16 | 17 | (defn- reply-fn [f] 18 | (partial (fn irc-reply-fn [f value] 19 | (let [[[new-value] new-f] (f value)] 20 | [[] (partial irc-reply-fn new-f)])) 21 | f)) 22 | 23 | (defprotocol IRCBot 24 | (get-channels [b]) 25 | (join-channel [b channel]) 26 | (-send-message [b recipient line]) 27 | (-send-action [b recipient line]) 28 | (-send-notice [b recipient line])) 29 | 30 | (defn declare-joined [channel] 31 | (when-not (contains? (set (get-channels *pircbot*)) channel) 32 | (join-channel *pircbot* channel))) 33 | 34 | (defn target-type [msg recipient] 35 | (if (.startsWith recipient "#") 36 | :channel 37 | :privmsg)) 38 | 39 | (defmacro defirc [fn-name method-name] 40 | `(do 41 | (defmulti ~fn-name target-type) 42 | (defmethod ~fn-name :channel [msg# recipient#] 43 | (declare-joined recipient#) 44 | (doseq [line# (.split msg# "\n")] 45 | (~method-name *pircbot* recipient# line#))) 46 | (defmethod ~fn-name :privmsg [msg# recipient#] 47 | (doseq [line# (.split msg# "\n")] 48 | (~method-name *pircbot* recipient# line#))))) 49 | 50 | (defirc send-message -send-message) 51 | 52 | (defirc send-action -send-action) 53 | 54 | (defirc send-notice -send-notice) 55 | 56 | (defn pircbot [server nick] 57 | (let [mq (LinkedBlockingQueue.) 58 | bid (if (coll? server) 59 | (let [[server port pass] server 60 | [bid] (for [bot (edn/read-string 61 | (:body (http/get (url)))) 62 | :when (= server (:server bot)) 63 | :when (= port (:port bot)) 64 | :when (= nick (:nick bot))] 65 | (:com.thelastcitadel.irc/bid bot))] 66 | (or 67 | bid 68 | (:body (http/post (url) {:form-params {:server server 69 | :nick nick 70 | :port port 71 | :password pass}})))) 72 | (let [[bid] (for [bot (edn/read-string 73 | (:body (http/get (url)))) 74 | :when (= server (:server bot)) 75 | :when (= nick (:nick bot))] 76 | (:com.thelastcitadel.irc/bid bot))] 77 | (or bid 78 | (http/post (url) {:form-params {:server server 79 | :nick nick}})))) 80 | fut (future 81 | (while true 82 | (Thread/sleep 1000) 83 | (try 84 | (doseq [[eid event] (edn/read-string (:body (http/get (url bid "events"))))] 85 | (.put mq [nick [(:type event) event]]) 86 | (http/delete (url bid "events" bid))) 87 | (catch Exception e 88 | (log/error e "error"))))) 89 | server (if (coll? server) (first server) server) 90 | conn (reify 91 | IRCBot 92 | (get-channels [b] 93 | (edn/read-string (:body (http/get (url bid "channels"))))) 94 | (join-channel [b channel] 95 | ;; TODO: url encode channel 96 | (http/post (url bid "channel" channel))) 97 | Named 98 | (getName [_] 99 | nick) 100 | IDeref 101 | (deref [_] 102 | mq) 103 | Closeable 104 | (close [_] 105 | (try 106 | (future-cancel fut) 107 | (finally 108 | (http/delete (url bid))))))] 109 | conn)) 110 | 111 | (defn a-irc [nick proc] 112 | (let [id nick] 113 | (assoc proc 114 | :type :irc 115 | :parts (assoc (:parts proc) 116 | id {:type :irc 117 | id (reply-fn (:reply proc))})))) 118 | 119 | (defn join [channels] 120 | (doseq [channel channels] 121 | (println channel) 122 | (join-channel *pircbot* channel))) 123 | 124 | (defn irc-run 125 | "start a single thread executing a proc" 126 | [proc & [channel-or-exception-handler & channels]] 127 | (let [funs (get-in proc [:parts (name *pircbot*)])] 128 | (join 129 | (if (fn? channel-or-exception-handler) 130 | channels 131 | (conj channels channel-or-exception-handler))) 132 | (letfn [(next-msg [Q] 133 | (fn next-msg-inner [_] 134 | [[(.take Q)] next-msg-inner])) 135 | (handle-msg [fun msg] 136 | (try 137 | (let [[_ new-fn] (fun msg)] 138 | [[] (partial handle-msg new-fn)]) 139 | (catch Exception e 140 | (if (fn? channel-or-exception-handler) 141 | (channel-or-exception-handler e) 142 | (.printStackTrace e)) 143 | [[] fun]))) 144 | (run [] 145 | (->> [(next-msg @*pircbot*) 146 | (partial handle-msg (partial select-fn funs))] 147 | (reduce comp-fn) 148 | (a-run) 149 | (dorun)))] 150 | (run)))) 151 | 152 | (comment 153 | 154 | (with-open [p (pircbot "irc.freenode.net" "conduitbot11")] 155 | (binding [*pircbot* p] 156 | (irc-run 157 | (a-irc "conduitbot11" 158 | (a-arr 159 | (fn [[t m]] 160 | (println t (dissoc m :bot))))) 161 | "#clojurebot"))) 162 | 163 | ) 164 | -------------------------------------------------------------------------------- /src/clojurebot/core.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.core 2 | (:use [conduit.irc :only [irc-run a-irc *pircbot* pircbot]] 3 | [conduit.core] 4 | [clojurebot.conduit :only [a-indirect a-if a-cond null a-when]] 5 | [hiredman.clojurebot.factoids :only [factoid-lookup 6 | factoid-command? 7 | factoid-command-run 8 | factoid-lookup-no-fall-back]] 9 | [hiredman.clojurebot.ticket :only [ticket-search? 10 | search-tickets 11 | ticket-search? 12 | ticket-query? 13 | get-ticket-n 14 | contrib-ticket-query? 15 | get-contrib-ticket-n]] 16 | [hiredman.clojurebot.code-lookup :only [code-lookup? do-code-lookup]] 17 | [clojurebot.eval :only [eval-request?]] 18 | [clojure.tools.logging :only [info]] 19 | [clojurebot.seenx :only [log-user seenx-query? seen-user]] 20 | [clojurebot.dice :only [roll-some-dice dice-roll?]] 21 | [hiredman.clojurebot.google :only [google-search? google-search]] 22 | [swank.swank :only [start-repl]] 23 | [clojurebot.epigrams :only [epigram-query? lookup-epigram]] 24 | [clojurebot.coreII :only [addressed? remove-nick-prefix question? 25 | limit-length clojurebot-eval reconnect 26 | rejoin nickserv-id doc-lookup? math? da-math 27 | notice target setup-crons]] 28 | [clojurebot.plugin :only [load-from]] 29 | [hiredman.clojurebot.simplyscala :only [scala-eval]] 30 | [compojure.core :only [defroutes GET]] 31 | [ring.adapter.jetty :only [run-jetty]] 32 | [com.thelastcitadel.apropos :only [apropos]]) 33 | (:require [clojure.tools.logging :as log])) 34 | 35 | (defn comic? [m] 36 | (when-let [v (resolve 'clojurebot.phil/comic?)] 37 | (v m))) 38 | 39 | ;; pipelines 40 | ;; addressed pipelines are run when a message has been determined to 41 | ;; have been addressed specificly at the bot 42 | (def addressed-pipeline 43 | (a-comp remove-nick-prefix 44 | ;; stupid implemention looking for config defined 45 | ;; addressed-plugins ends up search through the list twice 46 | (a-all (a-arr 47 | (fn [{:keys [config] :as a-map}] 48 | (log/info "here") 49 | ((comp boolean first filter) 50 | (fn [[ns query action]] 51 | (when-let [query (ns-resolve ns query)] 52 | (query a-map))) 53 | (:addressed-plugins config)))) 54 | pass-through) 55 | (a-select 56 | true (a-arr 57 | (fn [{:keys [config] :as a-map}] 58 | (log/info "here2") 59 | (let [[ns query action] ((comp first filter) 60 | (fn [[ns query action]] 61 | (let [query (ns-resolve 62 | ns query)] 63 | (log/info ns) 64 | (log/info "query" query) 65 | (when query 66 | (query a-map)))) 67 | (:addressed-plugins config))] 68 | (log/info "action" action) 69 | (@(ns-resolve ns action) a-map)))) 70 | false (a-cond comic? 71 | (a-arr (fn [m] 72 | (when-let [v (resolve 'clojurebot.phil/lookup-comic)] 73 | (v m)))) 74 | 75 | (fn [{:keys [message] :as m}] 76 | (when message 77 | (.startsWith message "apropos "))) 78 | (a-arr (fn [{:keys [message]}] 79 | (try 80 | (apropos (.replaceFirst message "apropos " "")) 81 | (catch Throwable _ 82 | "dunno")))) 83 | 84 | ticket-query? 85 | (a-arr get-ticket-n) 86 | 87 | contrib-ticket-query? 88 | (a-arr get-contrib-ticket-n) 89 | 90 | ticket-search? 91 | (a-arr search-tickets) 92 | 93 | code-lookup? 94 | (a-comp (a-arr do-code-lookup) 95 | notice) 96 | 97 | google-search? 98 | (a-arr google-search) 99 | 100 | seenx-query? 101 | (a-arr seen-user) 102 | 103 | epigram-query? 104 | (a-arr lookup-epigram) 105 | 106 | factoid-command? 107 | (a-arr factoid-command-run) 108 | 109 | (constantly true) 110 | (a-arr factoid-lookup) 111 | 112 | 113 | )))) 114 | 115 | (def pipeline 116 | (a-except 117 | (a-comp 118 | (a-all 119 | (a-arr log-user) ;enable "~seen foo" stuff 120 | 121 | ;; run logging plugins 122 | (a-arr (fn [{:keys [config] :as msg}] 123 | (doseq [name (:logging-plugins config)] 124 | (try 125 | ((resolve name) msg) 126 | (catch Exception e 127 | (log/error e "error running logging plugin")))))) 128 | pass-through) 129 | 130 | (a-arr last) ;we only want the passed through value 131 | 132 | (a-cond doc-lookup? 133 | (a-comp (a-arr 134 | #(update-in % [:message] (fn [x] (str "," x)))) 135 | clojurebot-eval) 136 | 137 | math? 138 | da-math 139 | 140 | (fn [{:keys [message]}] 141 | (and message (.startsWith message ",scala"))) 142 | (a-arr (fn [{:keys [message]}] 143 | (scala-eval (.replaceFirst message ",scala" "")))) 144 | 145 | eval-request? 146 | (a-comp (a-arr (fn [x] 147 | (info (format "evaling %s for %s" 148 | (:message x) 149 | (:sender x))) 150 | x)) 151 | clojurebot-eval 152 | limit-length) 153 | 154 | dice-roll? 155 | (a-arr roll-some-dice) 156 | 157 | addressed? 158 | addressed-pipeline 159 | 160 | question? ;ping? => PONG! 161 | (a-comp (a-arr factoid-lookup-no-fall-back) 162 | (a-if nil? 163 | null 164 | pass-through)) 165 | 166 | #(and (= 1 (rand-int 1000)) 167 | (= (:type %) :message)) 168 | addressed-pipeline 169 | 170 | (comp (partial = :disconnect) :type) 171 | reconnect 172 | 173 | (comp (partial = :connect) :type) 174 | (a-all nickserv-id 175 | rejoin) 176 | 177 | (comp (partial = :invite) :type) 178 | (a-comp (a-arr (fn [{:keys [bot channel config]}] 179 | (when (:on-invite config) 180 | (.joinChannel bot (last (.split channel " ")))))) 181 | null) 182 | 183 | (constantly true) 184 | (a-comp (a-arr #(dissoc % :config :bot)) 185 | null) 186 | )) 187 | (a-arr (comp #(log/error % "error") first)))) 188 | 189 | ;;/pipelines 190 | 191 | (defn clojurebot [config] 192 | (a-irc 193 | (:nick config) 194 | (a-comp 195 | (a-arr (fn [[type bag]] 196 | (assoc bag 197 | :type type 198 | :config config 199 | :time (System/currentTimeMillis)))) 200 | (a-indirect #'pipeline)))) 201 | 202 | (defn set-properties! [] 203 | (when (empty? (System/getProperty "java.security.policy")) 204 | (System/setProperty 205 | "java.security.policy" 206 | (str (.getResource (class clojurebot) "/example.policy")))) 207 | (System/setProperty "file.encoding" "utf8") 208 | (System/setProperty "swank.encoding" "utf8")) 209 | 210 | (defn load-plugins [config] 211 | (load-from (:plugin-directory config) 212 | (concat (map first (:addressed-plugins config)) 213 | (->> (:cron config) 214 | (map :task) 215 | (map namespace) 216 | (map symbol)) 217 | (map (comp symbol namespace) (:logging-plugins config))))) 218 | 219 | (defn start-swank [config] 220 | (when (:swank config) 221 | (future 222 | (start-repl (:swank config))))) 223 | 224 | (def l (atom {})) 225 | 226 | (defroutes cb 227 | (GET "/befuddled" [] 228 | {:status 200 229 | :headers {"Content-Type" "application/edn; charset=utf-8"} 230 | :body (let [x (hiredman.clojurebot.core/befuddled)] 231 | (log/debug "/befuddled ·" x) 232 | (pr-str x))}) 233 | (GET "/ok" [] 234 | {:status 200 235 | :headers {"Content-Type" "application/edn; charset=utf-8"} 236 | :body (pr-str (hiredman.clojurebot.core/ok))}) 237 | (GET "/randomperson/:id" [id] 238 | {:status 200 239 | :headers {"Content-Type" "application/edn; charset=utf-8"} 240 | :body (pr-str (hiredman.clojurebot.core/random-person (get @l id)))}) 241 | ) 242 | 243 | (defn -main [& [config-file]] 244 | (set-properties!) 245 | (let [config (read-string (slurp config-file)) 246 | crons (delay (setup-crons config))] 247 | ;; load the namespaces for different kinds of plugins 248 | (when (:plugin-directory config) 249 | (load-plugins config)) 250 | (binding [*ns* (create-ns 'sandbox)] 251 | (refer 'clojure.core)) 252 | (start-swank config) 253 | (run-jetty #'cb 254 | {:port 3205 255 | :join? false}) 256 | ;; for each server run irc-run 257 | (doseq [[server channels] (:irc config)] 258 | (let [out *out* 259 | config (assoc config 260 | :server server 261 | :channels channels) 262 | p (pircbot (:server config) (:nick config))] 263 | (dotimes [_ (:threads config)] 264 | (future 265 | (binding [*out* out 266 | *pircbot* p] 267 | (try 268 | @crons 269 | (apply irc-run 270 | (clojurebot config) 271 | channels) 272 | (catch Exception e 273 | (info e "Connection failed")))))))) 274 | @(promise))) 275 | -------------------------------------------------------------------------------- /clojurebot-facts/src/clojurebot/factoids.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.factoids 2 | (:require [clojurebot.triples :as trip] 3 | [clojure.java.io :as io] 4 | [name.choi.joshua.fnparse :as fp] 5 | [opennlp.nlp :as nlp] 6 | [clj-http.client :as http] 7 | [clojure.tools.logging :as log] 8 | [clojurebot.infer])) 9 | 10 | (def ^:dynamic *id*) 11 | 12 | ;;BEGIN GARBAGE 13 | (defmacro string [str] (cons 'fp/conc (map #(list 'fp/lit %) str))) 14 | 15 | (def literal (string "literal")) ;literally the string "literal" 16 | 17 | (def spaces (fp/semantics (fp/rep* (fp/lit \space)) first)) ;collapses spaces 18 | 19 | (def number 20 | (fp/semantics 21 | (fp/rep+ 22 | (fp/term (set (map (comp first str) (range 10))))) 23 | #(Integer/parseInt (apply str %)))) 24 | 25 | (def character (fp/term #(instance? Character %))) ;any character 26 | 27 | (def text (fp/rep+ (fp/except 28 | (fp/alt character 29 | (fp/conc character 30 | (fp/lit \?) 31 | character)) 32 | (fp/lit \?)))) 33 | 34 | ;;(def escaped-is (fp/followed-by (fp/lit (char 92)) (string "is"))) ;\is 35 | 36 | (def escaped-is (fp/conc (fp/lit (char 92)) (string "is"))) 37 | 38 | (def term 39 | (fp/rep+ (fp/except character (fp/except (string " is ") escaped-is)))) 40 | ;;a bunch of characters up to the first not escaped is 41 | 42 | (def definition 43 | (fp/semantics 44 | (fp/conc term (string " is ") text) 45 | (fn [[term _ defi]] 46 | (vary-meta {:term (.trim (apply str term)) 47 | :definition (.trim (apply str defi))} 48 | assoc :type :def)))) 49 | 50 | (def definition-add 51 | (fp/semantics 52 | (fp/conc term (string " is ") (string "also") (fp/lit \space) text) 53 | (fn [[term _ _ _ defi]] 54 | (vary-meta {:term (apply str term) 55 | :definition (apply str defi)} assoc :type :def)))) 56 | 57 | (def indexed-lookup 58 | (fp/semantics 59 | (fp/conc literal 60 | spaces 61 | (fp/lit \[) 62 | number 63 | (fp/lit \]) 64 | spaces 65 | (fp/semantics text (partial apply str))) 66 | (fn [[_ _ _ number _ _ term]] 67 | (vary-meta {:number number :term term} assoc :type :indexed-look-up)))) 68 | 69 | (def index-count 70 | (fp/semantics 71 | (fp/conc literal 72 | spaces 73 | (fp/lit \[) 74 | (fp/lit \?) 75 | (fp/lit \]) 76 | spaces 77 | (fp/semantics text (partial apply str))) 78 | (fn [[_ _ _ number _ _ term]] 79 | (vary-meta {:term term} assoc :type :count)))) 80 | 81 | (def index (fp/alt index-count indexed-lookup)) 82 | 83 | (def predicate 84 | (fp/semantics 85 | (fp/conc (fp/lit \|) 86 | (fp/rep+ (fp/except character (fp/lit \|))) (fp/conc (fp/lit \|))) 87 | (fn [[_ pred _]] (.trim (apply str pred))))) 88 | 89 | (def subject (fp/semantics (fp/rep+ (fp/except character (fp/lit \|))) 90 | (fn [d] (.trim (apply str d))))) 91 | 92 | (def object (fp/semantics (fp/rep+ character) 93 | (fn [o] (.trim (apply str o))))) 94 | 95 | (def predicate-style-definition 96 | (fp/semantics (fp/conc subject predicate object) 97 | (fn [[subject predicate object]] 98 | #^{:type :predicate-style-definition} 99 | {:subject subject :object object :predicate predicate}))) 100 | 101 | (def forget 102 | (fp/semantics (fp/conc (string "forget ") predicate-style-definition) 103 | (fn [[_ o]] 104 | (with-meta o {:type :forget})))) 105 | 106 | ;;END GARBAGE 107 | 108 | ;;parse a string into some kind of factoid related something or other 109 | ;;takes arguments in the style of fnparse {:remainder (seq some-string)} 110 | (def factoid-command 111 | (fp/alt index-count 112 | indexed-lookup 113 | forget 114 | definition-add 115 | definition 116 | predicate-style-definition)) 117 | 118 | ;;this should be ditched 119 | (defn simple-lookup [term] 120 | #_(@core/dict-is term)) 121 | 122 | (defmulti factoid-command-processor (comp type second list) :default :boom) 123 | 124 | (defn befuddled [] 125 | (let [{:keys [body]} (http/get "http://localhost:3205/befuddled")] 126 | (read-string body))) 127 | 128 | (defmethod factoid-command-processor :boom [_ bag] 129 | (befuddled)) 130 | 131 | (defmethod factoid-command-processor :count [_ bag] 132 | (let [defi (simple-lookup (:term bag))] 133 | (cond 134 | (nil? defi) 135 | 0 136 | (vector? defi) 137 | (count defi) 138 | :else 139 | 1))) 140 | 141 | ;;this too 142 | (defmethod factoid-command-processor :indexed-look-up [_ bag] 143 | (let [defi (simple-lookup (:term bag))] 144 | (cond 145 | (nil? defi) 146 | "nothing defined" 147 | (and (vector? defi) (> (count defi) (:number bag))) 148 | (defi (:number bag)) 149 | (vector? defi) 150 | (str (:number bag) " is out of range") 151 | (zero? (:number bag)) 152 | defi 153 | :else 154 | (befuddled)))) 155 | 156 | (defmethod factoid-command-processor :def [_ bag] 157 | (trip/store-triple 158 | {:s (:term bag) :o (:definition bag) :p "is"}) 159 | (let [{:keys [body]} (http/get "http://localhost:3205/ok")] 160 | (read-string body))) 161 | 162 | (defmethod factoid-command-processor :predicate-style-definition [_ bag] 163 | (trip/store-triple 164 | {:s (:subject bag) :o (:object bag) :p (:predicate bag)}) 165 | (let [{:keys [body]} (http/get "http://localhost:3205/ok")] 166 | (read-string body))) 167 | 168 | (defmethod factoid-command-processor :forget [_ bag] 169 | (trip/delete (:subject bag) (:predicate bag) (:object bag)) 170 | (format "I forgot that %s %s %s" 171 | (:subject bag) 172 | (:predicate bag) 173 | (:object bag))) 174 | 175 | ;;(defmethod factoid-command-processor :def-add [bag] 176 | ;; (trip/store-triple (trip/derby (db-name (:bot (meta bag)))) {:s (:term bag) :o (:definition bag) :p "is"}) 177 | ;; (core/new-send-out (:bot (meta bag)) :msg (:message (meta bag)) (core/ok))) 178 | 179 | 180 | (defn factoid-command? [{:keys [message]}] 181 | (and (not (.endsWith message "?")) 182 | (factoid-command {:remainder (seq message)}))) 183 | 184 | (defn factoid-command-run [{:keys [_ message]}] 185 | (println "@factoid-command-run" message) 186 | (factoid-command-processor 187 | _ 188 | (first 189 | (factoid-command 190 | {:remainder (seq message)})))) 191 | 192 | 193 | ;;(core/remove-dispatch-hook ::factoids) 194 | ;;(hiredman.triples/import-file 195 | ;; (hiredman.triples/derby (db-name bot)) (str 196 | ;; (hiredman.clojurebot.core/dict-file bot ".is"))) 197 | 198 | (defn replace-with [str map] 199 | (reduce #(.replaceAll % (first %2) (second %2)) str map)) 200 | 201 | (defn remove-from-beginning 202 | "return a string with the concatenation of the given chunks removed if it is 203 | found at the start of the string" 204 | [string & chunks] 205 | (.replaceFirst string (apply str "^" chunks) "")) 206 | 207 | (defn prep-reply 208 | "preps a reply, does substituion of stuff like and #who" 209 | [sender term pred defi bot] 210 | (let [{:keys [body]} (http/get (str "http://localhost:3205/randomperson/" *id*))] 211 | (replace-with 212 | (if (or (re-find #"^" defi) 213 | (re-find #"^" defi)) 214 | (.trim 215 | (remove-from-beginning 216 | (remove-from-beginning (str defi) "") 217 | "")) 218 | (format "%s %s %s" term pred defi)) 219 | {"#who" sender "#someone" (read-string body)}))) 220 | 221 | 222 | (defmulti #^{:doc "" :private true} 223 | befuddled-or-pick-random (comp empty? first list)) 224 | 225 | (def infered-results (atom ())) 226 | 227 | (defmethod befuddled-or-pick-random false [x bag] 228 | (-> x 229 | ((fn [x] 230 | (let [r (x (rand-int (count x)))] 231 | (if (and (:infered? r) 232 | (zero? (rand-int 2))) 233 | (recur x) 234 | r)))) 235 | ((fn [{:keys [subject object predicate infered?] :as relationship}] 236 | (clojure.tools.logging/info "CHOSEN" relationship) 237 | (when infered? 238 | (swap! infered-results 239 | (fn [db record] 240 | (if (> (count db) 10) 241 | (recur (rest db) record) 242 | (conj db record))) 243 | [(System/currentTimeMillis) (:channel bag) relationship])) 244 | (prep-reply (:sender bag) 245 | subject 246 | predicate 247 | object 248 | (:bot bag)))))) 249 | 250 | (defmethod befuddled-or-pick-random true [x bag] 251 | (log/info *id* x bag) 252 | (befuddled)) 253 | 254 | (defn mutli-query [_ pos form] 255 | (with-meta ((partial mapcat 256 | #(trip/query 257 | (list (format form %)) :z :y)) pos) 258 | (meta pos))) 259 | 260 | (def get-sentences 261 | (delay 262 | (with-open [s (.openStream (io/resource "en-sent.bin"))] 263 | (nlp/make-sentence-detector s)))) 264 | 265 | (def tokenize 266 | (delay 267 | (with-open [s (.openStream (io/resource "en-token.bin"))] 268 | (nlp/make-tokenizer s)))) 269 | 270 | (def pos-tag 271 | (delay 272 | (with-open [s (.openStream (io/resource "en-pos-maxent.bin"))] 273 | (nlp/make-pos-tagger s)))) 274 | 275 | (defn tag [x] 276 | (@pos-tag 277 | (@tokenize x))) 278 | 279 | (def noun-filter 280 | (comp 281 | (partial map first) 282 | (partial filter #(.startsWith (second %) "N")))) 283 | 284 | (defn search-term [thing] 285 | (:object thing)) 286 | 287 | (defn be [word] 288 | (if (.endsWith word "s") 289 | "are" 290 | "is")) 291 | 292 | (defmacro tl [n & body] 293 | `(let [now# (System/nanoTime)] 294 | (try 295 | ~@body 296 | (finally 297 | (clojure.tools.logging/info ~(str "Elapsed " n " time:") 298 | (/ (double (- (System/nanoTime) now#)) 299 | 1000000.0) 300 | "msecs"))))) 301 | 302 | (defn qw [input _] 303 | (tl 304 | :qw 305 | (->> (clojurebot.infer/respondo input) 306 | (group-by (juxt :subject :predicate :object)) 307 | (map (fn [[k v]] 308 | (let [{known false infered true} (group-by :infered? v)] 309 | (first (concat known infered)))))))) 310 | 311 | (defn factoid-lookup [{:keys [message] :as bag}] 312 | (-> (.replaceAll (.trim message) "\\?$" "") 313 | ((fn [thing] 314 | (when (= "botsnack" thing) 315 | (let [now (System/currentTimeMillis)] 316 | (doseq [[ts chan fact] @infered-results 317 | :when (= chan (:channel bag)) 318 | :when (> (+ ts (* 1000 60 2)) 319 | now)] 320 | (future 321 | (trip/store-triple 322 | {:s (:subject fact) 323 | :o (:object fact) 324 | :p (:predicate fact)}) 325 | (swap! 326 | infered-results 327 | (partial remove 328 | #(= (select-keys 329 | % [:object :predicate :subject]) 330 | (select-keys 331 | fact [:object :predicate :subject])))))))) 332 | thing)) 333 | (qw nil) 334 | vec 335 | (befuddled-or-pick-random bag))) 336 | 337 | (defn factoid-lookup-no-fall-back [{:keys [message] :as bag}] 338 | (let [x (-> (.replaceAll (.trim message) "\\?$" "") 339 | (qw nil) 340 | vec)] 341 | (if (empty? x) 342 | nil 343 | (let [{:keys [subject predicate object infered?] :as relationship} 344 | (first (shuffle x))] 345 | (clojure.tools.logging/info "CHOSEN" relationship) 346 | (when infered? 347 | (swap! infered-results 348 | (fn [db record] 349 | (if (> (count db) 10) 350 | (recur (rest db) record) 351 | (conj db record))) 352 | [(System/currentTimeMillis) (:channel bag) relationship])) 353 | (prep-reply (:sender bag) 354 | subject 355 | predicate 356 | object 357 | (:bot bag)))))) 358 | -------------------------------------------------------------------------------- /clojurebot-eval/src/clojurebot/sandbox.clj: -------------------------------------------------------------------------------- 1 | (ns clojurebot.sandbox 2 | (:use [clojure.tools.logging :only [info]]) 3 | (:require [carica.core :refer [config]]) 4 | (:import (java.util.concurrent FutureTask TimeUnit TimeoutException) 5 | (java.io File FileWriter PushbackReader StringReader))) 6 | 7 | (def *bad-forms* 8 | #{'alter-var-root 9 | 'alterRoot 10 | 'intern 11 | 'eval 12 | 'def 13 | 'catch 14 | 'load-string 15 | 'load-reader 16 | 'clojure.core/addMethod 17 | 'hiredman.clojurebot/bot}) 18 | 19 | (def default-timeout 10) ; in seconds 20 | 21 | (definterface Door 22 | (lock [pw]) 23 | (unlock [pw]) 24 | (isLocked [])) 25 | 26 | (defmacro defering-security-manager [sm door-key & [m]] 27 | (let [sm-name (gensym 'sm) 28 | methods (for [[method-name methods] 29 | (group-by #(.getName %) 30 | (.getDeclaredMethods SecurityManager)) 31 | :when (.startsWith method-name "check") 32 | :let [methods (filter 33 | #(java.lang.reflect.Modifier/isPublic 34 | (.getModifiers %)) 35 | methods)]] 36 | (if (contains? m method-name) 37 | (get m method-name) 38 | `(~(symbol method-name) 39 | ~@(for [[argc [method]] (group-by 40 | #(count (.getParameterTypes %)) 41 | methods) 42 | :let [args (vec (map-indexed 43 | (comp symbol str) 44 | (take argc (repeat "arg"))))]] 45 | `(~args 46 | (when (.isLocked ~'this) 47 | (println ~method-name ~@args) 48 | (throw (java.lang.SecurityException. 49 | "denied"))))))))] 50 | `(let [~sm-name ~sm 51 | ~'b (proxy [java.lang.InheritableThreadLocal] [] 52 | (initialValue [] 53 | false))] 54 | (proxy [SecurityManager Door] [] 55 | ~@methods 56 | (isLocked [] 57 | (.get ~'b)) 58 | (lock [pw#] 59 | (when (= pw# ~door-key) 60 | (.set ~'b true))) 61 | (unlock [pw#] 62 | (when (= pw# ~door-key) 63 | (.set ~'b false))))))) 64 | 65 | (defn enable-security-manager [k] 66 | (info "enable-security-manager") 67 | (System/setSecurityManager 68 | (let [sm (SecurityManager.) 69 | m (defering-security-manager sm k 70 | {"checkPackageAccess" 71 | (checkPackageAccess [package]) 72 | "checkMemberAccess" 73 | (checkMemberAccess 74 | [class member] 75 | (when (.isLocked ^Door this) 76 | (when (= class Runtime) 77 | (throw (java.lang.SecurityException. 78 | "Reference To Runtime is not allowed"))) 79 | (when (= class java.security.PrivilegedAction) 80 | (throw (java.lang.SecurityException. 81 | "Reference to PrivilegedActions is not allowed"))))) 82 | "checkCreateClassLoader" 83 | (checkCreateClassLoader []) 84 | "checkPermission" 85 | (checkPermission 86 | [p] 87 | (when (.isLocked ^Door this) 88 | (if (instance? java.lang.reflect.ReflectPermission p) 89 | nil 90 | (proxy-super checkPermission p)))) 91 | "checkAccess" 92 | (checkAccess 93 | [t-or-tg] 94 | (when (.isLocked ^Door this) 95 | (throw (java.lang.SecurityException. "no threads please"))))})] 96 | m))) 97 | 98 | 99 | 100 | ;;;;;;;; Chousuke 101 | (defn thunk-timeout [thunk seconds] 102 | (let [task (FutureTask. thunk) 103 | thr (Thread. task)] 104 | (try 105 | (.start thr) 106 | (.get task seconds TimeUnit/SECONDS) 107 | (catch TimeoutException e 108 | (.cancel task true) 109 | (.stop thr (Exception. "Thread stopped!")) 110 | (pr-str "Execution Timed Out"))))) 111 | 112 | (defn wrap-exceptions 113 | ([f] 114 | (wrap-exceptions f #(do 115 | (.printStackTrace %) 116 | (.getMessage %)))) 117 | ([f exception-handler] 118 | (try (f) (catch Exception e (exception-handler e))))) 119 | ;;;;;;;;;;; 120 | 121 | (defn empty-perms-list [] 122 | (java.security.Permissions.)) 123 | 124 | (defn domain [perms] 125 | (java.security.ProtectionDomain. 126 | (java.security.CodeSource. 127 | nil 128 | (cast java.security.cert.Certificate nil)) 129 | perms)) 130 | 131 | (defn context [dom] 132 | (java.security.AccessControlContext. 133 | (into-array [dom]))) 134 | 135 | (defn priv-action [thunk] 136 | (reify java.security.PrivilegedAction 137 | (run [_] (thunk)))) 138 | 139 | (defn sandbox [thunk context] 140 | (java.security.AccessController/doPrivileged 141 | (priv-action thunk) 142 | context)) 143 | 144 | (defn write-test [] 145 | (doto (-> "foo.txt" File. FileWriter.) (.write "foo") .close)) 146 | 147 | (defn de-fang 148 | "looks through the macroexpand of a form for things I don't allow" 149 | [form notallowed] 150 | (if (coll? form) 151 | (when (not 152 | (some notallowed 153 | (tree-seq coll? 154 | #(let [a (macroexpand %)] 155 | (if (coll? a) 156 | (seq a) 157 | (list a))) 158 | form))) 159 | form) 160 | form)) 161 | 162 | (defn cond-eval [pred form] 163 | (if (pred form) 164 | (eval form) 165 | (throw (java.lang.Exception. "DENIED")))) 166 | 167 | (defn killall-thrdgrp [thg] 168 | (let [a (make-array Thread (.activeCount thg)) 169 | _ (.enumerate thg a true)] 170 | (map #(.stop % (Exception. "KILLED"))) 171 | (.destroy thg))) 172 | 173 | (defn save-to-gensym [x] 174 | (let [a (gensym) 175 | b (list 'def a x)] 176 | (eval b) 177 | (str a))) 178 | 179 | (defn my-doc [befuddled] 180 | (let [arg-name (gensym)] 181 | (list 'defmacro 'my-doc [arg-name] 182 | `(let [m# (meta (resolve ~arg-name)) 183 | al# (:arglists m#) 184 | docstring# (:doc m#)] 185 | (if m# 186 | (.replaceAll (str al# "; " docstring# ) "\\s+" " ") 187 | ''~befuddled))))) 188 | 189 | (defn force-lazy-seq 190 | "if passed a lazy seq, forces seq with doall, if not return what is passed" 191 | [s] 192 | (or (and (instance? clojure.lang.LazySeq s) (doall s)) s)) 193 | 194 | (defn eval-in-box-helper [form {:keys [print-length print-level]}] 195 | (let [result (cond-eval #(de-fang % *bad-forms*) form)] 196 | (.close *out*) 197 | (.close *err*) 198 | (binding [*print-length* print-length 199 | *print-level* print-level] 200 | (let [r (prn-str (force-lazy-seq result)) 201 | o (print-str (.toString *out*)) 202 | e (print-str (.toString *err*))] 203 | [o e (when (or result (.equals o "")) r)])))) 204 | 205 | (defn call-method 206 | "Calls a private or protected method. 207 | 208 | params is a vector of classes which correspond to the arguments to 209 | the method e 210 | 211 | obj is nil for static methods, the instance object otherwise. 212 | 213 | The method-name is given a symbol or a keyword (something Named)." 214 | [klass method-name params obj & args] 215 | (-> klass (.getDeclaredMethod (name method-name) 216 | (into-array Class params)) 217 | (.invoke obj (into-array Object args)))) 218 | 219 | 220 | (defprotocol Evaluator 221 | (evil [evaluator form])) 222 | 223 | (extend-type ClassLoader 224 | Evaluator 225 | (evil [cl form-str] 226 | (read-string 227 | (let [old-cl (.getContextClassLoader (Thread/currentThread))] 228 | (try 229 | (.setContextClassLoader (Thread/currentThread) cl) 230 | (let [rt (.loadClass cl "clojure.lang.RT") 231 | compiler (.loadClass cl "clojure.lang.Compiler") 232 | var- (fn [s] 233 | (call-method 234 | rt :var [String String] nil (namespace s) (name s))) 235 | class (fn [x] (.loadClass cl (name x))) 236 | deref (fn [x] (call-method (.getClass x) :deref [] x)) 237 | invoke (fn [x & args] (call-method (.getClass x) :invoke [])) 238 | read-string (fn [s] 239 | (call-method rt :readString [String] nil s)) 240 | eval (fn [f] 241 | (call-method compiler :eval [Object] nil f))] 242 | (thunk-timeout 243 | (fn [] 244 | (sandbox #(eval (read-string (format "(pr-str %s)" form-str))) 245 | (context (domain (empty-perms-list))))) 246 | default-timeout)) 247 | (finally 248 | (.setContextClassLoader (Thread/currentThread) old-cl))))))) 249 | 250 | (defn eval-in-box [_string sb-ns class-loader n befuddled] 251 | (enable-security-manager n) 252 | (let [f `(do 253 | (with-open [o# (java.io.StringWriter.) 254 | e# (java.io.StringWriter.)] 255 | (binding [*out* o# 256 | *err* e# 257 | *read-eval* false 258 | *print-level* 10 259 | *print-length* 5 260 | *ns* (find-ns 'clojure.core)] 261 | ~(my-doc befuddled) 262 | (ns ~sb-ns 263 | (:use [clojure.repl])) 264 | (alter-var-root (resolve '~'doc) 265 | (constantly (resolve '~'my-doc))) 266 | (.lock (System/getSecurityManager) ~n) 267 | (try 268 | (let [f# (read-string ~_string) 269 | good?# (if (and (coll? f#) 270 | (not (empty? f#))) 271 | (when (not 272 | (some '~*bad-forms* 273 | (tree-seq coll? 274 | (fn [i#] 275 | (let [a# (macroexpand 276 | i#)] 277 | (if (coll? a#) 278 | (seq a#) 279 | (list a#)))) 280 | f#))) 281 | f#) 282 | true) 283 | r# (pr-str (try 284 | (when-not good?# 285 | (throw (Exception. "SANBOX DENIED"))) 286 | (eval f#) 287 | (catch Throwable t# 288 | t#)))] 289 | [(.toString (doto o# .close)) 290 | (.toString (doto e# .close)) 291 | r#]) 292 | (finally 293 | (.unlock (System/getSecurityManager) ~n)))))) 294 | thunk (fn [] (evil class-loader f))] 295 | (thunk))) 296 | 297 | 298 | (let [cl-cache (atom {})] 299 | (defn cl [clojure-jar] 300 | (if-let [[ctime cl] (get @cl-cache clojure-jar)] 301 | (if (> (- (System/currentTimeMillis) 302 | (* 10 60 1000)) 303 | ctime) 304 | (do 305 | (swap! cl-cache dissoc clojure-jar) 306 | (recur clojure-jar)) 307 | cl) 308 | (doto (if clojure-jar 309 | (java.security.AccessController/doPrivileged 310 | (reify 311 | java.security.PrivilegedAction 312 | (run [_] 313 | (info "new classloader") 314 | (let [bootcp clojure-jar 315 | cp (.split bootcp ":") 316 | cp (for [c cp] (java.net.URL. 317 | (format "file://%s" c))) 318 | cp (into-array java.net.URL cp)] 319 | (java.net.URLClassLoader. cp nil))))) 320 | (.getClassLoader clojure.lang.RT)) 321 | ;; make sure RT is loaded and inited before we try and use it 322 | ;; in the sandbox 323 | ((fn [cl] 324 | (java.security.AccessController/doPrivileged 325 | (reify 326 | java.security.PrivilegedAction 327 | (run [_] 328 | (try 329 | (evil cl "(+ 1 2)") 330 | (catch Exception e 331 | (swap! cl-cache dissoc clojure-jar) 332 | (throw e)))))))) 333 | ((fn [cl] 334 | (swap! cl-cache assoc clojure-jar 335 | [(System/currentTimeMillis) cl]))))))) 336 | 337 | (defn naughty-forms? [strang] 338 | (let [nf #{"catch" "finally" "clojure.asm" "hiredman.clojurebot" 339 | "java.lang.Thread."}] 340 | (some #(not= -1 %) (map #(.lastIndexOf strang %) nf)))) 341 | 342 | (defn eval-request? [{:keys [message]}] 343 | (and message (re-find #"^," (.trim message)))) 344 | 345 | (let [n (str (java.util.UUID/randomUUID))] 346 | (defn eval-message [expression befuddled] 347 | (let [result (eval-in-box expression 348 | (or (config :sandbox-ns) 'sandbox) 349 | (cl (config :clojure-jar)) 350 | n 351 | befuddled)] 352 | (if (vector? result) 353 | result 354 | (.replace (str result) "(NO_SOURCE_FILE:0)" ""))))) 355 | -------------------------------------------------------------------------------- /src/hiredman/clojurebot/core.clj: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Thus spake the master programmer: 3 | ;; "Though a program be but three lines long, someday it will have to be 4 | ;; maintained." 5 | ;; 6 | ;; 7 | ;;java -server -ms16m -mx64m -Xss128m 8 | 9 | (ns hiredman.clojurebot.core 10 | (:require [hiredman.pqueue :as pq] 11 | [hiredman.schedule :as sched] 12 | [hiredman.utilities :as util] 13 | [hiredman.words :as w]) 14 | (:import (org.jibble.pircbot PircBot) 15 | (java.util Date Timer TimerTask) 16 | (java.util.concurrent ScheduledThreadPoolExecutor TimeUnit) 17 | (java.util.logging Logger))) 18 | 19 | (defonce start-date (Date.)) 20 | 21 | (defonce task-runner sched/task-runner) 22 | 23 | ;; dictionaries for storing relationships 24 | ;; 'are' dict is not used right now. 25 | (defonce dict-is (ref {})) 26 | (defonce dict-are (ref {})) 27 | 28 | ;; this struct is used to pass around messages 29 | (defstruct junks :channel :sender :login :hostname :message) 30 | 31 | (def logger (Logger/getLogger "clojurebot")) 32 | 33 | (declare addressed? *bots*) 34 | 35 | (defn log [x] 36 | (.info logger (pr-str x))) 37 | 38 | (defn randth 39 | "random item from sequence" 40 | [se] 41 | (let [s (seq se)] 42 | (first (drop (rand-int (count se)) se)))) 43 | 44 | ;; responses that can be randomly selected from 45 | (defonce 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!" "A nod, you know, is as good as a wink to a blind horse."]) 46 | 47 | (defonce 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." "Cool story bro."]) 48 | 49 | (defn ok 50 | "random input-accepted sort of string" 51 | [] 52 | (randth input-accepted)) 53 | 54 | (defn befuddled 55 | "random \"Huh?\" sort of string" 56 | [] 57 | (randth befuddl)) 58 | 59 | (defn inits "again I blame Chouser" [[f & r :as c]] 60 | (when c (lazy-cat (map #(conj % f) 61 | (inits r)) (inits r) [(list f)]))) 62 | 63 | (defn strip-is 64 | "return a string with everything up to the end of the 65 | first \"is\" removed" 66 | [string] 67 | (.trim (.substring string (+ 3 (.indexOf string " is "))))) 68 | 69 | (defn term 70 | "returns the part of a string before the first occurence 71 | of \"is\"" 72 | [string] 73 | (first (.split string " is "))) 74 | 75 | (defn doc-lookup? 76 | "is this a well formed doc-string lookup?" 77 | [msg] 78 | (re-find #"^\(doc " msg)) 79 | 80 | (defn d?op 81 | "if string ends in a question mark return 82 | the string without the question mark" 83 | [x] 84 | (.replaceAll x "^(.*)\\?$" "$1")) 85 | 86 | (defn- normalise-docstring 87 | [string] 88 | (and string (.replaceAll string "\\s+" " "))) 89 | 90 | (defn symbol-to-var-doc 91 | "this returns the doc metadata from a var in the 92 | clojure ns or a befuddled response" 93 | [symb] 94 | (let [a (meta (find-var (symbol "clojure.core" symb))) 95 | x (normalise-docstring (:doc a)) 96 | y (:arglists a)] 97 | (if x 98 | (str x (when y (str "; arglists " y))) 99 | (befuddled)))) 100 | 101 | (defmacro async 102 | "just do this, I don't care" 103 | [& x] 104 | `(send-off (agent nil) (fn [& _#] ~@x ))) 105 | 106 | (defn who 107 | "am I talking to someonein a privmsg, or in a channel?" 108 | [pojo] 109 | (or (:channel pojo) (:sender pojo))) 110 | 111 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 112 | 113 | (defn sendMsg 114 | "send a message to a recv, a recv is a channel name or a nick" 115 | [this recv msg] 116 | (io! (.sendMessage this recv (.replace (str msg) \newline \space)))) 117 | 118 | (defn sendMsg-who 119 | "wrapper around sendMsg" 120 | [bot msg msg-to-send] 121 | (sendMsg (:this bot) (who msg) msg-to-send)) 122 | 123 | (defmulti send-out (fn [& x] (first x))) 124 | 125 | (defmethod send-out :msg [_ bot recvr string] 126 | (io! (.sendMessage #^PircBot (:this bot) (if (map? recvr) (who recvr) recvr) (normalise-docstring (str string))))) 127 | 128 | (defmethod send-out :action [_ bot recvr string] 129 | (io! (.sendAction #^PircBot (:this bot) (if (map? recvr) (who recvr) recvr) (normalise-docstring (str string))))) 130 | 131 | (defmethod send-out :notice [_ bot recvr string] 132 | (io! (.sendNotice #^PircBot (:this bot) (if (map? recvr) (who recvr) recvr) (normalise-docstring (str string))))) 133 | 134 | (defmulti new-send-out (comp type first list)) 135 | 136 | (defn send-out [one two & r] 137 | (apply new-send-out two one r)) 138 | 139 | (defmethod new-send-out clojure.lang.IPersistentMap [bot msg-type recvr message] 140 | (condp = msg-type 141 | :msg 142 | (io! (.sendMessage #^PircBot (:this bot) (if (map? recvr) (who recvr) recvr) (normalise-docstring (.toString message)))) 143 | :action 144 | (io! (.sendAction #^PircBot (:this bot) (if (map? recvr) (who recvr) recvr) (normalise-docstring (.toString message)))) 145 | :notice 146 | (io! (.sendNotice #^PircBot (:this bot) (if (map? recvr) (who recvr) recvr) (normalise-docstring (.toString message)))))) 147 | 148 | (defmethod new-send-out :irc [bot msg-type recvr message] 149 | (new-send-out (vary-meta bot dissoc :type) msg-type recvr message)) 150 | 151 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 152 | 153 | (defn do-channels [bot fn] 154 | (doseq [c (.getChannels (:this bot))] 155 | (fn c))) 156 | 157 | ;; (defn store [bot key value] 158 | ;; (trip/delete (trip/derby (db-name bot)) key "is" :y) 159 | ;; (trip/store-triple (trip/derby (db-name bot)) {:s key :o value :p "is"})) 160 | 161 | ;; (defn what-is [term bot] 162 | ;; (trip/query (trip/derby (db-name bot)) term :x :y)) 163 | 164 | 165 | (defmacro dfn 166 | "Creates a dispatch fn with 'bot bound to the bot object 167 | and 'msg bound to a struct representing the message" 168 | [& body] 169 | `(fn [~'bot ~'msg] 170 | ~@body)) 171 | 172 | (defn everyone-I-see 173 | "returns seq like ([\"#clojure\" (\"somenick\" \"someothernicl\")]) 174 | for ever channel the bot is in" 175 | [bot] 176 | (for [channel (.getChannels bot)] 177 | [channel (map (comp :nick bean) (.getUsers bot channel))])) 178 | 179 | (defn see-nick? 180 | "do I see someone with the nickname nick? returns nil or a seq of channels where I see him" 181 | [bot nick] 182 | (reduce #(when %2 (if (seq? %) (conj % %2) (filter identity [% %2]))) 183 | nil 184 | (map first (filter #(some (fn [y] (.equals y nick)) (last %)) 185 | (everyone-I-see bot))))) 186 | 187 | (defn random-person [bot] 188 | (randth (filter #(not (.equals % (:nick bot))) 189 | (apply concat (map last (everyone-I-see bot)))))) 190 | 191 | (def #^{:doc "ref contains priority queue that is used for dispatching the responder multimethod"} 192 | *dispatchers* 193 | (ref pq/empty)) 194 | 195 | (defn dispatch 196 | "this function does dispatch for responder" 197 | [bot msg] 198 | (loop [d (pq/seq @*dispatchers*)] 199 | (when d 200 | (let [[k v] (first d)] 201 | (if (k bot msg) 202 | v 203 | (recur (seq (rest d)))))))) 204 | 205 | (defn add-dispatch-hook 206 | "Allows you to add your own hook to the message responder 207 | You *must* define a 'responder multimethod corresponding to the 208 | dispatch-value" 209 | ([dispatch-check dispatch-value] 210 | (add-dispatch-hook 0 dispatch-check dispatch-value)) 211 | ([dispatch-priority dispatch-check dispatch-value] 212 | (dosync (commute *dispatchers* pq/conj dispatch-priority [dispatch-check dispatch-value])))) 213 | 214 | (defn remove-dispatch-hook [dispatch-value] 215 | (dosync 216 | (alter 217 | *dispatchers* 218 | (comp (partial into pq/empty) 219 | (partial filter #(not= dispatch-value (last (last %)))))))) 220 | 221 | ;; register legacy stuffs 222 | (dorun 223 | (map #(add-dispatch-hook 0 (first %) (second %)) 224 | [[(dfn (doc-lookup? (:message msg))) ::doc-lookup] 225 | [(dfn (re-find #"^\([\+ / \- \*] [ 0-9]+\)" (:message msg))) ::math]])) 226 | 227 | ;;this stuff needs to come last? 228 | ;(add-dispatch-hook 20 (dfn (and (addressed? bot msg) (not (:quit msg)))) ::lookup) 229 | 230 | (defmacro defresponder [key priority fn & body] 231 | `(do 232 | (defmethod responder ~key [~'bot ~'msg] 233 | (let [~'msg (vary-meta ~'msg assoc ~key true)] 234 | ~@body)) 235 | (add-dispatch-hook ~priority (dfn (when (not (~key (meta ~'msg))) (~fn ~'bot ~'msg))) ~key))) 236 | 237 | ;;(defresponder2 238 | ;; {:priority 1 239 | ;; :key ::dostuff 240 | ;; :dispatch (fn [bot msg]) 241 | ;; :body (fn [bot msg])}) 242 | 243 | (defmacro defresponder2 [{:keys [priority body dispatch name]}] 244 | `(let [priority# ~priority 245 | body# ~body 246 | dispatch# ~dispatch 247 | name# ~name] 248 | (remove-dispatch-hook name#) 249 | (defmethod responder name# [bot# msg#] (body# bot# msg#)) 250 | (add-dispatch-hook priority# 251 | (fn [bot# msg#] 252 | (when (not (name# (meta msg#))) 253 | (dispatch# bot# msg#))) 254 | name#))) 255 | 256 | (defmulti #^{:doc "currently all messages are routed though this function"} responder dispatch) 257 | 258 | (defmethod responder nil [& _]) 259 | 260 | (defn remove-from-beginning 261 | "return a string with the concatenation of the given chunks removed if it is 262 | found at the start of the string" 263 | [string & chunks] 264 | (.replaceFirst string (apply str "^" chunks) "")) 265 | 266 | (defn extract-message 267 | "removes bot name and/or ~ from the beginning of the msg" 268 | [bot pojo] 269 | (.trim (.replaceAll (:message pojo) (str "(?:" (:nick bot) ":|~)(.*)") "$1"))) 270 | 271 | ;; (defmethod responder ::know [bot pojo] 272 | ;; (new-send-out bot :msg pojo (str "I know " (count (trip/query (trip/derby (db-name bot)) :y :y :z))" things"))) 273 | 274 | (defn handleMessage [this channel sender login hostname message] 275 | (try 276 | (let [bot this 277 | msg (struct junks channel sender login hostname message)] 278 | (future (trampoline responder bot (vary-meta msg assoc :addressed? (addressed? bot msg))))) 279 | (catch Exception e (.printStackTrace e)))) 280 | 281 | (defn handlePrivateMessage [this sender login hostname message] 282 | (handleMessage this nil sender login hostname message)) 283 | 284 | (defn join-or-part [this event channel sender login hostname] 285 | (try 286 | (trampoline responder this 287 | (assoc (struct junks channel sender login hostname "") event true)) 288 | (catch Exception e (.printStackTrace e)))) 289 | 290 | (defn pircbot [bot-config] 291 | (let [x (promise) 292 | bot-obj 293 | (proxy [PircBot] [] 294 | (onJoin [channel sender login hostname] 295 | (join-or-part @x :join channel sender login hostname)) 296 | (onPart [channel sender login hostname] 297 | (join-or-part @x :part channel sender login hostname)) 298 | (onQuit [nick login hostname reason] 299 | (join-or-part @x :quit nil nick login hostname)) 300 | (onMessage [channel sender login hostname message] 301 | (handleMessage @x channel sender login hostname message)) 302 | (onPrivateMessage [sender login hostname message] 303 | (handlePrivateMessage @x sender login hostname message)))] 304 | (let [w (merge bot-config {:this bot-obj})] 305 | (x w) 306 | w))) 307 | 308 | (defn dict-file [config suffix] 309 | (let [file (-> (str (:dict-dir config "./") (:dict-basename config (:nick config)) suffix) 310 | java.io.File.)] 311 | (.createNewFile file) 312 | file)) 313 | 314 | (defn dump-dicts [config] 315 | (dorun (map (fn [[rel rels]] 316 | (binding [*out* (java.io.FileWriter. 317 | (dict-file config rel))] 318 | (prn @rels) 319 | (.close *out*))) 320 | [[".is" dict-is] [".are" dict-are]]))) 321 | 322 | (defn load-dicts [config] 323 | (dosync 324 | (ref-set dict-is 325 | (eval 326 | (binding [*in* (java.io.PushbackReader. 327 | (java.io.FileReader. 328 | (dict-file config ".is")))] 329 | (let [a (try (read) (catch Exception e {}))] 330 | (.close *in*) 331 | a))))) 332 | config) 333 | 334 | (defn dump-dict-is [config] 335 | (log "Dumping dictionaries") 336 | (binding [*out* (-> (dict-file config ".is") 337 | java.io.FileWriter.)] 338 | (prn @dict-is) 339 | (.close *out*))) 340 | 341 | (defn load-store [bot] 342 | (send (:store bot) 343 | (fn [& _] 344 | (log "Reading store") 345 | (binding [*in* (-> (dict-file bot ".store") java.io.FileReader. java.io.PushbackReader.)] 346 | (with-open [i *in*] 347 | (try (read) 348 | (catch Exception e 349 | (println e))))))) 350 | bot) 351 | 352 | (defn watch-store [bot] 353 | (add-watch (:store bot) 354 | :writer 355 | (fn [key ref old-state new-state] 356 | (log "Writing store") 357 | (binding [*out* (-> (dict-file bot ".store") java.io.FileWriter.)] 358 | (with-open [o *out*] (prn new-state))))) 359 | bot) 360 | 361 | (defn start-dump-thread [config] 362 | (sched/fixedrate 363 | {:task #(dump-dict-is config) 364 | :start-delay 1 365 | :rate 10 366 | :unit (:minutes sched/unit)}) 367 | config) 368 | 369 | (defn wall-hack-method [class-name name- params obj & args] 370 | (-> class-name (.getDeclaredMethod (name name-) (into-array Class params)) 371 | (doto (.setAccessible true)) 372 | (.invoke obj (into-array Object args)))) 373 | 374 | (defn start-clojurebot [attrs additional-setup] 375 | (let [bot (pircbot attrs)] 376 | (dosync (commute *bots* assoc (:this bot) bot)) 377 | (wall-hack-method org.jibble.pircbot.PircBot :setName [String] (:this bot) (:nick bot)) 378 | (doto (:this bot) 379 | (.connect (:network bot)) 380 | (.changeNick (:nick bot)) 381 | (.joinChannel (:channel bot))) 382 | (additional-setup bot) 383 | bot)) 384 | 385 | (defmacro run-clojurebot [botname botattrs & additional-setup] 386 | `(start-clojurebot ~botattrs (fn [~botname] (do ~@additional-setup)))) 387 | --------------------------------------------------------------------------------