diff options
| -rwxr-xr-x | src/site.clj | 81 |
1 files changed, 42 insertions, 39 deletions
diff --git a/src/site.clj b/src/site.clj index 4ba5981..c36f1ae 100755 --- a/src/site.clj +++ b/src/site.clj @@ -7,7 +7,8 @@ org.apache.commons.codec.digest.DigestUtils javax.servlet.http.Cookie org.antlr.stringtemplate.StringTemplateGroup) - (:use clojure.contrib.str-utils + (:use clojure.xml + clojure.contrib.str-utils clojure.contrib.duck-streams clojure.contrib.json.write clojure.contrib.sql @@ -24,6 +25,10 @@ :user "postgres" :password "root"})) +(def *run-flusher* true) +(def *flusher-sleep-ms* 4000) +(def *user-timeout-ms* 15000) + (def template-group (new StringTemplateGroup "dumpfm" "template")) (.setRefreshInterval template-group 3) @@ -35,24 +40,19 @@ (System/currentTimeMillis))) (def rooms (ref {})) - -(def run-flusher true) -(def flusher-sleep-ms 4000) -(def user-timeout-ms 15000) - (def flusher (agent nil)) (defn flush! [x] - (when run-flusher + (when *run-flusher* (send-off *agent* #'flush!)) (doseq [[rid room] @rooms] (dosync (let [users (room :users) now (System/currentTimeMillis) - alive? (fn [[n u]] (> (u :last-seen) (- now user-timeout-ms)))] + alive? (fn [[n u]] (> (u :last-seen) (- now *user-timeout-ms*)))] (ref-set users (into {} (filter alive? @users)))))) - (. Thread (sleep flusher-sleep-ms)) + (. Thread (sleep *flusher-sleep-ms*)) x) ;; Configuration @@ -69,6 +69,9 @@ ;; Utils +(defn ms-in-future [ms] + (+ ms (System/currentTimeMillis))) + (defn swap [f] (fn [& more] (apply f (reverse more)))) @@ -170,7 +173,7 @@ "messages" (map process-message-for-json (new-messages room since))}) -(def dumps-per-page 20) +(def *dumps-per-page* 20) (defn maybe-parse-int [s f] (if s (Integer/parseInt s) f)) @@ -193,7 +196,7 @@ "WHERE room_id = ? AND m.user_id = u.user_id " (if image-only "AND m.is_image = true " "") "ORDER BY created_on DESC " - "LIMIT " dumps-per-page " OFFSET ?")] + "LIMIT " *dumps-per-page* " OFFSET ?")] (do-select [query room-id offset])))) (defn count-messages-by-nick [nick image-only] @@ -213,9 +216,18 @@ "AND r.room_id = m.room_id AND r.admin_only = false " (if image-only "AND m.is_image = true " "") "ORDER BY created_on DESC " - "LIMIT " dumps-per-page " OFFSET ?")] + "LIMIT " *dumps-per-page* " OFFSET ?")] (do-select [query nick offset])))) +(defn build-room-map-from-db [room-db] + {:admin_only (room-db :admin_only) + :room_id (room-db :room_id) + :key (room-db :key) + :name (room-db :name) + :description (room-db :description) + :users (ref {}) + :messages (ref (fetch-messages-by-room (room-db :room_id) false))}) + ;; Templates (defn fetch-template [template-name session] @@ -243,10 +255,10 @@ ;; login-token functions -(defn is-logged-in? +(defn logged-in? "Test whether user is logged in by presence of nick key in session." - [session] - (contains? session :nick)) + [request] + (contains? (request :session) :nick)) (defn encode-login-token [nick hash expiry] (let [token-hash (sha1-hash hash expiry)] @@ -268,11 +280,11 @@ db-info))))) (defn make-login-token - [{nick :nick hash :hash} expiry] - (let [expiration (+ (System/currentTimeMillis) expiry)] - (set-cookie *default-login-token-key* (encode-login-token nick - hash - expiration) + [{nick :nick hash :hash}] + (let [expiration (ms-in-future *login-token-expiry*)] + (set-cookie *login-token-key* (encode-login-token nick + hash + expiration) :expires (gmt-string (new Date expiration))))) ;; Landing @@ -288,8 +300,8 @@ db-user (authorize-nick-hash nick hash) remember-me (= (params :rememberme) "yes") login-cookie (if remember-me - (make-login-token db-user *default-login-token-expiry*) - (clear-login-token *default-login-token-key*))] + (make-login-token db-user *login-token-expiry*) + (clear-login-token *login-token-key*))] (if db-user [(session-assoc-from-db db-user) login-cookie @@ -298,7 +310,7 @@ (defn logout [session] [(session-dissoc :nick :user_id :is_admin :avatar) - (clear-login-token *default-login-token-key*) + (clear-login-token *login-token-key*) (redirect-to "/")]) ;; Registration @@ -327,7 +339,7 @@ is-home (and nick (= nick profile-nick)) has-avatar (non-empty-string? (user-info :avatar)) offset (maybe-parse-int offset 0) - dump-offset (* offset dumps-per-page) + dump-offset (* offset *dumps-per-page*) dumps (fetch-messages-by-nick profile-nick true dump-offset) dump-count (count-messages-by-nick profile-nick true) st (fetch-template "profile" session)] @@ -339,7 +351,7 @@ (if (non-empty-string? v) (escape-html v))))) (.setAttribute st "dumps" (to-array (map process-message-for-output dumps))) - (if (< (+ dump-offset dumps-per-page) dump-count) + (if (< (+ dump-offset *dumps-per-page*) dump-count) (.setAttribute st "next" (inc offset))) (if (not= offset 0) (.setAttribute st "prev" (max (dec offset) 0))) @@ -491,13 +503,13 @@ (defn log [session room offset params] (let [st (fetch-template "log" session) offset (maybe-parse-int offset 0) - dump-offset (* offset dumps-per-page) + dump-offset (* offset *dumps-per-page*) image-only (and (not (room :admin_only)) (not= (params :show) "all")) dumps (to-array (map process-message-for-output (fetch-messages-by-room (room :room_id) image-only dump-offset))) dump-count (count-messages-by-room (room :room_id) image-only)] - (if (< (+ dump-offset dumps-per-page) dump-count) + (if (< (+ dump-offset *dumps-per-page*) dump-count) (.setAttribute st "next" (inc offset))) (if (not= offset 0) (.setAttribute st "prev" (max (dec offset) 0))) @@ -613,15 +625,12 @@ "zip" "application/zip"}) (decorate static - (with-mimetypes)) + (with-mimetypes {:mimetypes mimetypes})) (decorate pichat - (with-cookie-login {:is-logged-in? is-logged-in? - :token-maker make-login-token - :token-reader read-login-token}) (with-mimetypes {:mimetypes mimetypes}) + (with-cookie-login (comp not logged-in?) make-login-token read-login-token) (with-session {:type :memory, :expires (* 60 60)})) - (decorate multipart (with-mimetypes {:mimetypes mimetypes}) @@ -633,13 +642,7 @@ (dosync (doseq [room-db (fetch-rooms)] (alter rooms assoc (room-db :key) - {:admin_only (room-db :admin_only) - :room_id (room-db :room_id) - :key (room-db :key) - :name (room-db :name) - :description (room-db :description) - :users (ref {}) - :messages (ref (fetch-messages-by-room (room-db :room_id) false))}))) + (build-room-map-from-db room-db)))) (run-server {:port 8080} "/static/*" (servlet static) |