Added additional rooms

1 files changed, 119 insertions, 53 deletions

diff --git a/src/site.clj b/src/site.clj
index 50a382b..fb7e7a9 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -25,8 +25,10 @@
 (defstruct user-struct :nick :user_id :avatar :last-seen)
 (defstruct message-struct :nick :content :created_on)
 
-(def users (ref {}))
-(def messages (ref []))
+(def rooms (ref {}))
+
+;(def users (ref {}))
+;(def messages (ref []))
 
 (def run-flusher true)
 (def flusher-sleep-ms 4000)
@@ -37,11 +39,13 @@
 (defn flush! [x]
   (when run-flusher
     (send-off *agent* #'flush!))
-  (dosync
-   (let [now (System/currentTimeMillis)
-         alive? (fn [[n u]] (> (u :last-seen) (- now user-timeout-ms)))]
-     (ref-set users
-              (into {} (filter alive? @users)))))
+  (doseq [[rid room] @rooms]
+    (dosync
+     (let [users ((ensure room) :users)
+           now (System/currentTimeMillis)
+           alive? (fn [[n u]] (> (u :last-seen) (- now user-timeout-ms)))]
+       (ref-set users
+                (into {} (filter alive? @users))))))
   (. Thread (sleep flusher-sleep-ms))
   x)
 
@@ -82,7 +86,12 @@
 	    (with-query-results rs query
 	      (doall rs))))
    :count))
-   
+
+;; Room handling
+
+(defn fetch-rooms []
+  (do-select ["SELECT * FROM ROOMS"]))
+
 ;; User authentication
 
 (def nick-regex #"^[A-Za-z0-9\-_∆˚†]*$")
@@ -111,11 +120,11 @@
    "content" (encode-html-entities (d :content))})
 
 (defn new-messages 
-  ([since-ts]
+  ([room since-ts]
      (let [since-date (new Date (long since-ts))]
        (reverse (take-while (fn [m] (.after (m :created_on) since-date)) 
-			    @messages))))
-  ([] (reverse (take 25 @messages))))
+			    @(room :messages)))))
+  ([room] (reverse (take 25 @(room :messages)))))
 
 (defn process-user [u]
   (if (u :avatar)   
@@ -123,15 +132,15 @@
      "avatar" (encode-html-entities (u :avatar))}
     {"nick" (u :nick)}))
 
-(defn prepare-user-list []
+(defn prepare-user-list [room]
   (map process-user (sort-by #(% :nick)
-			     (vals @users))))
+			     (vals @(room :users)))))
 
 (defn updates
-  ([] {"users" (prepare-user-list)
-       "messages" (map process-message-for-json (new-messages))})
-  ([since] {"users" (prepare-user-list)
-            "messages" (map process-message-for-json (new-messages since))}))
+  ([room] {"users" (prepare-user-list room)
+           "messages" (map process-message-for-json (new-messages room))})
+  ([room since] {"users" (prepare-user-list room)
+                 "messages" (map process-message-for-json (new-messages room since))}))
 
 (def dumps-per-page 20)
 
@@ -158,8 +167,9 @@
 
 (defn count-messages-by-nick [nick image-only]
   (let [query (str "SELECT COUNT(*) "
-		   "FROM messages m, users u "
+		   "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 "
 		   (if image-only "AND m.is_image = true " ""))]
     (do-count [query nick])))
 
@@ -167,8 +177,9 @@
   ([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 "
-                      "FROM messages m, users u "
+                      "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 "
                       (if image-only "AND m.is_image = true " "")
                       "ORDER BY created_on DESC "
                       "LIMIT " dumps-per-page " OFFSET ?")]
