Added login cookies

1 files changed, 114 insertions, 13 deletions

diff --git a/src/site.clj b/src/site.clj
index 3531f4a..f10f925 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -2,6 +2,7 @@
   (:import java.lang.System
            java.text.SimpleDateFormat
            java.util.Date
+           java.util.TimeZone
            java.io.File
            org.apache.commons.codec.digest.DigestUtils
            javax.servlet.http.Cookie
@@ -85,6 +86,16 @@
             (cons (System/getProperty "user.dir")
                   more)))
 
+(defn sha1-hash [& more]
+  (DigestUtils/shaHex (apply str more)))
+
+(defn gmt-string 
+  ([] (gmt-string (new Date)))
+  ([dt]
+     (let [df (new SimpleDateFormat "EEE, dd MMM yyyy kk:mm:ss z")]
+       (.setTimeZone df (TimeZone/getTimeZone "GMT"))
+       (.format df dt))))
+
 ;; Database
 
 (defn do-select [query]
@@ -212,30 +223,104 @@
           (.setAttribute st "isadmin" (session :is_admin))))
     st))
 
-;; Landing
 
-(defn populate-session-from-db [user-info]
+;; Login code
+  
+;; Authorize login-cookies for a week.
+(def *login-cookie-duration* (* 1000 60 60 24 7))
+
+(defn session-map-from-db
+  [user-info]
+  {:user_id (user-info :user_id)
+   :nick (user-info :nick)
+   :is_admin (user-info :is_admin)
+   :avatar (user-info :avatar)})
+
+(defn session-assoc-from-db 
+  [user-info]
   (session-assoc :user_id (user-info :user_id)
 		 :nick (user-info :nick)
                  :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)]
+    (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)))
+
+(defn clear-login-token
+  []
+  (set-cookie :token "dummy"
+              :expires "Thu, 01-Jan-70 00:00:01 GMT"))
+
+(defn apply-login-info
+  [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)})))
+
+(defn logged-in?
+  "Test whether user is logged in"
+  [session]
+  (and session (contains? session :nick)))
+
+(defn try-cookie-login
+  [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))))
+
+(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)
+      (handler (try-cookie-login request)))))
+
+;; Landing
+
 (defn landing [session]
   (if (session :nick)
     (redirect-to "/chat")
     (serve-file "static" "index.html")))
 
-(defn login [session params]
+(defn login [session params cookies]
   (let [nick (params :nick)
         hash (params :hash)
-        db-user (authorize-nick-hash nick hash)]
+        db-user (authorize-nick-hash nick hash)
+        remember-me (params :rememberme)]
     (if db-user
-      [(populate-session-from-db db-user)
+      [(session-assoc-from-db db-user)
+       (set-cookie :token (generate-login-token nick hash)
+                   :expires (gmt-string (new Date
+                                             (+ (System/currentTimeMillis)
+                                                *login-cookie-duration*))))
        (resp-success "OK")]
       (resp-error "BAD_LOGIN"))))
 
 (defn logout [session]
   [(session-dissoc :nick :user_id :is_admin :avatar)
+   (clear-login-token)
    (redirect-to "/")])
 
 ;; Registration
@@ -252,7 +337,7 @@
 				 [:nick :hash :email]
 				 [nick hash email])
 		  (let [db-user (fetch-nick nick)]
-		    [(populate-session-from-db db-user)
+		    [(session-assoc-from-db db-user)
 		     (resp-success "OK")])))))
 
 ;; Profile
@@ -414,7 +499,6 @@
       (.setAttribute st "users" user-list))
     (.setAttribute st "messages" message-list)
     (.setAttribute st "roomkey" (room :key))
-    (.setAttribute st "isadmin" (session :is_admin))
     (.setAttribute st "isadminroom" (room :admin_only))
     (.setAttribute st "json_room_key" (json-str (room :key)))
     (.setAttribute st "json_user_nick" (if nick (json-str nick) "null"))
@@ -499,15 +583,15 @@
 
 (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 "/favicon.ico" (serve-static "static" "favicon.ico"))
   (GET "/u/:nick" (profile session (params :nick) "0"))
   (GET "/u/:nick/" (profile session (params :nick) "0"))
   (GET "/u/:nick/:offset" (profile session
                                    (params :nick)
                                    (params :offset)))
-  (GET "/login" (login session params))
+  (GET "/login" (login session params cookies))
   (GET "/logout" (logout session))
   (GET "/register" (serve-static "static" "register.html"))
   (GET "/:room/chat" (no-cache (validated-chat session (-> request :route-params :room))))
@@ -528,16 +612,33 @@
   (POST "/update-profile" (update-profile session params))
   (ANY "*" (unknown-page params)))
 
-
 (defroutes multipart
   (POST "/upload" (upload session params)))
 
-(decorate pichat 
-  (with-mimetypes)
+;; Add jpeg to list
+(def mimetypes
+  {"css"  "text/css"
+   "gif"  "image/gif"
+   "gz"   "application/gzip"
+   "htm"  "text/html"
+   "html" "text/html"
+   "jpg"  "image/jpeg"
+   "jpeg" "image/jpeg"
+   "js"   "text/javascript"
+   "pdf"  "application/pdf"
+   "png"  "image/png"
+   "swf"  "application/x-shockwave-flash"
+   "txt"  "text/plain"
+   "xml"  "text/xml"
+   "zip"  "application/zip"})
+
+(decorate pichat
+  (with-cookie-login)
+  (with-mimetypes {:mimetypes mimetypes})
   (with-session {:type :memory, :expires (* 60 60)}))
 
 (decorate multipart
-  (with-mimetypes)
+  (with-mimetypes {:mimetypes mimetypes})
   (with-session {:type :memory, :expires (* 60 60)})
   (with-multipart))