diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/image_utils.clj | 3 | ||||
| -rwxr-xr-x | src/site.clj | 181 |
2 files changed, 121 insertions, 63 deletions
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 b519f90..4db69e8 100755 --- a/src/site.clj +++ b/src/site.clj @@ -59,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 @@ -126,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))}) @@ -168,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 " "") @@ -187,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 " @@ -243,10 +246,9 @@ (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] (if-let [[nick expiry token-hash] (parse-login-token token)] @@ -254,15 +256,15 @@ (let [db-info (fetch-nick nick) computed-hash (sha1-hash (db-info :hash) expiry)] (if (= token-hash computed-hash) - db-info))))) + (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 @@ -310,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 @@ -392,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) @@ -502,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] @@ -549,7 +590,8 @@ (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))) @@ -582,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 @@ -620,6 +663,17 @@ (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) + "/avatars/*" (servlet static) + "/upload/*" (servlet multipart) + "/*" (servlet pichat)) + +(send-off flusher flush!) +======= (defn start-server ([port] (run-server {:port port} @@ -631,4 +685,5 @@ (start-server) (start-user-flusher!) -(start-session-pruner!)
\ No newline at end of file +(start-session-pruner!) +>>>>>>> 8003ba27e49a630b24090f3af01426f35e85af67 |