xmas work

1 files changed, 87 insertions, 51 deletions

diff --git a/src/site.clj b/src/site.clj
index 063bc59..3f8fa48 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -22,7 +22,7 @@
 (def template-group (new StringTemplateGroup "dumpfm" "template"))
 (.setRefreshInterval template-group 3)
 
-(defstruct user-struct :user-id :nick :last-seen)
+(defstruct user-struct :user_id :nick :avatar :last-seen)
 (defstruct message-struct :nick :content :created_on)
 
 (def users (ref {}))
@@ -30,7 +30,7 @@
 
 (def run-flusher true)
 (def flusher-sleep-ms 4000)
-(def user-timeout-ms 5000)
+(def user-timeout-ms 15000)
 
 (def flusher (agent nil))
 
@@ -64,15 +64,12 @@
 
 (def formatter (new SimpleDateFormat "h:mm EEE M/d"))
 
-;;;;;
-
 (defn resp-error [message]
   {:status 400 :headers {} :body message})
 
 (defn resp-success [message]
   {:status 200 :headers {} :body (json-str message)})
 
-
 ;; Database
 
 (defn do-select [query]
@@ -82,14 +79,20 @@
 
 ;; User authentication
 
+(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 [query "SELECT * FROM users WHERE nick = ?"]
+  (let [query "SELECT * FROM users WHERE nick = ? LIMIT 1"]
     (first (do-select [query nick]))))
 
 (defn authorize-nick-hash [nick hash]
   (let [db-user (fetch-nick nick)]
-    (if (and db-user (= (db-user :hash) hash))
-      db-user false)))
+    (and db-user (= (db-user :hash) hash) db-user)))
 
 ;; Message handling
 
@@ -97,30 +100,40 @@
   (assoc d :created_on (.getTime (d :created_on))))
 
 (defn process-message-for-output [d]
-  (let [avatar (d :avatar)]
-    {"nick" (encode-html-entities (d :nick))
-     "created_on" (.format formatter (d :created_on))
-     "content" (encode-html-entities (d :content))}))
+  {"nick" (encode-html-entities (d :nick))
+   "created_on" (.format formatter (d :created_on))
+   "content" (encode-html-entities (d :content))})
 
 (defn new-messages 
   ([since-ts]
      (let [since-date (new Date (long since-ts))]
-       (reverse (take-while (fn [m] (.after (m :created_on) since-date)) @messages))))
+       (reverse (take-while (fn [m] (.after (m :created_on) since-date)) 
+			    @messages))))
   ([] (reverse (take 25 @messages))))
 
