Extracted cookie_login.clj from src.clj

4 files changed, 114 insertions, 76 deletions

diff --git a/bin/repl.bat b/bin/repl.bat
index e06c6ef..2417315 100755
--- a/bin/repl.bat
+++ b/bin/repl.bat
@@ -1,3 +1,3 @@
 REM Windows REPL script
 
-java -server -cp lib/commons-io-1.4.jar;lib/commons-fileupload-1.2.1.jar;lib/commons-codec-1.3.jar;lib/clojure.jar;lib/clojure-contrib.jar;lib/compojure-3.2v1.jar;lib/jetty-6.1.14.jar;lib/jetty-util-6.1.14.jar;lib/servlet-api-2.5-6.1.14.jar;lib/jline-0.9.94.jar;lib/postgresql-8.4-701.jdbc4.jar;lib/stringtemplate-3.2.1.jar;lib/antlr-2.7.7.jar jline.ConsoleRunner clojure.lang.Repl %1
\ No newline at end of file
+java -server -cp lib/commons-io-1.4.jar;lib/commons-fileupload-1.2.1.jar;lib/commons-codec-1.3.jar;lib/clojure.jar;lib/clojure-contrib.jar;lib/compojure-3.2v1.jar;lib/jetty-6.1.14.jar;lib/jetty-util-6.1.14.jar;lib/servlet-api-2.5-6.1.14.jar;lib/jline-0.9.94.jar;lib/postgresql-8.4-701.jdbc4.jar;lib/stringtemplate-3.2.1.jar;lib/antlr-2.7.7.jar;src/ jline.ConsoleRunner clojure.lang.Repl %1
\ No newline at end of file
diff --git a/bin/repl.sh b/bin/repl.sh
index a7308df..d5c7413 100755
--- a/bin/repl.sh
+++ b/bin/repl.sh
@@ -1,3 +1,3 @@
 #!/bin/sh
 
-java -server -cp .:lib/commons-io-1.4.jar:lib/commons-fileupload-1.2.1.jar:lib/commons-codec-1.3.jar:lib/jline-0.9.94.jar:lib/clojure.jar:lib/clojure-contrib.jar:lib/compojure-3.2v1.jar:lib/jetty-6.1.14.jar:lib/jetty-util-6.1.14.jar:lib/servlet-api-2.5-6.1.14.jar:lib/postgresql-8.4-701.jdbc4.jar:lib/stringtemplate-3.2.1.jar:lib/antlr-2.7.7.jar jline.ConsoleRunner clojure.lang.Repl $1
+java -server -cp .:lib/commons-io-1.4.jar:lib/commons-fileupload-1.2.1.jar:lib/commons-codec-1.3.jar:lib/jline-0.9.94.jar:lib/clojure.jar:lib/clojure-contrib.jar:lib/compojure-3.2v1.jar:lib/jetty-6.1.14.jar:lib/jetty-util-6.1.14.jar:lib/servlet-api-2.5-6.1.14.jar:lib/postgresql-8.4-701.jdbc4.jar:lib/stringtemplate-3.2.1.jar:lib/antlr-2.7.7.jar:src/ jline.ConsoleRunner clojure.lang.Repl $1
diff --git a/src/cookie_login.clj b/src/cookie_login.clj
new file mode 100755
index 0000000..6ac1f6c
--- /dev/null
+++ b/src/cookie_login.clj
@@ -0,0 +1,74 @@
+(ns cookie-login
+  (:use compojure))
+
+(defn clear-login-token [token-key]
+  "Creates an expiration cookie for a given cookie name."
+  (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]))]
+    (let [response (handler (merge-with merge
+                                        request
+                                        {:session session-info}))
+          ; Session variable priority:
+          ; 1) variables set by handler
+          ; 2) session variables from token-reader
+          ; 3) variables from repository          
+          session-map (merge (request :session)
+                             session-info
+                             (response :session))]
+      (merge-with merge
+                  response
+                  {:session session-map}
+                  (token-maker session-info expiry)))
+    (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)
+
+(defn with-cookie-login
+  "Middleware to support automatic cookie login. Must be placed after 
+   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,
+        then the next handler is called.
+   - token-maker:
+        Function to generate new login token from session map and 
+        milliseconds until login token expiry.
+   - 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)]
+    (fn [request]
+      (if (or (is-logged-in? (request :session))
+              (not (get-in request [:cookies token-key])))
+        (handler request)
+        (handle-request-with-login-token
+          handler
+          request
+          expiry
+          token-key
+          token-maker
+          token-reader)))))
\ No newline at end of file
diff --git a/src/site.clj b/src/site.clj
index 8647c23..4ba5981 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -7,11 +7,13 @@
            org.apache.commons.codec.digest.DigestUtils
            javax.servlet.http.Cookie
            org.antlr.stringtemplate.StringTemplateGroup)
