; site.clj (ns pichat (:import java.lang.System) (:use compojure clojure.contrib.json.write)) (defstruct user-struct :nick :last-seen) (defstruct message-struct :nick :content :timestamp) (def users (ref {})) (def messages (ref [])) (def run-flusher true) (def flusher-sleep-ms 4000) (def user-timeout-ms 30000) (defn swap [f] (fn [& more] (apply f (reverse more)))) (def flusher (agent nil)) (defn flush! [x] (when run-flusher (send-off *agent* #'flush!)) (dosync (let [now (System/currentTimeMillis) alive? (fn [[n u]] (> (u :last-seen) (- now user-timeout-ms)))] (ref-set users (into {} (filter alive? @users))))) (. Thread (sleep flusher-sleep-ms)) x) (defn resp-error [message] {:status 400 :headers {} :body message}) (defn resp-success [message] {:status 200 :headers {} :body (json-str message)}) (defn join-success [nick] (alter users assoc nick (struct user-struct nick (System/currentTimeMillis))) (let [users (sort (keys @users)) messages (reverse (take 40 @messages)) data {"users" users "messages" messages}] [(session-assoc :nick nick) (resp-success data)])) (defn try-join [params] (let [nick (escape-html (params :nick))] (dosync (if (contains? @users nick) (resp-error "NICK_TAKEN") (join-success nick))))) (defn new-messages [since] (reverse (take-while (fn [m] (> (m :timestamp) since)) @messages))) (defn refresh [nick] (dosync (if (contains? @users nick) (let [last-seen (get-in @users [nick :last-seen]) user-list (sort (keys @users))] (alter users assoc-in [nick :last-seen] (System/currentTimeMillis)) (resp-success {"messages" (new-messages last-seen) "users" user-list})) (resp-error "UNKNOWN_USER")))) (defn msg [session params] (dosync (let [nick (session :nick) content (escape-html (params :content)) msg (struct message-struct nick content (System/currentTimeMillis))] (if (contains? @users nick) (do (alter messages (swap cons) msg) (resp-success "OK")) (resp-error "UNKNOWN_USER"))))) (defroutes pichat (GET "/" (serve-file "static" "index.html")) (GET "/static/*" (or (serve-file "static" (params :*)) :next)) (GET "/join" (try-join params)) (GET "/refresh" (refresh (session :nick))) (GET "/msg" (msg session params)) (ANY "*" [404 "Page not found"])) (decorate pichat (with-mimetypes) (with-session {:type :memory, :expires (* 60 60)})) (run-server {:port 8080} "/*" (servlet pichat)) (send-off flusher flush!)