resolved merge

3 files changed, 143 insertions, 74 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/image_utils.clj b/src/image_utils.clj
new file mode 100644
index 0000000..638cd05
--- /dev/null
+++ b/src/image_utils.clj
@@ -0,0 +1,3 @@
+(ns image-utils
+  (:import javax.imageio.ImageIO))
+
diff --git a/src/site.clj b/src/site.clj
index fb78a9b..4db69e8 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -13,8 +13,10 @@
         clojure.contrib.json.write
         clojure.contrib.sql
         compojure
+        utils
         cookie-login
-        utils))
+        session-sweeper
+        feed))
 
 (def *run-flusher* true)
 (def *flusher-sleep-ms* 4000)
@@ -33,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)
@@ -43,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*
@@ -54,9 +59,11 @@
     "http://localhost:8080"))
 
 (def *image-directory* "images")
+(def *avatar-directory* "avatars")
 
-; Create image directory if it doesn't exist.
+; Create image directories if they don't exist.
 (.mkdir (new File *image-directory*))
+(.mkdir (new File *avatar-directory*))
 
 ;; Utils
 
@@ -121,6 +128,7 @@
 
 (defn process-message-for-output [d]
   {"nick" (escape-html (d :nick))
+   "avatar" (escape-html (d :avatar))
    "message_id" (d :message_id)
    "created_on" (.format formatter (d :created_on))
    "content" (escape-html (d :content))})
