Fixed cookie handling

1 files changed, 57 insertions, 36 deletions

diff --git a/src/site.clj b/src/site.clj
index 996fe4e..b5bdf4a 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -249,60 +249,73 @@
     (str nick "%" expiry "%" token-hash)))
 
 (defn validate-login-token [token]
-  (try
-   (let [[nick expiry token-hash] (.split token "\\%")]
-         (if (< (Long/parseLong expiry) (System/currentTimeMillis))
-           nil
-           (let [db-info (fetch-nick nick)
-                 computed-hash (sha1-hash (db-info :hash) expiry)]
-             (if (= token-hash computed-hash)
-               db-info nil))))
-   (catch Exception _ nil)))
+  (let [[nick expiry token-hash] (.split token "\\%")]
+    (if (< (Long/parseLong expiry) (System/currentTimeMillis))
+      nil
+      (let [db-info (fetch-nick nick)
+            computed-hash (sha1-hash (db-info :hash) expiry)]
+        (if (= token-hash computed-hash)
+          db-info nil)))))
 
-(defn clear-login-token
-  []
+(defn clear-login-token []
   (set-cookie :token "dummy"
-              :expires "Thu, 01-Jan-70 00:00:01 GMT"))
+              :expires "Thu, 01-Jan-1970 00:00:01 GMT"))
 
-(defn set-login-token
-  [nick hash]
+(defn set-fresh-login-token
+  [{nick :nick hash :hash}]
   (set-cookie :token (generate-login-token nick hash)
               :expires (gmt-string (new Date
                                         (+ (System/currentTimeMillis)
                                            *login-cookie-duration*)))))
 
-(defn apply-login-info
+(defn apply-user-info-to-session
+  "Merges the user's account information into the request's session map.
+   WARNING: this doesn't change Compojure's session repository!"
   [request user-info]
-  (let [req-cookies (request :cookies)
-        req-session (request :session)
-        login-token (generate-login-token (user-info :nick)
-                                          (user-info :hash))
-        user-session (session-map-from-db user-info)]
-    (merge request
-           {:cookies (assoc req-cookies :token login-token)
-            :session (merge req-session user-session)})))
+  (let [user-session (session-map-from-db user-info)]
+    (merge-with merge request {:session user-session})))
 
 (defn logged-in?
-  "Test whether user is logged in"
+  "Test whether user is logged in by presence of nick key."
   [session]
-  (and session (contains? session :nick)))
+  (contains? session :nick))
 
-(defn try-cookie-login
-  [request]
+(defn handle-request-with-login-token
+  "Handles request using login token. If token is valid, add the user's
+  info to request's session hash, and use session-assoc-from-db to update the
+  session repository. If token is invalid, use clear-login-token to 
+  expire the cookie."
+  [handler request]
   (let [token (get-in request [:cookies :token])
-        login-info (validate-login-token token)]
-    (if (not login-info)
-      (merge request (clear-login-token))
-      (apply-login-info request login-info))))
+        user-info (validate-login-token token)
+        updated-request (if user-info
+                          (apply-user-info-to-session request user-info)
+                          request)
+        response (handler updated-request)
+        ; Session priority:
+        ; 1) variables set by handler
+        ; 2) variables set from user-info
+        ; 3) variables from repository
+        session-map (merge (request :session)
+                           (session-map-from-db user-info)
+                           (response :session))]
+    (merge-with merge
+                response
+                {:session session-map}
+                (set-fresh-login-token user-info))))
 
 (defn with-cookie-login
   "Middleware to support automatic cookie login. Place after with-session."
   [handler]
   (fn [request]
+    (prn "with-cookie-login" (request :session))
     (if (or (logged-in? (request :session))
             (not (get-in request [:cookies :token])))
       (handler request)
-      (handler (try-cookie-login request)))))
+      (let [r (handle-request-with-login-token handler request)]
+        (prn r)
+        r))))
+        
 
 ;; Landing
 
@@ -317,7 +330,7 @@
         db-user (authorize-nick-hash nick hash)
         remember-me (= (params :rememberme) "yes")
         login-cookie (if remember-me
-                       (set-login-token nick hash)
+                       (set-fresh-login-token db-user)
                        (clear-login-token))]
     (if db-user
       [(session-assoc-from-db db-user)
@@ -462,7 +475,7 @@
 	qry (str "INSERT INTO messages (user_id, room_id, content, is_image) "
 		 "VALUES (?, ?, ?, ?) RETURNING message_id")] 
     (with-connection db
-      ((first (do-select [qry user-id room-id content is-image])) 
+      ((first (do-select [qry user-id room-id content is-image]))
        :message_id))))
 
 (defn msg [session params]
@@ -588,11 +601,13 @@
     [cache-header
      (serve-file dir path)]))
 
+(defroutes static
+  (GET "/static/*" (serve-static "static" (params :*)))
+  (GET "/images/*" (serve-static *image-directory* (params :*))))
+
 (defroutes pichat
   (GET "/" (no-cache (landing session)))
   (GET "/favicon.ico" (serve-static "static" "favicon.ico"))
-  (GET "/static/*" (serve-static "static" (params :*)))
-  (GET "/images/*" (serve-static *image-directory* (params :*)))
   (GET "/u/:nick" (profile session (params :nick) "0"))
   (GET "/u/:nick/" (profile session (params :nick) "0"))
   (GET "/u/:nick/:offset" (profile session
@@ -639,10 +654,14 @@
    "xml"  "text/xml"
    "zip"  "application/zip"})
 
+(decorate static
+  (with-mimetypes))
+
 (decorate pichat
   (with-cookie-login)
   (with-mimetypes {:mimetypes mimetypes})
   (with-session {:type :memory, :expires (* 60 60)}))
+  
 
 (decorate multipart
   (with-mimetypes {:mimetypes mimetypes})
@@ -663,6 +682,8 @@
            :messages (ref (fetch-messages-by-room (room-db :room_id) false))})))
   
 (run-server {:port 8080}
+  "/static/*" (servlet static)
+  "/images/*" (servlet static)
   "/upload" (servlet multipart)
   "/*" (servlet pichat))