Merged

4 files changed, 155 insertions, 38 deletions

diff --git a/src/db_populate.clj b/src/db_populate.clj
new file mode 100644
index 0000000..5d47d13
--- /dev/null
+++ b/src/db_populate.clj
@@ -0,0 +1,96 @@
+(ns db-populate
+  (:import java.lang.Math)
+  (:require [clojure.contrib.generic.collection :as gc])
+  (:use clojure.contrib.sql
+        clojure.contrib.probabilities.finite-distributions
+        clojure.contrib.probabilities.monte-carlo
+        clojure.contrib.probabilities.random-numbers
+        utils))
+
+(def *num-users* 500)
+(def *mean-posts-per-user* 200)
+(def *std-dev-posts-per-user* 1.5)
+(def *image-msg-frequency* 0.5)
+(def *nick-prefix* "user")
+(def *sample-message-sentences*
+     ["Aim at new love victories",
+      "Bomb her womb from your huge battleship",
+      "Face your new mate without fear",
+      "Get armed for a new love battle",
+      "Upgrade your weapon used to make love"])
+
+(defn sample-unit []
+  (first (gc/seq rand-stream)))
+
+(defn sample-lognormal [mean sigma]
+  (first (gc/seq (random-stream (lognormal (Math/log mean) sigma)
+                                rand-stream))))
+
+(defn rand-elt [coll]
+  (nth coll (rand-int (count coll))))
+
+(defn nick-func [i]
+  (str *nick-prefix* "-" i "-" (System/currentTimeMillis)))
+
+(defn hash-func [i]
+  (str "HASH"))
+
+(defn email-func [i]
+  (str *nick-prefix* "-" i "@" i ".com"))
+
+(defn make-user [label]
+  (println "Creating user" label)
+  (let [qry (str "INSERT INTO users (nick, hash, email) "
+                 "VALUES (?, ?, ?) RETURNING user_id")
+        nick  (nick-func label)
+        hash  (hash-func label)
+        email (email-func label)
+        res   (do-select [qry nick hash email])]
+    ((first res) :user_id)))
+
+(defn sample-text-msg []
+  (rand-elt *sample-message-sentences*))
+
+(defn sample-image-msg []
+  "http://localhost:8080/images/20100310/1268271054246-abc-b7413897775a39087737d54768adca55d3c97cf4.jpeg")
+
+(defn sample-msg-contents []
+  (if (<= *image-msg-frequency* (sample-unit))
+    [(sample-image-msg) true]
+    [(sample-text-msg) false]))
+
+(defn sample-room-id []
+  1)
+
+(defn make-messages [user-id]
+  (let [num-msgs (int (sample-lognormal *mean-posts-per-user* 
+                                        *std-dev-posts-per-user*))]
+    (println "Creating" num-msgs "messages for userid" user-id)
+    (doseq [i (range num-msgs)]
+      (let [[content is-image] (sample-msg-contents)
+            room-id            (sample-room-id)
+            qry                (str "INSERT INTO messages "
+                                    "(user_id, room_id, content, is_image) "
+                                    "VALUES (?, ?, ?, ?) RETURNING message_id")]
+        (do-select [qry user-id room-id content is-image])))))
+        
+(defn populate [n-str]
+  (let [n (Integer/parseInt n-str)]
+    (doall (map (comp make-messages make-user) (range n)))))
+
+(defn clear []
+  (println "Clearing all users starting with" *nick-prefix*)
+  (let [params ["nick LIKE ?" (str *nick-prefix* "%")]
+        cnt (first (do-delete "users" params))]
+    (println "Cleared" cnt "users")))
+    
+(def *command-map* {"populate" populate "clear" clear})
+
+(defn parse-command-args
+  ([] (prn "Usage: db_populate.clj command num"))
+  ([cmd-str & more]
+     (if-let [cmd (*command-map* cmd-str)]
+       (apply cmd more)
+       (println "Unknown command '" cmd-str "'"))))
+
+(apply parse-command-args (rest *command-line-args*))
\ No newline at end of file
diff --git a/src/origin_check.clj b/src/origin_check.clj
new file mode 100644
index 0000000..a24e43b
--- /dev/null
+++ b/src/origin_check.clj
@@ -0,0 +1,8 @@
+(ns origin-check)
+
+(defn with-origin-check
+  "Middleware to validate that state-changing URL access
+   originated from a page in the local domain."
+  [handler]
+  (fn [request]
+    (handler request)))
\ No newline at end of file
diff --git a/src/site.clj b/src/site.clj
index a57cf16..6efbd2f 100755
--- a/src/site.clj
+++ b/src/site.clj
@@ -15,6 +15,7 @@
         clojure.contrib.sql
         clojure.contrib.str-utils
         compojure
+        origin-check
         utils
         cookie-login
         session-sweeper
