load testing code

8 files changed, 190 insertions, 9 deletions

diff --git a/bin/test.sh b/bin/test.sh
new file mode 100755
index 0000000..82acaa4
--- /dev/null
+++ b/bin/test.sh
@@ -0,0 +1,4 @@
+#!/bin/sh
+
+java -Xmx384m -server -cp lib/jline-0.9.94.jar:lib/clojure.jar:lib/clojure-contrib.jar:lib/postgresql-8.4-701.jdbc4.jar:lib/clojure-http-client-1.1.0.jar:test jline.ConsoleRunner clojure.main -i $1 -r $@
+
diff --git a/db/0-create.psql b/db/0-create.psql
index 01831e5..4725c08 100644
--- a/db/0-create.psql
+++ b/db/0-create.psql
@@ -91,7 +91,7 @@ CREATE TABLE feed_images (
   room text NOT NULL,
   message_id integer REFERENCES messages,
   queued_on timestamp NOT NULL DEFAULT now(),
-  UNIQUE (room, image_url)
+  PRIMARY KEY (room, image_url)
 );
 
 CREATE INDEX feed_images_url_room_idx ON feed_images (image_url, room);
@@ -101,7 +101,7 @@ CREATE TABLE invalid_feed_images (
   image_url text NOT NULL,
   reason text NOT NULL,
   added_on timestamp NOT NULL DEFAULT now(),
-  UNIQUE (image_url)
+  PRIMARY KEY (image_url)
 );
 
 CREATE INDEX invalid_feed_images_idx ON invalid_feed_images (image_url);
diff --git a/lib/clojure-http-client-1.1.0.jar b/lib/clojure-http-client-1.1.0.jar
new file mode 100644
index 0000000..4fbf842
--- /dev/null
+++ b/lib/clojure-http-client-1.1.0.jar
diff --git a/src/rooms.clj b/src/rooms.clj
index dd02219..c1b596b 100644
--- a/src/rooms.clj
+++ b/src/rooms.clj
@@ -36,7 +36,7 @@
   (= (lower-case key) *default-room*))
 
 (defn lookup-room [key]
-  (@rooms (lower-case key)))
+  (and key (@rooms (lower-case key))))
 
 (defn fetch-room [key]
   (first (do-select ["SELECT * FROM rooms WHERE key = LOWER(?) AND active" key])))