@@ -163,7 +171,7 @@
 (defn fetch-messages-by-room
   ([room-id image-only] (fetch-messages-by-room room-id image-only 0))
   ([room-id image-only offset]
-     (let [query (str "SELECT m.content, m.message_id, m.created_on, u.nick "
+     (let [query (str "SELECT m.content, m.message_id, m.created_on, u.nick, u.avatar "
 		      "FROM messages m, users u "
 		      "WHERE room_id = ? AND m.user_id = u.user_id "
                       (if image-only "AND m.is_image = true " "")
@@ -182,7 +190,7 @@
 (defn fetch-messages-by-nick 
   ([nick image-only] (fetch-messages-by-nick nick image-only 0))
   ([nick image-only offset]
-     (let [query (str "SELECT m.content, m.created_on, u.nick "
+     (let [query (str "SELECT m.content, m.created_on, u.nick, u.avatar "
                       "FROM messages m, users u, rooms r "
                       "WHERE m.user_id = u.user_id AND u.nick = ? "
                       "AND r.room_id = m.room_id AND r.admin_only = false "
@@ -238,22 +246,25 @@
 
 (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))))
-
+    (if (= (alength x) 3)
+      (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)
+          (select-keys db-info [:user_id :nick :is_admin :avatar]))))))
 
 (defn make-login-token
   [{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)))))
+    (set-cookie *login-token-key* 
+                (encode-login-token nick hash expiration)
+                :expires 
+                (gmt-string (new Date expiration)))))
 
 ;; Landing
 
@@ -301,45 +312,51 @@
 ;; Profile
 
 (defn profile [session profile-nick offset]
-  (let [user-info (fetch-nick profile-nick)]
-    (if user-info
-      (let [nick (session :nick)
-            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*)
-            dumps (fetch-messages-by-nick profile-nick true dump-offset)
-	    dump-count (count-messages-by-nick profile-nick true)
-            st (fetch-template "profile" session)]
-        (do
-          (.setAttribute st "is_home" is-home)
-          (doseq [a [:nick :avatar :contact :bio]]
-            (let [v (user-info a)]
-              (.setAttribute st (name a)
-                             (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)
-	    (.setAttribute st "next" (inc offset)))
-	  (if (not= offset 0)
-	    (.setAttribute st "prev" (max (dec offset) 0)))
+  (if-let [user-info (fetch-nick profile-nick)]
+    (let [nick (session :nick)
+          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*)
+          dumps (fetch-messages-by-nick profile-nick true dump-offset)
+          dump-count (count-messages-by-nick profile-nick true)
+          st (fetch-template "profile" session)]
+      (do
+        (.setAttribute st "is_home" is-home)
+        (doseq [a [:nick :avatar :contact :bio]]
+          (let [v (user-info a)]
+            (.setAttribute st (name a)
+                           (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)
+          (.setAttribute st "next" (inc offset)))
+        (if (not= offset 0)
+          (.setAttribute st "prev" (max (dec offset) 0)))
         (.toString st)))
-      (resp-error "NO_USER"))))
+    (resp-error "NO_USER")))
+
+
+(defn update-user-db [user-id attr val]
+  (with-connection db
+    (update-values "users" ["user_id = ?" user-id] {attr val})))
+
+(defn download-avatar [session url]
+  (let [url false]
+    (update-user-db (session :user_id) "avatar" url)
+    (resp-success url)))
 
 (defn update-profile [session params]
   (let [user-id (session :user_id)
         attr (params :attr)
         val (params :val)
         attr-set #{"avatar" "contact" "bio"}]
-    (if (and user-id attr val 
-             (contains? attr-set attr))
-      (do
-        (with-connection db
-          (update-values "users" ["user_id = ?" user-id] {attr val}))
-        (if (= attr "avatar")
-          [(session-assoc :avatar val) "OK"]
-          "OK"))
-      (resp-error "BAD_REQUEST"))))
+    (cond (not user-id)                   (resp-error "MUST_LOGIN")
+          (not (and user-id attr val))    (resp-error "BAD_REQUEST")
+          (not (contains? attr-set attr)) (resp-error "BAD_REQUEST")
+          (= attr "avatar")               (download-avatar session val)
+          :else (do (update-user-db user-id attr val)
+                    (resp-success "OK")))))
 
 ;; Chat
 
@@ -383,11 +400,12 @@
          nick (session :nick)
          users (room :users)]
      (if nick
-       (if (contains? @users nick)
-         (alter users assoc-in [nick :last-seen] now)
-         (alter (room :users) assoc nick (user-struct-from-session session))))
-     (resp-success (assoc (updates room since)
-                     :timestamp now)))))
+       (if-let [user-info (@users nick)]
+         ; Incorporate avatar updates
+         (commute users assoc nick (merge user-info {:last-seen now
+                                                     :avatar (session :avatar)}))
+         (commute (room :users) assoc nick (user-struct-from-session session))))
+     (resp-success (assoc (updates room since) :timestamp now)))))
 
 (defn validated-refresh [session params]
   (let [room-key (params :room)
@@ -493,32 +511,64 @@
 
 ;; Upload
 
+(def *avatar-dimensions* [50 50])
+
+(defn is-image-file? [path]
+  true)
+
 (defn format-filename [s]
   (let [spaceless (.replace s \space \-)
         subbed (re-gsub #"[^\w.-]" "" spaceless)]
     (str (System/currentTimeMillis) "-" subbed)))
 
-(defn image-url-from-file [f]
-  (str-join "/" [*server-url* "images" (.getName f)]))
+(defn image-url-from-file [d f] 
+  (str-join "/" [*server-url* d (.getName f)]))
+
 
 (defn do-upload [session image room]
   (let [filename (format-filename (:filename image))
         dest (File. (rel-join *image-directory* filename))
-        url (image-url-from-file dest)
+        url (image-url-from-file "images" dest)
         msg-id (msg-db (session :user_id) (room :room_id) url)
-        now (new Date)
-        msg (struct message-struct (session :nick) url now msg-id)]
-    (dosync
-     (add-message msg room))
-    (copy (:tempfile image) dest)
-    [200 url]))
+        msg (struct message-struct (session :nick) url (new Date) msg-id)]
+    (do 
+      (dosync
+       (add-message msg room))
+      (copy (:tempfile image) dest)
+      (resp-success url))))
 
 (defn upload [session params]
   (let [room-key (params :room)
-        nick (session :nick)]
+        nick (session :nick)
+        image (params :image)]
     (cond (not nick) [200 "NOT_LOGGED_IN"]
+          (not image) [200 "INVALID_REQUEST"]
+          (not (is-image-file? (image :filename))) [200 "INVALID_IMAGE"]
           (not (validate-room-access room-key session)) [200 "UNKNOWN_ROOM"]
-          :else (do-upload session (:image params) (@rooms room-key)))))
+          :else (do-upload session image (@rooms room-key)))))
+
+(defn copy-and-resize [image dest]
+  ; TODO: resize
+  (copy image dest))
+
+;; N.B. -- Upload responses aren't JSON-evaluated
+(defn do-upload-avatar [session image]
+  (let [filename (format-filename (:filename image))
+        dest (File. (rel-join *avatar-directory* filename))
+        url (image-url-from-file "avatars" dest)]
+    (do
+      (copy-and-resize (:tempfile image) dest)
+      (update-user-db (session :user_id) "avatar" url)
+      [(session-assoc :avatar url)
+       [200 url]])))
+
+(defn upload-avatar [session params]
+  (let [image (params :image)]
+    (cond (not image) [200 "INVALID_REQUEST"]
+          (not (session :nick)) [200 "NOT_LOGGED_IN"]
+          (not (is-image-file? (image :filename))) [200 "INVALID_IMAGE"]
+          :else (do-upload-avatar session image))))
+
 ;; 404
 
 (defn unknown-page [params]
@@ -533,15 +583,15 @@
 (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)]))
 
 (defroutes static
   (GET "/static/*" (serve-static "static" (params :*)))
-  (GET "/images/*" (serve-static *image-directory* (params :*))))
+  (GET "/images/*" (serve-static *image-directory* (params :*)))
+  (GET "/avatars/*" (serve-static *avatar-directory* (params :*))))
 
 (defroutes pichat
   (GET "/" (no-cache (landing session)))
@@ -574,7 +624,8 @@
   (ANY "*" (unknown-page params)))
 
 (defroutes multipart
-  (POST "/upload" (upload session params)))
+  (POST "/upload/message" (upload session params))
+  (POST "/upload/avatar" (upload-avatar session params)))
 
 ;; Add jpeg to list
 (def mimetypes
@@ -612,11 +663,27 @@
  (doseq [room-db (fetch-rooms)]
    (alter rooms assoc (room-db :key)
           (build-room-map-from-db room-db))))
+<<<<<<< HEAD
   
 (run-server {:port 8080}
   "/static/*" (servlet static)
   "/images/*" (servlet static)
-  "/upload" (servlet multipart)
+  "/avatars/*" (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!)
+>>>>>>> 8003ba27e49a630b24090f3af01426f35e85af67