Password reset feature

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))