+(defn process-user [u]
+  {"nick" (u :nick)
+   "avatar" (encode-html-entities (u :avatar))})
+
+(defn prepare-user-list []
+  (map process-user (sort-by #(% :nick)
+			     (vals @users))))
+
 (defn updates
-  ([] {"users" (sort (keys @users)) 
+  ([] {"users" (prepare-user-list)
        "messages" (map process-message-for-json (new-messages))})
-  ([since] {"users" (sort (keys @users)) 
+  ([since] {"users" (prepare-user-list)
             "messages" (map process-message-for-json (new-messages since))}))
 
-(defn fetch-messages-by-room [room-id]
-  (let [query (str "SELECT m.content, m.created_on, u.nick " 
-                   "FROM messages m, users u "
-                   "WHERE room_id = ? AND m.user_id = u.user_id "
-                   "ORDER BY created_on DESC "
-                   "LIMIT 20")]
-    (do-select [query room-id])))
+(defn fetch-messages-by-room
+  ([room-id] (fetch-messages-by-room room-id 1))
+  ([room-id offset]
+     (let [query (str "SELECT m.content, m.created_on, u.nick "
+		      "FROM messages m, users u "
+		      "WHERE room_id = ? AND m.user_id = u.user_id "
+		      "ORDER BY created_on DESC "
+		      "LIMIT 20 OFFSET ?")]
+       (do-select [query room-id offset]))))
 
 (defn fetch-messages-by-nick [nick image-only]
   (let [query (str "SELECT m.content, m.created_on, u.nick "
@@ -146,6 +159,11 @@
 
 ;; Landing
 
+(defn populate-session-from-db [user-info]
+  (session-assoc :user_id (user-info :user_id)
+		 :nick (user-info :nick)
+		 :avatar (user-info :avatar)))
+
 (defn landing [session]
   (let [nick (session :nick)]
     (if nick
@@ -157,18 +175,12 @@
         hash (params :hash)
         db-user (authorize-nick-hash nick hash)]
     (if db-user
-      (dosync
-       (let [user-struct (struct user-struct (db-user :user_id) ; DB naming
-                                 nick (System/currentTimeMillis))]
-         (alter users assoc nick user-struct)
-         [(session-assoc :user-id (db-user :user_id) 
-                         :nick nick 
-                         :avatar (db-user :avatar))
-          (resp-success "OK")]))
+      [(populate-session-from-db db-user)
+       (resp-success "OK")]
       (resp-error "BAD_LOGIN"))))
 
 (defn logout [session]
-  [(session-dissoc :nick :user-id)
+  [(session-dissoc :nick :user_id)
    (redirect-to "/")])
 
 ;; Registration
@@ -176,14 +188,17 @@
 (defn register [session params]
   (let [nick (params :nick)
         email (params :email)
-        hash (params :hash)]
-    (if (fetch-nick nick)
-      (resp-error "NICK_TAKEN")
-      (with-connection db
-        (insert-values :users 
-                       [:nick :hash :email]
-                       [nick hash email])
-        (resp-success "OK")))))
+        hash (params :hash)
+	invalid-nick-reason (is-invalid-nick? nick)]
+    (cond invalid-nick-reason (resp-error invalid-nick-reason)
+	  (fetch-nick nick) (resp-error "NICK_TAKEN")
+	  :else (with-connection db
+		  (insert-values :users
+				 [:nick :hash :email]
+				 [nick hash email])
+		  (let [db-user (fetch-nick nick)]
+		    [(populate-session-from-db db-user)
+		     (resp-success "OK")])))))
 
 ;; Profile
 
@@ -210,7 +225,7 @@
       (resp-error "NO_USER"))))
 
 (defn update-profile [session params]
-  (let [user-id (session :user-id)
+  (let [user-id (session :user_id)
         attr (params :attr)
         val (params :val)
         attr-set #{"avatar" "contact" "bio"}]
@@ -226,20 +241,24 @@
 
 ;; Chat
 
+(defn user-struct-from-session [session]
+  {:nick (session :nick)
+   :user_id (session :user_id)
+   :avatar (session :avatar)
+   :last-seen (System/currentTimeMillis)})
+
 (defn chat [session]
   (let [now (System/currentTimeMillis)
         nick (session :nick)
-        user-id (session :user-id)
         st (fetch-template "chat" session)
         message-list (to-array
                       (map process-message-for-output
                            (reverse (fetch-messages-by-room 1))))]
     (if nick
       (dosync
-       (let [user-struct (struct user-struct user-id nick now)]
-         (alter users assoc nick user-struct))))
-    (.setAttribute st "users" (map encode-html-entities 
-                                   (sort (keys @users))))
+       (alter users assoc nick (user-struct-from-session session))))
+    (let [user-list (to-array (prepare-user-list))]
+      (.setAttribute st "users" user-list))
     (.setAttribute st "messages" message-list)
     (.setAttribute st "json_user_nick" (if nick (json-str nick) "null"))
     (if nick
@@ -259,23 +278,24 @@
          (let [last-seen (session :last-seen)]
            [(session-assoc :last-seen now)
             (updates last-seen)])))
-      ; TODO: session should store room-id of anon. users
+      ; TODO: better handle anonymous users
       (resp-error "NOT_IN_CHAT"))))
 
 ;; http://snippets.dzone.com/posts/show/6995
-(def url-regex #"((http\:\/\/|https\:\/\/|ftp\:\/\/)|(www\.))+(\w+:{0,1}\w*@)?(\S+)(:[0-9]+)?(\/|\/([\w#!:.?+=&%@!\-\/]))?")
-(def pic-regex #"^.*\.(jpg|jpeg|png|gif|bmp)$")
+(def single-url-regex #"^((http\:\/\/|https\:\/\/|ftp\:\/\/)|(www\.))+(\w+:{0,1}\w*@)?(\S+)(:[0-9]+)?(\/|\/([\w#!:.?+=&%@!\-\/]))$")
+(def pic-regex #"\.(jpg|jpeg|png|gif|bmp)")
 
 (defn is-image? [content]
+ ; TODO: trim content, strip params
  (let [lower-content (.toLowerCase content)]
-   (if (and (re-matches url-regex lower-content)
+   (if (and (re-matches single-url-regex lower-content)
             (re-matches pic-regex lower-content))
      true false)))
 
 (defn msg-transaction [nick msg]
   (dosync
    (and (contains? (ensure users) nick)
-        (do (alter messages (swap cons) msg) 
+        (do (alter messages (swap cons) msg)
             true))))
 
 (defn msg-db [user-id room-id msg]
@@ -287,7 +307,7 @@
                      [user-id room-id content is-image]))))
 
 (defn msg [session params]
-   (let [user-id (session :user-id)
+   (let [user-id (session :user_id)
          nick (session :nick)
          content (.trim (params :content))
          now (new Date)
@@ -298,6 +318,21 @@
          (resp-success "OK"))
        (resp-error "MUST_LOGIN"))))
 
+;; Chat Log
+
+(defn maybe-parse-int [s f]
+  (if s (Integer/parseInt s) f))
+
+(defn log [session params]
+  (let [st (fetch-template "log" session)
+	offset (maybe-parse-int (params :offset) 1)
+	dumps (to-array (map process-message-for-output
+			     (fetch-messages-by-room 1 offset)))]
+    (.setAttribute st "dumps" dumps)
+    (.toString st)))
+
+;; Upload
+
 (defn upload [session params]
     "TODO")
 
@@ -315,6 +350,7 @@
   (GET "/chat" (chat session))
   (GET "/refresh" (refresh session))
   (GET "/msg" (msg session params))
+  (GET "/log" (log session params))
   (GET "/upload" (upload session))
   (ANY "*" [404 "Page not found"]))