diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/admin.clj | 22 | ||||
| -rw-r--r-- | src/email.clj | 8 | ||||
| -rw-r--r-- | src/image_utils.clj | 3 | ||||
| -rw-r--r-- | src/site.clj | 176 | ||||
| -rw-r--r-- | src/user.clj | 42 | ||||
| -rwxr-xr-x | src/utils.clj | 59 |
6 files changed, 187 insertions, 123 deletions
diff --git a/src/admin.clj b/src/admin.clj index f0b6453..76e690a 100644 --- a/src/admin.clj +++ b/src/admin.clj @@ -4,6 +4,7 @@ (:use compojure email scheduled-agent + user utils)) ;; Muting @@ -105,9 +106,6 @@ WHERE mute_id = ? AND cancelled = false ") -(defn- assert-update [res ok err] - (if (zero? (first res)) err ok)) - (defn cancel-mute! [mute-id admin-id] (let [mute (fetch-mute mute-id) active (nor (:expired mute) (:cancelled mute)) @@ -152,6 +150,9 @@ AND cancelled = false ;; Debug Page +(defn error-header [& text] + (html [:h2 {"color" "red"} text])) + (defn exception-to-string [e] (let [sw (java.io.StringWriter.) pw (java.io.PrintWriter. sw)] @@ -171,6 +172,7 @@ AND cancelled = false st (fetch-template "debug" session)] (.setAttribute st "flash" (:msg flash)) (.setAttribute st "mailtemps" (lookup-templates "template/mail" "welcome")) + (.setAttribute st "resettemps" (lookup-templates "template/mail" "reset")) (.toString st)))) (defn debug-reg-email [session params] @@ -179,14 +181,22 @@ AND cancelled = false (params :template)) (str "Sent registration mail to " (params :to))) -(defn debug-reset-email [session params] - ) +(defn debug-reset-email [session {nick :nick to :to template :template}] + (if-let [info (fetch-nick nick)] + (let [nick (info :nick) + hash (info :hash) + ts (System/currentTimeMillis) + token (reset-token nick hash ts) + link (reset-link nick token ts)] + (do (send-reset-email nick to link template) + (str "Send reset email to " to))) + (error-header "Unknown user " nick))) (def *debug-action-map* {"regemail" debug-reg-email "resetemail" debug-reset-email}) (defn format-unknown-action [action] - (html [:h2 {"color" "red"} ["Unknown action " action]])) + (error-header "Unknown action " action)) (defn format-debug-exception [action e] (html diff --git a/src/email.clj b/src/email.clj index 1124f48..e2a5f1f 100644 --- a/src/email.clj +++ b/src/email.clj @@ -82,9 +82,11 @@ (let [[s b] (parse-mail-template temp {"nick" nick})] (dump-mail [email] s b)))) -(defn send-reset-email [nick email key] - (let [[s b] (parse-mail-template "reset" {"nick" nick "key" key})] - (dump-mail [email] s b))) +(defn send-reset-email + ([nick email link temp] + (let [[s b] (parse-mail-template temp {"nick" nick "link" link})] + (dump-mail [email] s b))) + ([nick email link] (send-reset-email nick email link "reset"))) (defn send-mute-email [user-nick admin-nick reason duration] (let [subject (format "%s was muted by %s for %s" diff --git a/src/image_utils.clj b/src/image_utils.clj deleted file mode 100644 index 638cd05..0000000 --- a/src/image_utils.clj +++ /dev/null @@ -1,3 +0,0 @@ -(ns image-utils - (:import javax.imageio.ImageIO)) - diff --git a/src/site.clj b/src/site.clj index f48f560..7848dcb 100644 --- a/src/site.clj +++ b/src/site.clj @@ -20,7 +20,8 @@ session-sweeper feed tags - scheduled-agent)) + scheduled-agent + user)) (def *run-flusher* true) (def *flusher-sleep* (seconds 4)) @@ -240,12 +241,13 @@ (defn session-assoc-from-db [user-info] - (session-assoc :user_id (user-info :user_id) - :nick (user-info :nick) - :email (user-info :email) - :is_admin (user-info :is_admin) - :avatar (user-info :avatar) - :password_login true)) + (session-assoc + :user_id (user-info :user_id) + :nick (user-info :nick) + :email (user-info :email) + :is_admin (user-info :is_admin) + :avatar (user-info :avatar) + :password_login true)) ;; login-token functions @@ -348,9 +350,9 @@ (> (count (do-select [query (lower-case nick)])) 0)))) (defn register [session params] - (let [nick (params :nick) - email (params :email) - hash (params :hash) + (let [nick (params :nick) + email (params :email) + hash (params :hash) invalid-nick-reason (is-invalid-nick? nick)] (cond invalid-nick-reason (resp-error invalid-nick-reason) (nick-reserved? nick) (resp-error "NICK_TAKEN") @@ -507,43 +509,42 @@ ORDER BY msg_count DESC") "maker" (topic :maker)})) (defn validate-topic-list [session] - (if (is-vip? session) - (let [st (fetch-template "topic_list" session)] - (.setAttribute st "rooms" - (map topic-map-from-room (vals @rooms))) - (.toString st)) - [404 "UNKNOWN_ROOM"])) + (if-vip + (let [st (fetch-template "topic_list" session)] + (.setAttribute st "rooms" + (map topic-map-from-room (vals @rooms))) + (.toString st)))) (defn set-topic! [room topic deadline maker] (dosync (ref-set (room :topic) - {:topic topic + {:topic topic :deadline deadline - :maker maker}))) + :maker maker}))) (defn end-topic! [room] (dosync (ref-set (room :topic) nil))) (defn validate-set-topic [session params] - (let [room (lookup-room (params :room)) - topic (params :topic) - deadline (params :deadline) - maker (params :maker)] - (cond (not (is-vip? session)) (resp-error "NOT_VIP") - (not (valid-topic? topic)) (resp-error "INVALID_TOPIC") - (not (valid-deadline? deadline)) (resp-error "INVALID_DEADLINE") - (not room) (resp-error "INVALID_ROOM") - (not maker) (resp-error "NOT_MAKER") - :else (do - (set-topic! room topic deadline maker) - (resp-success "OK"))))) + (if-vip + (let [room (lookup-room (params :room)) + topic (params :topic) + deadline (params :deadline) + maker (params :maker)] + (cond (not (valid-topic? topic)) (resp-error "INVALID_TOPIC") + (not (valid-deadline? deadline)) (resp-error "INVALID_DEADLINE") + (not room) (resp-error "INVALID_ROOM") + (not maker) (resp-error "NOT_MAKER") + :else (do + (set-topic! room topic deadline maker) + (resp-success "OK")))))) (defn validate-end-topic [session params] - (let [room (lookup-room (params :room))] - (cond (not (is-vip? :is_admin)) (resp-error "NOT_VIP") - (not room) (resp-error "INVALID_ROOM") - :else (do - (end-topic! room) - (resp-success "OK"))))) + (if-vip + (if-let [room (lookup-room (params :room))] + (do + (end-topic! room) + (resp-success "OK")) + (resp-error "INVALID_ROOM")))) ;; Chat @@ -678,13 +679,12 @@ ORDER BY msg_count DESC") (.setAttribute st "json_user_nick" (if nick (json-str nick) "null")) (.setAttribute st "roomname" (room :name)) (.setAttribute st "timestamp" now) + (.setAttribute st "version" *chat-version-number*) (.toString st))) ;; Chat Log -; TODO: Optimize dump counts -; timb: ^^ done... i changed it to fetch one more than is shown per page to determine if next page is needed (defn log [session room offset params] (let [st (fetch-template "log" session) logger (make-time-logger) @@ -816,22 +816,45 @@ ORDER BY msg_count DESC") ;; Account resets -(defn reset-request-page [session] - (.toString (fetch-template "reset_request.st" session))) +(defn reset-request! [session {nick :nick}] + (if-let [info (fetch-nick nick)] + (let [email (info :email) + hash (info :hash) + ts (System/currentTimeMillis) + token (reset-token nick hash ts) + link (reset-link nick token ts)] + (do (send-reset-email nick email link) + (resp-success "OK"))) + (resp-error "NO_NICK"))) -(defn reset-account-request! [session params] - ) +(defn reset-page [session params] + (let [st (fetch-template "reset" session) + nick (params :nick) + ts (maybe-parse-long (params :ts) 0) + token (params :token) + valid (valid-reset-link? nick token ts)] + (.setAttribute st "valid_request" valid) + (.setAttribute st "nick" nick) + (when valid + (.setAttribute st "link" (reset-link nick token ts))) + (.toString st))) -(defn reset-account! [session key] - ) +(defn reset-account! [session params] + (let [nick (params :nick) + ts (maybe-parse-long (params :ts) 0) + token (params :token) + hash (params :hash)] + (if (and (valid-reset-link? nick token ts) hash) + (let [info (fetch-nick nick)] + (update-nick-hash nick hash) + [(session-assoc-from-db info) + (redirect-to "/")]) + [200 "BAD_REQUEST"]))) ;; Upload - -(def *max-image-height* 2000) -(def *max-image-width* 2000) -(def *max-avatar-height* 2000) -(def *max-avatar-width* 2000) +(def *max-image-dimensions* [2000 2000]) +(def *max-avatar-dimensions* [2000 2000]) (def *vip-max-file-size* (mbytes 5)) ; don't be nuts guys (def *max-file-size* (kbytes 750)) (def *ignore-size-limit-for-vip* true) @@ -847,15 +870,15 @@ ORDER BY msg_count DESC") (if (> (.length f) limit) (str "FILE_TOO_BIG " limit)))) -(defn is-image-invalid? [f] +(defn invalid-image-dimensions? [f [max-width max-height]] (try (let [i (ImageIO/read f) height (.getHeight i) width (.getWidth i)] - (if (or (> width *max-image-width*) - (> height *max-image-height*)) - (str "INVALID_RESOLUTION " *max-image-width* " " *max-image-height*))) - (catch Exception _ "FILE_NOT_IMAGE"))) + (if (or (> width max-width) + (> height max-height)) + (str "INVALID_RESOLUTION " max-width " " max-height))) + (catch Exception _ "INVALID_IMAGE"))) (defn format-filename [s nick] (let [spaceless (.replace s \space \-) @@ -868,7 +891,7 @@ ORDER BY msg_count DESC") (defn validate-upload-file [f vip] (or (is-file-too-big? f vip) - (is-image-invalid? f))) + (invalid-image-dimensions? f *max-image-dimensions*))) ; Upload notes: @@ -920,19 +943,15 @@ ORDER BY msg_count DESC") (defn upload-avatar [session params] (let [image (params :image)] - (cond (not image) [200 "INVALID_REQUEST"] + (cond (not image) [200 "INVALID_REQUEST"] (not (session :nick)) [200 "NOT_LOGGED_IN"] :else (do-upload-avatar session image)))) ;; Compojure Routes -(defn no-cache [resp] - [{:headers {"Cache-Control" "no-cache, no-store, max-age=0, must-revalidate"}} - resp]) - (defn serve-static [dir path] - ; TODO: cache policy for other static files (js, css, etc.) + ; TODO: cache other static files (js, css, etc.) (let [cache-header (if (re-find pic-regex path) {:headers {"Cache-Control" "max-age=604800,public"}} {})] @@ -940,12 +959,12 @@ ORDER BY msg_count DESC") (serve-file dir path)])) (defroutes static - (GET "/static/*" (serve-static "static" (params :*))) - (GET "/images/*" (serve-static *image-directory* (params :*))) + (GET "/static/*" (serve-static "static" (params :*))) + (GET "/images/*" (serve-static *image-directory* (params :*))) (GET "/avatars/*" (serve-static *avatar-directory* (params :*)))) (defroutes pichat - (GET "/" (no-cache (landing session))) + (GET "/" (landing session)) (GET "/favicon.ico" (serve-static "static" "favicon.ico")) (GET "/u/:nick" (profile session (params :nick) "0")) (GET "/u/:nick/" (profile session (params :nick) "0")) @@ -954,16 +973,17 @@ ORDER BY msg_count DESC") (GET "/u/:nick/favorites" (favorites session params)) (GET "/u/:nick/favorites/:offset" (favorites session params)) (GET "/json/:nick/favorites" (json-favorites session params)) - (GET "/u/:nick/:offset" (profile session - (params :nick) - (params :offset))) ; have to put this route after favs + + ; have to put this route after favs + (GET "/u/:nick/:offset" (profile session (params :nick) (params :offset))) + (GET "/p/:nick/:postid" (single-message session (params :nick) (params :postid))) (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) "chat"))) - (GET "/chat" (no-cache (validated-chat session "dumpfm" "chat"))) - (GET "/chat/:t" (no-cache (validated-chat session "dumpfm" (-> request :route-params :t)))) + (GET "/:room/chat" (validated-chat session (params :room) "chat")) + (GET "/chat" (validated-chat session "dumpfm" "chat")) + (GET "/chat/:t" (validated-chat session "dumpfm" (params :t))) (GET "/browser" (browser session)) (GET "/refresh" (validated-refresh session params)) (GET "/tag/:tag" (tagged-dumps session params (request-url request))) @@ -971,12 +991,8 @@ ORDER BY msg_count DESC") (POST "/cmd/tag/add" (validated-add-tag session params)) (POST "/cmd/tag/rm" (validated-remove-tag session params)) (GET "/log" (validated-log session "dumpfm" "0" params)) - (GET "/:room/log" (validated-log session - (-> request :route-params :room) - "0" params)) - (GET "/:room/log/:offset" (validated-log session - (-> request :route-params :room) - (-> request :route-params :offset) + (GET "/:room/log" (validated-log session (params :room) "0" params)) + (GET "/:room/log/:offset" (validated-log session (params :room) (params :offset) params)) ;; TODO: add form tokens for all destructive actions (POST "/msg" (validated-msg session params)) @@ -987,10 +1003,10 @@ ORDER BY msg_count DESC") (POST "/end-topic" (validate-end-topic session params)) (GET "/directory" (directory session 0)) (GET "/directory/:offset" - (directory session (maybe-parse-int (-> request :route-params :offset) 0))) - (GET "/reset" (reset-request-page session)) - (POST "/reset-request" (reset-account-request! session params)) - (POST "/reset/:key" (reset-account! session (-> request :route-params :key))) + (directory session (maybe-parse-int (params :offset) 0))) + (POST "/reset-request" (reset-request! session params)) + (GET "/reset" (reset-page session params)) + (POST "/reset" (reset-account! session params)) ;; Admin stuff (should be own route?) (GET "/debug" (debug-page session flash)) diff --git a/src/user.clj b/src/user.clj new file mode 100644 index 0000000..9d3060f --- /dev/null +++ b/src/user.clj @@ -0,0 +1,42 @@ +(ns user + (:use compojure + utils)) + +(def *nick-regex* #"^[A-Za-z0-9\-_∆˚†]*$") + +(defn is-invalid-nick? [n] + (cond + (< (count n) 3) "NICK_TOO_SHORT" + (not (re-matches *nick-regex* n)) "NICK_INVALID_CHARS")) + +(defn fetch-nick [nick] + (let [q1 "SELECT * FROM users WHERE nick = ? LIMIT 1" + ; ORDER BY ensures consistent retrieval of ambiguious names + q2 "SELECT * FROM users WHERE lower(nick) = ? ORDER BY nick LIMIT 1"] + (or (first-or-nil (do-select [q1 nick])) + (first-or-nil (do-select [q2 (lower-case nick)]))))) + +(defn authorize-nick-hash [nick hash] + (let [db-user (fetch-nick nick)] + (and db-user (= (db-user :hash) hash) db-user))) + +(defn update-nick-hash [nick hash] + (if (not (assert-update + (do-update :users ["nick=?" nick] + {:hash hash}))) + ; TODO: logging + (println (format "Error updating hash for %s" nick)))) + + +(defn reset-token [nick hash ts] + (sha1-hash nick hash ts)) + +(defn reset-link [nick token ts] + (url-params "http://dump.fm/reset" {"nick" nick + "ts" ts + "token" token})) + +(defn valid-reset-link? [nick token ts] + (if-let [info (fetch-nick nick)] + (and (= token (reset-token (info :nick) (info :hash) ts)) + (>= ts (ms-ago (days 2))))))
\ No newline at end of file diff --git a/src/utils.clj b/src/utils.clj index f42746c..628e4b8 100755 --- a/src/utils.clj +++ b/src/utils.clj @@ -56,7 +56,12 @@ :else s)) (defn seconds [t] (* t 1000)) -(defn minutes [t] (* t 60 1000)) +(defn minutes [t] (* 60 (seconds t))) +(defn hours [t] (* 60 (minutes t))) +(defn days [t] (* 24 (hours t))) + +(defn ms-ago [ms] + (- (System/currentTimeMillis) ms)) (defn kbytes [b] (* b 1024)) (defn mbytes [b] (* b 1024 1024)) @@ -72,12 +77,12 @@ (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)))) +(defmacro with-timing [e] + `(let [s# (System/nanoTime) + r# ~e + f# (System/nanoTime)] + [(int (/ (- f# s#) 1000000.0)) r#])) + ;; Formatters @@ -123,6 +128,13 @@ [k (f v)] [k v])))) +(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)))) + ;; JSON responses (defmethod print-json Date @@ -168,6 +180,10 @@ (with-connection *db* (insert-values table cols values))) +(defn assert-update + ([res ok err] (if (not (= (first res) 1)) err ok)) + ([res] (assert-update res true false))) + ;; Parsing (defn maybe-parse-int @@ -197,43 +213,24 @@ (def template-group (new StringTemplateGroup "dumpfm" "template")) (.setRefreshInterval template-group 3) -;; TODO: handle exception +; TODO: handle exception, clean-up template setting (defn fetch-template [template session] (let [st (.getInstanceOf template-group template)] (if (session :nick) (do (.setAttribute st "user_email" (session :email)) (.setAttribute st "user_nick" (session :nick)) - (if (non-empty-string? (session :avatar)) (.setAttribute st "user_avatar" (session :avatar))) - (.setAttribute st "isadmin" (session :is_admin)))) ;; TODO: consolidate session/user code + (if (non-empty-string? (session :avatar)) + (.setAttribute st "user_avatar" (session :avatar))) + (.setAttribute st "isadmin" (session :is_admin)))) st)) (defn serve-template [template session] (.toString (fetch-template template session))) - -;; User authentication -; TODO: create user module - (defn first-or-nil [l] (if (empty? l) nil (first l))) -(def nick-regex #"^[A-Za-z0-9\-_∆˚†]*$") - -(defn is-invalid-nick? [n] - (cond - (< (count n) 3) "NICK_TOO_SHORT" - (not (re-matches nick-regex n)) "NICK_INVALID_CHARS")) - -(defn fetch-nick [nick] - (let [q1 "SELECT * FROM users WHERE nick = ? LIMIT 1" - ; ORDER BY ensures consistent retrieval of ambiguious names - q2 "SELECT * FROM users WHERE lower(nick) = ? ORDER BY nick LIMIT 1"] - (or (first-or-nil (do-select [q1 nick])) - (first-or-nil (do-select [q2 (lower-case nick)]))))) - -(defn authorize-nick-hash [nick hash] - (let [db-user (fetch-nick nick)] - (and db-user (= (db-user :hash) hash) db-user))) +;; VIP (defn is-vip? [session] (session :is_admin)) |