diff options
Diffstat (limited to 'src/site.clj')
| -rw-r--r-- | src/site.clj | 112 |
1 files changed, 65 insertions, 47 deletions
diff --git a/src/site.clj b/src/site.clj index d45aa09..d58406c 100644 --- a/src/site.clj +++ b/src/site.clj @@ -71,9 +71,6 @@ ;; Utils -(defn id [x] - x) - (defn open-file [dir-comps filename] (let [d (str-join (System/getProperty "file.separator") (cons *root-directory* dir-comps)) @@ -138,17 +135,6 @@ (defn strip-empty-vals [m] (into {} (filter (fn [[k v]] (non-empty-string? v)) m))) -(declare stringify-and-escape) -(defn escape-html-deep [o] - (if (map? o) - (stringify-and-escape o) - (if (seq? o) - (map escape-html-deep o) - (escape-html o)))) - -(defn stringify-and-escape [m] - (zipmap (map str* (keys m)) (map escape-html-deep (vals m)))) - (defn process-message-for-json [d] (assoc d :created_on (.getTime (d :created_on)))) @@ -156,7 +142,7 @@ (escape-html-deep (strip-empty-vals (if (contains? d :created_on) - (assoc d :created_on (.format formatter (d :created_on))) + (assoc d :created_on (format-timestamp (d :created_on))) d)))) (defn new-messages [room since-ts] @@ -225,14 +211,14 @@ (do-select [query nick *dumps-per-page* offset])))) -(defn fetch-public-message-by-id [id] +(defn fetch-public-message-by-id [m-id] (let [query "SELECT m.content, m.created_on, m.user_id, u.nick, u.avatar FROM messages m, users u, rooms r WHERE m.user_id = u.user_id AND r.room_id = m.room_id AND r.admin_only = false AND m.message_id = ?"] - (first (do-select [query (maybe-parse-int id -1)])))) + (first (do-select [query (maybe-parse-int m-id -1)])))) (defn build-room-map-from-db [room-db] {:admin_only (room-db :admin_only) @@ -287,19 +273,40 @@ ;; login-token functions (defn logged-in? - "Test whether user is logged in by presence of nick key in session." - [request] - (contains? (request :session) :nick)) + "Test whether user is logged in by presence of nick key in session. + (Apply to request map)" + [{session :session}] + (contains? session :nick)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Login-token version history +; +; v0: Format: nick%expiry%token-hash +; Date: Mists of dump antiquity +; +; v1: Format: v1%nick%expiry%token-hash +; Date: 2010/04/24 +; Note: Contains same information as v0, but created under the +; wildcard domain (i.e. ".dump.fm") so that logins work +; across all subdomains. (defn encode-login-token [nick hash expiry] (let [token-hash (sha1-hash hash expiry)] - (str nick "%" expiry "%" token-hash))) + (str "v1%" nick "%" expiry "%" token-hash))) + +(defn- parse-login-vec [v] + (try [(aget v 1) (Long/parseLong (aget v 2)) (aget v 3)] + (catch NumberFormatException _ nil))) (defn parse-login-token [token] - (let [x (.split token "\\%")] - (if (= (alength x) 3) - (try [(aget x 0) (Long/parseLong (aget x 1)) (aget x 2)] - (catch NumberFormatException _ nil))))) + ; If users have multiple login-cookies across different domains + ; (i.e. both "dump.fm" and ".dump.fm"), token will be a vector + ; instead of a string. + (if (not (string? token)) + (some identity (map parse-login-token token)) + (let [v (.split token "\\%")] + (if (and (= (alength v) 4) (= (aget v 0) "v1")) + (parse-login-vec v))))) (defn read-login-token [token] (if-let [[nick expiry token-hash] (parse-login-token token)] @@ -311,11 +318,11 @@ (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))))) + (let [expiration (ms-in-future *login-token-expiry*) + token (encode-login-token nick hash expiration)] + (set-cookie *login-token-key* token + :expires (gmt-string (new Date expiration)) + :domain ".dump.fm"))) ;; Landing @@ -340,7 +347,9 @@ (defn logout [session] [(session-dissoc :nick :user_id :is_admin :avatar) - (clear-login-token *login-token-key*) + (set-cookie *login-token-key* "dummy" + :expires "Thu, 01-Jan-1970 00:00:01 GMT" + :domain ".dump.fm") (redirect-to "/")]) ;; Registration @@ -584,8 +593,6 @@ (.setAttribute st "timestamp" now) (.toString st))) - - (defn validated-chat [session room-key template] (if (validate-room-access room-key session) (chat session (lookup-room room-key) template) @@ -619,10 +626,11 @@ (defn strip-params [s] (.replaceFirst s "\\?.*$" "")) +; TODO: is-image? has *long* been broken wrt messages w/ multiple image links. + (defn is-image? [content] - (if (and (re-find single-url-regex content) - (re-find pic-regex (strip-params content))) - true false)) + (boolean (and (re-find single-url-regex content) + (re-find pic-regex (strip-params content))))) (defn msg-db [user-id room-id content] (let [is-image (is-image? content) @@ -867,6 +875,14 @@ (or (is-file-too-big? f vip) (is-image-invalid? f))) + +; Upload notes: +; The webcam code doesn't feature an error handler, +; so all upload responses not equal to "OK" are considered +; errors. +; The upload code doesn't use jQuery.ajax, and doesn't JSON-eval +; responses. Therefore, return strings should not be JSON-encoded. + (defn do-upload [session image room] (if-let [err (validate-upload-file (image :tempfile) (is-vip? session))] (resp-error err) @@ -880,7 +896,7 @@ (dosync (add-message msg room)) (copy (:tempfile image) dest) - "OK")))) + [200 "OK"])))) (defn upload [session params] (let [room-key (params :room) @@ -889,13 +905,10 @@ image (params :image) mute ((poll *active-mutes*) user-id) has-access (validate-room-access room-key session)] - ; --TODO-- - ; Because ajaxupload.js doesn't feature an error-handler, - ; all responses not equal to "OK" signal errors. - (cond (not nick) (resp-success "NOT_LOGGED_IN") - (not image) (resp-success "INVALID_REQUEST") - mute (resp-success (format-mute mute)) - (not has-access) (resp-success "UNKNOWN_ROOM") + (cond (not nick) [200 "NOT_LOGGED_IN"] + (not image) [200 "INVALID_REQUEST"] + mute [200 (format-mute mute)] + (not has-access) [200 "UNKNOWN_ROOM"] :else (do-upload session image (lookup-room room-key))))) ;; N.B. -- Upload responses aren't JSON-evaluated @@ -987,8 +1000,9 @@ ;; Admin stuff (should be own route?) (GET "/debug" (debug-page session flash)) (POST "/debug" (debug-commmand! session params)) - (GET "/mute-status" (mute-status session)) + (GET "/mutes" (show-mutes session)) (POST "/mute" (mute! session params)) + (POST "/cancel-mute" (handle-cancel-mute! session params)) ;; Footer pages (GET "/about_us" (serve-template "about_us" session)) @@ -1023,15 +1037,19 @@ (decorate static (with-mimetypes {:mimetypes mimetypes})) +(def *session-cookie-params* {:type :memory + :expires (* 60 60) + :domain ".dump.fm"}) + (decorate pichat (with-mimetypes {:mimetypes mimetypes}) (with-cookie-login (comp not logged-in?) make-login-token read-login-token) - (with-session {:type :memory, :expires (* 60 60)})) + (with-session *session-cookie-params*)) (decorate multipart (with-mimetypes {:mimetypes mimetypes}) (with-cookie-login (comp not logged-in?) make-login-token read-login-token) - (with-session {:type :memory, :expires (* 60 60)}) + (with-session *session-cookie-params*) (with-multipart)) ;; Load messages from database |