Resolved cookie_login conflict

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)