diff --git a/src/site.clj b/src/site.clj
index 8596021..a476638 100644
--- a/src/site.clj
+++ b/src/site.clj
@@ -497,10 +497,9 @@ FROM   users u
 (def *chat-version-number* 1)
 
 (defn validate-room-access [room-key session]
-  (let [room (lookup-room room-key)]
-    (and room
-         (or (not (room :admin_only))
-             (is-vip? session)))))
+  (if-let [room (lookup-room room-key)]
+    (or (not (room :admin_only))
+	(is-vip? session))))
 
 (defn chat [session room template]
   (let [now              (System/currentTimeMillis)
@@ -780,7 +779,6 @@ FROM   users u
 	avatar (:avatar user-info)
         url (str nick "/favorites")
         page-title (str nick "'s favorites")]
-    (println user-info)
     (tagged-dumps-template session params "favorite" url page-title :tag-user-id user-id :avatar avatar)))
 
 (defn json-favorites [session params]
@@ -990,6 +988,7 @@ FROM   users u
   (GET "/u/:nick/:offset" (profile session (params :nick) (params :offset)))
   
   (GET "/p/:nick/:postid" (single-message session (params :nick) (params :postid)))
+  ;; TODO: these shouldn't be GETs
   (GET "/login" (login session params cookies))
   (GET "/logout" (logout session))
   (GET "/register" (serve-static "static" "register.html"))
@@ -1112,4 +1111,5 @@ FROM   users u
 (start-user-flusher!)
 (start-session-pruner!)
 ;(start! feed-downloader)
- (start! feed-inserter)
+(start! feed-inserter)
+
diff --git a/src/utils.clj b/src/utils.clj
index b0941f6..3f1a7b1 100755
--- a/src/utils.clj
+++ b/src/utils.clj
@@ -224,6 +224,7 @@
 (defn url-decode [text]
   (URLDecoder/decode text "UTF-8"))
 
+; TODO: this duplicates str-utils, should be removed
 (defn #^String lower-case
   "Converts string to all lower-case."
   [#^String s]
diff --git a/test/dumpfm/load_test.clj b/test/dumpfm/load_test.clj
new file mode 100644
index 0000000..68eda68
--- /dev/null
+++ b/test/dumpfm/load_test.clj
@@ -0,0 +1,81 @@
+(ns dumpfm.load-test
+  (:import org.postgresql.ds.PGPoolingDataSource)
+  (:use clojure.contrib.json.read
+        clojure.contrib.json.write
+	clojure.contrib.seq-utils
+        clojure.contrib.sql
+        dumpfm.millstone))
+
+
+(let [db-host "localhost"
+      db-name "dumpfm"
+      db-user "postgres"
+      db-pass "root"]
+  (def *db* {:datasource (doto (new PGPoolingDataSource)
+                           (.setServerName   db-host)
+                           (.setDatabaseName db-name)
+                           (.setUser         db-user)
+                           (.setPassword     db-pass)
+                           (.setMaxConnections 3))}))
+
+(def userlist-query "
+select u.nick, u.hash
+from users u, messages m where u.user_id = m.user_id
+group by u.nick, u.hash 
+having count(*) > 50
+order by count(*) desc
+")
+
+(print "Fetching userlist: ")
+(def userlist (time
+               (with-connection *db*
+                 (with-query-results rs [userlist-query]
+		   (doall rs)))))
+
+
+(def sample-messages-query "
+select content
+from messages
+order by random()
+limit 100
+")
+
+(print "Fetching messages: ")
+(def message-contents (time
+		       (with-connection *db*
+			 (with-query-results rs [sample-messages-query]
+			   (doall (map :content rs))))))
+
+(defn login-client []
+  (let [user-info (rand-elt userlist)
+	params    (select-keys user-info [:nick :hash])]
+    (do-setup-request! "/login"
+		       :params params
+		       :method "GET")))
+
+(defn refresh []
+  (let [params {:since (- (System/currentTimeMillis) 2000)
+		:room  "test"}]
+    (do-request! "/refresh"
+		 :params params
+		 :method "GET")
+    (Thread/sleep 1000)))
+
+(defn post-msg []
+  (let [params {:content (rand-elt message-contents)
+		:room  "test"}]
+    (do-request! "/msg"
+		 :params params
+		 :method "POST")))
+
+(def test-spec {:server        "http://localhost:8080"
+                :clients       100
+                :requests      10000
+                :setup-func    login-client
+                :funcs        [[55 refresh]
+			       [5  post-msg]]
+                :frequency 1
+                })
+
+(grind! test-spec)
+(System/exit 0)
\ No newline at end of file
diff --git a/test/dumpfm/millstone.clj b/test/dumpfm/millstone.clj
new file mode 100644
index 0000000..e59bb61
--- /dev/null
+++ b/test/dumpfm/millstone.clj
@@ -0,0 +1,95 @@
+(ns dumpfm.millstone
+  (:use clojure.contrib.def
+	clojure.contrib.seq-utils
+	clojure-http.client))
+
+(def *spec*)
+(def *cookies*)
+
+(def printer (agent nil))
+
+(defn log [& args]
+  (send printer (fn [_] (apply println args))))
+
+(defmacro with-timing [e]
+  `(let [s# (System/nanoTime)
+         r# ~e
+         f# (System/nanoTime)]
+     [(float (/ (- f# s#) 1e6)) r#]))
+
+(defn do-base-request [server path method cookies params]
+  (let [method (.toUpperCase method)
+	url    (str server path)]
+    (if (= method "GET")
+      (request (add-query-params url params) method nil cookies)
+      (request url method nil cookies params))))
+
+(defnk do-setup-request! [path
+			  :params nil
+			  :method "GET"]
+  (let [res (do-base-request (:server *spec*) path method *cookies* params)]
+    (if (:cookies res)
+      (set! *cookies* (merge *cookies* (:cookies res))))
+    res))
+
+(defnk do-request! [path
+		    :params nil
+		    :method :GET]
+  (let [[time res] (with-timing
+		     (do-base-request (:server *spec*)
+				      path
+				      method
+				      *cookies*
+				      params))]
+    (log (format "%s - %sms [%s %s]" path time (:code res) (:msg res)))
+    (if (:cookies res)
+      (log "should set cookies" (:cookies res)))
+    res))
+
+(defn build-client! [spec client-id]
+  (binding [*cookies*   {}]
+    (if (:setup-func spec)
+      ((:setup-func spec)))
+    {:client-id client-id
+     :cookies   *cookies*}))
+
+(defn print-run-results [spec elapsed]
+  (log (format "\nFinished\n--------\n%s runs in %s s (%s r/s)\n%s clients"
+	       (:requests spec)
+	       (/ elapsed 1000)
+	       (/ (:requests spec) elapsed 1000)
+	       (:clients spec))))
+
+(defn build-func-list [routes]
+  (flatten (for [[n f] routes]
+	     (repeat n f))))
+
+(defn grind! [spec]
+  (binding [*spec* spec]
+    (let [clients (doall
+		   (for [id (range (:clients spec))]
+		     (build-client! spec id)))
+	  funcs     (build-func-list (:funcs spec))
+	  results   (atom [])
+	  counter   (atom (:requests spec))
+	  threads (doall
+		   (for [c clients]
+		     (Thread.
+		      (fn []
+			(log "starting thread" (:client-id c))
+			(binding [*spec* spec
+				  *cookies* (:cookies c)]
+			  (loop []
+			    (if (> (swap! counter dec) 0)
+			      (let [f (rand-elt funcs)]
+				(f)
+				(recur))))
+			  (log "finishing thread" (:client-id c)))))))]
+      (println "Finished setup")
+      (let [[elapsed _] (with-timing
+			  (do
+			    (doseq [t threads]
+			      (.start t))
+			    (doseq [t threads]
+			      (.join t))))]
+	(print-run-results spec elapsed)))))