@@ -192,6 +203,7 @@
 (defn populate-session-from-db [user-info]
   (session-assoc :user_id (user-info :user_id)
 		 :nick (user-info :nick)
+                 :is_admin (user-info :is_admin)
 		 :avatar (user-info :avatar)))
 
 (defn landing [session]
@@ -235,6 +247,8 @@
 (defn non-empty-string? [s]
   (and s (> (count s) 0)))
 
+
+; TODO: hide admin-only rooms from profile
 (defn profile [session profile-nick offset]
   (let [user-info (fetch-nick profile-nick)]
     (if user-info
@@ -246,7 +260,6 @@
             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]]
@@ -283,39 +296,60 @@
   (struct user-struct (session :nick) (session :user_id) (session :avatar)
           (System/currentTimeMillis)))
 
-(defn chat [session]
+(defn chat [session room]
   (let [now (System/currentTimeMillis)
         nick (session :nick)
         st (fetch-template "chat" session)
         message-list (to-array
                       (map process-message-for-output
-                           (reverse (fetch-messages-by-room 1 false))))]
+                           ; TODO: remove db query
+                           (reverse (fetch-messages-by-room (room :room_id) false))))]
     (if nick
       (dosync
-       (alter users assoc nick (user-struct-from-session session))))
-    (let [user-list (to-array (prepare-user-list))]
+       (alter (room :users) assoc nick (user-struct-from-session session))))
+    (let [user-list (to-array (prepare-user-list room))]
       (.setAttribute st "users" user-list))
     (.setAttribute st "messages" message-list)
+    (.setAttribute st "roomkey" (room :key))
+    (.setAttribute st "json_room_key" (json-str (room :key)))
+    (.setAttribute st "roomname" (room :name))
     (.setAttribute st "json_user_nick" (if nick (json-str nick) "null"))
     (if nick
       (.toString st)
       [(session-assoc :last-seen now)
        (.toString st)])))
 
-(defn refresh [session]
-  (let [nick (session :nick)
-        now (System/currentTimeMillis)]
-    (if (or nick (session :last-seen))
-      (dosync
-       (if (contains? (ensure users) nick)
+(defn validated-chat [session room-key]
+  (let [room (@rooms room-key)]
+    (if (and room
+             (or (not (room :admin-only)) (session :is_admin)))
+      (chat session room)
+      (resp-error "UNKNOWN_ROOM"))))
+
+; TODO: handle anonymous users in multiple rooms        
+(defn refresh [session params room]
+  (dosync
+   (let [now (System/currentTimeMillis)
+         nick (session :nick)
+         users (room :users)]
+      (if (or nick (session :last-seen))       
+       (if (contains? @users nick)
          (let [last-seen (get-in @users [nick :last-seen])]
            (alter users assoc-in [nick :last-seen] now)
-           (resp-success (updates last-seen)))
+           (resp-success (updates room last-seen)))
          (let [last-seen (session :last-seen)]
            [(session-assoc :last-seen now)
-            (resp-success (updates last-seen))])))
+            (resp-success (updates room last-seen))])))
       (resp-error "NOT_IN_CHAT"))))
 
+(defn validated-refresh [session params]
+  (let [room-key (params :room)
+        room (@rooms room-key)]
+    (if (and room
+             (or (not (room :admin-only)) (session :is_admin)))
+      (refresh session params room)
+      (resp-error "UNKNOWN_ROOM"))))
+
 ;; http://snippets.dzone.com/posts/show/6995
 (def single-url-regex #"(?i)^((http\:\/\/|https\:\/\/|ftp\:\/\/)|(www\.))+(\w+:{0,1}\w*@)?(\S+)(:[0-9]+)?(\/|\/([\w#!:.?+=&%@!\-\/]))?$")
 (def pic-regex #"(?i)\.(jpg|jpeg|png|gif|bmp)$")
@@ -328,12 +362,13 @@
            (re-find pic-regex (strip-params content)))
     true false))
 
-(defn msg-transaction [nick msg]
+(defn msg-transaction [nick msg room]
   (dosync
-   (and (contains? (ensure users) nick)
-        (alter messages (swap cons) msg))))
-            
+   (and (contains? (ensure (room :users)) nick)
+        (alter (room :messages) (swap cons) msg)
+        true)))
 