@@ -183,42 +184,42 @@
 (def *dumps-per-page* 20)
 
 (defn count-messages-by-room [room-id image-only]
-  (let [query (str "SELECT COUNT(*) "
-		   "FROM messages m, users u "
-		   "WHERE room_id = ? AND m.user_id = u.user_id "
-		   (if image-only "AND m.is_image = true " ""))]
+  (let [query (str "SELECT COUNT(*)
+		    FROM messages m, users u
+		    WHERE room_id = ? AND m.user_id = u.user_id"
+		   (if image-only " AND m.is_image = true " ""))]
     (do-count [query room-id])))
 
 (defn fetch-messages-by-room
   ([room-id image-only] (fetch-messages-by-room room-id image-only 0))
   ([room-id image-only offset]
-     (let [query (str "SELECT m.content, m.message_id, m.created_on, u.nick, u.avatar "
-		      "FROM messages m, users u "
-		      "WHERE room_id = ? AND m.user_id = u.user_id "
+     (let [query (str "SELECT m.content, m.message_id, m.created_on, u.nick, u.avatar
+		       FROM messages m, users u
+		       WHERE room_id = ? AND m.user_id = u.user_id "
                       (if image-only "AND m.is_image = true " "")
-		      "ORDER BY created_on DESC "
-		      "LIMIT " *dumps-per-page* " OFFSET ?")]
-       (do-select [query room-id offset]))))
+                      "ORDER BY created_on DESC
+		       LIMIT ? OFFSET ?")]
+       (do-select [query room-id *dumps-per-page* offset]))))
 
 (defn count-messages-by-nick [nick image-only]
-  (let [query (str "SELECT COUNT(*) "
-		   "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 "
+  (let [query (str "SELECT COUNT(*)
+		    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])))
 
 (defn fetch-messages-by-nick 
   ([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, u.avatar "
-                      "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 "
+     (let [query (str "SELECT m.content, m.created_on, u.nick, u.avatar
+                       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 ?")]
-       (do-select [query nick offset]))))
+                      "ORDER BY created_on DESC
+                       LIMIT ? OFFSET ?")]
+       (do-select [query nick *dumps-per-page* offset]))))
 
 (defn build-room-map-from-db [room-db]
   {:admin_only (room-db :admin_only)
@@ -253,12 +254,13 @@
    :is_admin (user-info :is_admin)
    :avatar (user-info :avatar)})
 
-(defn session-assoc-from-db 
+(defn session-assoc-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)))
+		 :avatar (user-info :avatar)
+                 :password_login true))
 
 ;; login-token functions
 
@@ -401,13 +403,16 @@
                       (min (count directory)
                            (* (inc offset) *per-directory-page*)))
         user-ids (apply str (interpose ", " (map #(%1 :user_id) users)))
-        qry (str "SELECT u.user_id, u.nick, u.avatar, m.content "
-                 "FROM users u, messages m "
-                 "WHERE u.user_id in (" user-ids ") "
-                 "AND m.user_id = u.user_id "
-                 "AND m.created_on = (select max(created_on) from messages "
-                 "                    where user_id = u.user_id)")]
-    (if (> (count user-ids) 0)
+        qry (str "SELECT u.user_id, u.nick, u.avatar, m.content
+                  FROM users u, messages m
+                  WHERE u.user_id in (" user-ids ")
+                  AND m.user_id = u.user_id
+                  AND m.message_id = (SELECT message_id FROM messages 
+                           WHERE user_id = u.user_id
+                           AND room_id = 1
+                           AND is_image = true
+                           ORDER BY created_on LIMIT 1)")]
+    (when (> (count user-ids) 0)
       (let [res (do-select [qry])
             keys (map :user_id res)           
             dict (zipmap keys res)]
@@ -418,11 +423,11 @@
       [])))
            
 (defn update-directory! []
-  (let [qry (str "SELECT u.user_id, COUNT(m) as cnt "
-                 "FROM users u, messages m "
-                 "WHERE u.user_id = m.user_id "
-                 "GROUP BY u.user_id "
-                 "ORDER BY COUNT(m) DESC")
+  (let [qry "SELECT u.user_id, COUNT(m) as cnt
+             FROM users u, messages m
+             WHERE u.user_id = m.user_id
+             GROUP BY u.user_id
+             ORDER BY COUNT(m) DESC"
         res (vec (do-select [qry]))]
     (dosync (ref-set *directory-listing* res))
     res))
@@ -437,7 +442,7 @@
 (defn start-directory-updater! []
   (send *directory-agent* update-directory-agent-func))
 
-(defn directory [session offset]
+(defn directory [session offset]    
   (let [st (fetch-template "directory" session)
         users (to-array (directory-search offset))]
     (.setAttribute st "users" users)
@@ -445,8 +450,10 @@
           (= offset 1) (.setAttribute st "prev" "")
           :else (.setAttribute st "prev" (str "/" (dec offset))))
     (.setAttribute st "next" (str "/" (inc offset)))
+    (if (zero? (count @*directory-listing*))
+      (.setAttribute st "notloaded" true))
     (.toString st)))
-
+  
 ;; Topics
 
 (defn valid-topic? [topic]
@@ -824,11 +831,13 @@
   (with-mimetypes {:mimetypes mimetypes}))
 
 (decorate pichat
+  (with-origin-check)
   (with-mimetypes {:mimetypes mimetypes})
   (with-cookie-login (comp not logged-in?) make-login-token read-login-token)
   (with-session {:type :memory, :expires (* 60 60)}))
 
 (decorate multipart
+  (with-origin-check)
   (with-mimetypes {:mimetypes mimetypes})
   (with-session {:type :memory, :expires (* 60 60)})
   (with-multipart))
@@ -856,7 +865,7 @@
 
 (def options (apply parse-command-args *command-line-args*))
 
+(start-server (options :port))
 (start-user-flusher!)
 (start-session-pruner!)
 (start-directory-updater!)
-(start-server (options :port))
\ No newline at end of file
diff --git a/src/utils.clj b/src/utils.clj
index 9a95430..ea0176a 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -50,6 +50,10 @@
 	      (doall rs))))
    :count))
 
+(defn do-delete [table query]
+  (with-connection *db*
+    (delete-rows table query)))
+
 ;; Parsing
 
 (defn maybe-parse-int