-  (:use compojure
-        clojure.contrib.str-utils
+  (:use clojure.contrib.str-utils
         clojure.contrib.duck-streams
         clojure.contrib.json.write
-        clojure.contrib.sql))
+        clojure.contrib.sql
+        compojure
+        cookie-login
+        ))
 
 (let [db-host "localhost"
       db-port 5432
@@ -223,11 +225,7 @@
           (.setAttribute st "isadmin" (session :is_admin))))
     st))
 
-
 ;; Login code
-  
-;; Authorize login-cookies for a week.
-(def *login-cookie-duration* (* 1000 60 60 24 7))
 
 (defn session-map-from-db
   [user-info]
@@ -243,75 +241,39 @@
                  :is_admin (user-info :is_admin)
 		 :avatar (user-info :avatar)))
 
-(defn generate-login-token [nick hash]
-  (let [expiry (+ (System/currentTimeMillis) *login-cookie-duration*)
-        token-hash (sha1-hash hash expiry)]
+;; login-token functions
+
+(defn is-logged-in?
+  "Test whether user is logged in by presence of nick key in session."
+  [session]
+  (contains? session :nick))
+
+(defn encode-login-token [nick hash expiry]
+  (let [token-hash (sha1-hash hash expiry)]
     (str nick "%" expiry "%" token-hash)))
 
-(defn validate-login-token [token]
-  (let [[nick expiry token-hash] (.split token "\\%")]
-    (if (< (Long/parseLong expiry) (System/currentTimeMillis))
-      nil
+(defn parse-login-token [token]
+  (let [x (.split token "\\%")]
+    (if (not (= (alength x) 3))
+      nil)
+    (try [(aget x 0) (Long/parseLong (aget x 1)) (aget x 2)]
+         (catch NumberFormatException _ nil))))
+
+(defn read-login-token [token]
+  (if-let [[nick expiry token-hash]  (parse-login-token token)]
+    (if (>= expiry (System/currentTimeMillis))
       (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 []
-  (set-cookie :token "dummy"
-              :expires "Thu, 01-Jan-1970 00:00:01 GMT"))
-
-(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-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 [user-session (session-map-from-db user-info)]
-    (merge-with merge request {:session user-session})))
-
-(defn logged-in?
-  "Test whether user is logged in by presence of nick key."
-  [session]
-  (contains? session :nick))
-
-(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])
-        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))))
+          db-info)))))
 
-(defn with-cookie-login
-  "Middleware to support automatic cookie login. Place after with-session."
-  [handler]
-  (fn [request]
-    (if (or (logged-in? (request :session))
-            (not (get-in request [:cookies :token])))
-      (handler request)
-      (handle-request-with-login-token handler request))))
+(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)
+                :expires (gmt-string (new Date expiration)))))
 
 ;; Landing
 
@@ -326,8 +288,8 @@
         db-user (authorize-nick-hash nick hash)
         remember-me (= (params :rememberme) "yes")
         login-cookie (if remember-me
-                       (set-fresh-login-token db-user)
-                       (clear-login-token))]
+                       (make-login-token db-user *default-login-token-expiry*)
+                       (clear-login-token *default-login-token-key*))]
     (if db-user
       [(session-assoc-from-db db-user)
        login-cookie
@@ -336,7 +298,7 @@
 
 (defn logout [session]
   [(session-dissoc :nick :user_id :is_admin :avatar)
-   (clear-login-token)
+   (clear-login-token *default-login-token-key*)
    (redirect-to "/")])
 
 ;; Registration
@@ -654,7 +616,9 @@
   (with-mimetypes))
 
 (decorate pichat
-  (with-cookie-login)
+  (with-cookie-login {:is-logged-in? is-logged-in?
+                      :token-maker   make-login-token
+                      :token-reader  read-login-token})
   (with-mimetypes {:mimetypes mimetypes})
   (with-session {:type :memory, :expires (* 60 60)}))