diff options
Diffstat (limited to 'src')
| -rwxr-xr-x | src/cookie_login.clj | 76 | ||||
| -rwxr-xr-x | src/site.clj | 81 |
2 files changed, 80 insertions, 77 deletions
diff --git a/src/cookie_login.clj b/src/cookie_login.clj index 9e501f4..e507876 100755 --- a/src/cookie_login.clj +++ b/src/cookie_login.clj @@ -1,23 +1,28 @@ (ns cookie-login (:use compojure)) -(defn clear-login-token [token-key] +(def *login-token-key* :login-token) +(def *login-token-expiry* (* 1000 60 60 24 7)) ; one week + +(defn clear-login-token "Creates an expiration cookie for a given cookie name." + [token-key] (set-cookie token-key "dummy" :expires "Thu, 01-Jan-1970 00:00:01 GMT")) + (defn handle-request-with-login-token "Validates login token, handles request, and updates cookies and session - repository. If token is invalid or an exception is raised while reading it, - the token cookie is expired." - [handler request expiry token-key token-maker token-reader] - (if-let [session-info (token-reader (get-in request [:cookies token-key]))] + repository. If the token is invalid, the token cookie is expired." + [handler request token-maker token-reader login-token-key login-token-expiry] + (if-let [session-info (token-reader (get-in request + [:cookies login-token-key]))] (let [response (handler (merge-with merge request {:session session-info})) ; Session variable priority: ; 1) variables set by handler - ; 2) session variables from token-reader + ; 2) variables from token-reader ; 3) variables from repository session-map (merge (request :session) session-info @@ -25,50 +30,45 @@ (merge-with merge response {:session session-map} - (token-maker session-info expiry))) + (token-maker session-info))) (merge (handler request) - (clear-login-token token-key)))) - -; Default expiration is a week. -(def *default-login-token-expiry* (* 1000 60 60 24 7)) -(def *default-login-token-key* :login-token) + (clear-login-token login-token-key)))) (defn with-cookie-login "Middleware to support automatic cookie login. Must be placed after - the with-session middleware! + the with-session middleware. - Accepts five configuration options: - - token-key: - The cookie name to store the login-token under. - Defaults to 'login-token'. - - expiry: - The number of milliseconds a login token is valid for. - Defaults to one week. - - is-logged-in?: - Function to apply to request's session map to determine whether to - process login token or not. If a truthy value is returned, +Must be given three arguments: + - process-login-token? + Function to apply to request map to determine whether to + process login token or not. If a false value is returned, then the next handler is called without further processing. - token-maker: - Function to generate new login token from session map and - milliseconds until login token expiry. + Function to generate new login token from session map. - token-reader: Function to generate session map from login token. Should return nil if login token is invalid. -" - [handler options] - (let [token-key (or (options :default-token-key) *default-login-token-key*) - expiry (or (options :expiry) *default-login-token-expiry*) - is-logged-in? (options :is-logged-in?) - token-maker (options :token-maker) - token-reader (options :token-reader)] + + The following variables can be rebound: + - *login-token-key* + The cookie name to store the login-token under. + Defaults to 'login-token'. + + - *login-token-expiry* + The number of milliseconds a login token is valid for. + Defaults to one week. +" + [handler process-login-token? token-maker token-reader] + (let [login-token-key *login-token-key* + login-token-expiry *login-token-expiry*] (fn [request] - (if (or (is-logged-in? (request :session)) - (not (get-in request [:cookies token-key]))) - (handler request) + (if (and (get-in request [:cookies login-token-key]) + (process-login-token? request)) (handle-request-with-login-token handler request - expiry - token-key token-maker - token-reader)))))
\ No newline at end of file + token-reader + login-token-key + login-token-expiry) + (handler request))))) diff --git a/src/site.clj b/src/site.clj index b1774fd..e0a40b9 100755 --- a/src/site.clj +++ b/src/site.clj @@ -7,13 +7,18 @@ 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.sql compojure cookie-login utils)) +(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) @@ -25,24 +30,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 @@ -59,6 +59,9 @@ ;; Utils +(defn ms-in-future [ms] + (+ ms (System/currentTimeMillis))) + (defn swap [f] (fn [& more] (apply f (reverse more)))) @@ -141,7 +144,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)) @@ -164,7 +167,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] @@ -184,9 +187,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] @@ -214,10 +226,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)] @@ -239,11 +251,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 @@ -259,8 +271,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 @@ -269,7 +281,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 @@ -298,7 +310,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)] @@ -310,7 +322,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))) @@ -462,13 +474,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))) @@ -585,15 +597,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}) @@ -605,13 +614,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) |