+; TODO: validate user
 (defn msg-db [user-id room-id msg]
   (let [content (.trim (msg :content))
         is-image (is-image? content)]
@@ -345,33 +380,50 @@
 (defn msg [session params]
    (let [user-id (session :user_id)
          nick (session :nick)
+         room-key (params :room)
+         room (@rooms room-key)
          content (.trim (params :content))
          now (new Date)
          msg (struct message-struct nick content now)]
-     (if (msg-transaction nick msg)
-       (do
-         (msg-db user-id 1 msg)
-         (resp-success "OK"))
-       (resp-error "MUST_LOGIN"))))
+     (cond (not room) (resp-error "BAD_ROOM")
+           (not (msg-transaction nick msg room)) (resp-error "MUST_LOGIN")
+           :else (do (msg-db user-id (room :room_id) msg)
+                     (resp-success "OK")))))
+
+(defn validated-msg [session params]
+  (let [room-key (params :room)
+        room (@rooms room-key)]
+    (if (and room
+             (or (not (room :admin-only)) (session :is_admin)))
+      (msg session params)
+      (resp-error "UNKNOWN_ROOM"))))
 
 ;; Chat Log
 
-; TODO: Optimize log counts
+; TODO: Optimize dump counts
 
-(defn log [session offset]
+(defn log [session room offset]
   (let [st (fetch-template "log" session)
 	offset (maybe-parse-int offset 0)
         dump-offset (* offset dumps-per-page)
 	dumps (to-array (map process-message-for-output
-			     (fetch-messages-by-room 1 true dump-offset)))
-	dump-count (count-messages-by-room 1 true)]
+			     (fetch-messages-by-room (room :room_id) true dump-offset)))
+	dump-count (count-messages-by-room (room :room_id) true)]
     (if (< (+ dump-offset dumps-per-page) dump-count)
       (.setAttribute st "next" (inc offset)))
     (if (not= offset 0)
       (.setAttribute st "prev" (max (dec offset) 0)))
     (.setAttribute st "dumps" dumps)
+    (.setAttribute st "roomkey" (room :key))
+    (.setAttribute st "roomname" (room :name))
     (.toString st)))
 
+(defn validated-log [session room-key offset]
+  (let [room (@rooms room-key)]
+    (if room
+      (log session room offset)
+      (resp-error "UNKNOWN_ROOM"))))
+
 ;; Upload
 
 (defn upload [session params]
@@ -398,12 +450,17 @@
   (GET "/logout" (logout session))
   (GET "/register" (serve-file "static" "register.html"))
   (GET "/submit-registration" (register session params))
-  (GET "/chat" (no-cache (chat session)))
-  (GET "/refresh" (refresh session))
-  (GET "/msg" (msg session params))
-  (GET "/log" (log session "0"))
-  (GET "/log/" (log session "0"))
-  (GET "/log/:offset" (log session (-> request :route-params :offset)))
+  (GET "/:room/chat" (no-cache (validated-chat session (-> request :route-params :room))))
+  (GET "/chat" (no-cache (validated-chat session "RoomA")))
+  (GET "/refresh" (validated-refresh session params))
+  (GET "/msg" (validated-msg session params))
+  (GET "/log" (validated-log session "RoomA" "0"))
+  (GET "/:room/log" (validated-log session 
+                                   (-> request :route-params :room)
+                                   "0"))
+  (GET "/:room/log/:offset" (validated-log session
+                                           (-> request :route-params :room)
+                                           (-> request :route-params :offset)))
   (GET "/upload" (upload session))
   (ANY "*" [404 "Page not found"]))
 
@@ -413,9 +470,18 @@
 
 
 ;; Load messages from database
-(dosync
- (ref-set messages (fetch-messages-by-room 1 false)))
 
+(dosync
+ (doseq [room-db (fetch-rooms)]
+   (alter rooms assoc (room-db :key)
+          {:admin-only (room-db :admin_only)
+           :room_id (room-db :room_id)
+           :key (room-db :key)
+           :name (room-db :name)
+           :description (room-db :description)
+           :users (ref {})
+           :messages (ref (fetch-messages-by-room (room-db :room_id) false))})))
+  
 (run-server {:port 8080}
   "/*" (servlet pichat))