Fixed cookie logins

2 files changed, 28 insertions, 18 deletions

diff --git a/src/cookie_login.clj b/src/cookie_login.clj
index e507876..8c948a6 100755
--- a/src/cookie_login.clj
+++ b/src/cookie_login.clj
@@ -38,7 +38,7 @@
   "Middleware to support automatic cookie login. Must be placed after 
    the with-session middleware.
 
-Must be given three arguments:
+   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,
@@ -56,8 +56,7 @@ Must be given three arguments:
         
    - *login-token-expiry*
         The number of milliseconds a login token is valid for.
-        Defaults to one week.
-"
+        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*]
diff --git a/src/site.clj b/src/site.clj
index a524a1c..b519f90 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -15,6 +15,7 @@
         compojure
         utils
         cookie-login
+        session-sweeper
         feed))
 
 (def *run-flusher* true)
@@ -34,9 +35,7 @@
 (def rooms (ref {}))
 (def flusher (agent nil))
 
-(defn flush! [x]
-  (when *run-flusher*
-    (send-off *agent* #'flush!))
+(defn flush-inactive-users! [x]
   (doseq [[rid room] @rooms]
     (dosync
      (let [users (room :users)
@@ -44,9 +43,14 @@
            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*)
+  (when *run-flusher*
+    (send *agent* #'flush-inactive-users!))
   x)
 
+(defn start-user-flusher! []
+  (send flusher flush-inactive-users!))
+
 ;; Configuration
 
 (def *server-url*
@@ -244,9 +248,13 @@
     (try [(aget x 0) (Long/parseLong (aget x 1)) (aget x 2)]
          (catch NumberFormatException _ nil))))
 
-
 (defn read-login-token [token]
-  nil)
+  (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)))))
 
 (defn make-login-token
   [{nick :nick hash :hash}]
@@ -534,8 +542,7 @@
 (defn serve-static [dir path]
   ; TODO: cache policy for other static files (js, css, etc.)
   (let [cache-header (if (re-find pic-regex path)
-                       {:headers {"Cache-Control"
-                                  "post-check=3600,pre-check=43200"}}
+                       {:headers {"Cache-Control" "max-age=604800,public"}}
                        {})]
     [cache-header
      (serve-file dir path)]))
@@ -613,11 +620,15 @@
  (doseq [room-db (fetch-rooms)]
    (alter rooms assoc (room-db :key)
           (build-room-map-from-db room-db))))
-  
-(run-server {:port 8080}
-  "/static/*" (servlet static)
-  "/images/*" (servlet static)
-  "/upload" (servlet multipart)
-  "/*" (servlet pichat))
 
-(send-off flusher flush!)
+(defn start-server
+  ([port] (run-server {:port port}
+                      "/static/*" (servlet static)
+                      "/images/*" (servlet static)
+                      "/upload" (servlet multipart)
+                      "/*" (servlet pichat)))
+  ([] (start-server 8080)))
+
+(start-server)
+(start-user-flusher!)
+(start-session-pruner!)
\ No newline at end of file