diff options
| -rwxr-xr-x | db/0-create.psql | 1 | ||||
| -rw-r--r-- | src/db_populate.clj | 96 | ||||
| -rw-r--r-- | src/origin_check.clj | 8 | ||||
| -rwxr-xr-x | src/site.clj | 98 | ||||
| -rwxr-xr-x | src/utils.clj | 15 | ||||
| -rwxr-xr-x | template/browser.st | 16 | ||||
| -rwxr-xr-x | template/chat.st | 12 | ||||
| -rw-r--r-- | template/directory.st | 32 | ||||
| -rw-r--r-- | template/topic_list.st | 57 |
9 files changed, 262 insertions, 73 deletions
diff --git a/db/0-create.psql b/db/0-create.psql index 0360d22..00ea012 100755 --- a/db/0-create.psql +++ b/db/0-create.psql @@ -44,6 +44,7 @@ CREATE TABLE favorites ( CREATE INDEX user_id_idx ON messages (user_id); CREATE INDEX room_id_idx ON messages (room_id); CREATE INDEX created_on_idx ON messages (created_on); +CREATE INDEX is_image_idx ON messages (is_image); CREATE INDEX src_user_id_idx ON favorites (src_user_id); CREATE INDEX favorites_created_on_idx on favorites (created_on); 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 fe78633..6efbd2f 100755 --- a/src/site.clj +++ b/src/site.clj @@ -15,14 +15,15 @@ clojure.contrib.sql clojure.contrib.str-utils compojure + origin-check utils cookie-login session-sweeper feed)) (def *run-flusher* true) -(def *flusher-sleep-ms* 4000) -(def *user-timeout-ms* 15000) +(def *flusher-sleep* (seconds 4)) +(def *user-timeout* (seconds 15)) (def template-group (new StringTemplateGroup "dumpfm" "template")) (.setRefreshInterval template-group 3) @@ -42,10 +43,10 @@ (dosync (let [users (room :users) now (System/currentTimeMillis) - alive? (fn [[n u]] (> (u :last-seen) (- now *user-timeout-ms*)))] + alive? (fn [[n u]] (> (u :last-seen) (- now *user-timeout*)))] (ref-set users (into {} (filter alive? @users)))))) - (Thread/sleep *flusher-sleep-ms*) + (Thread/sleep *flusher-sleep*) (when *run-flusher* (send *agent* #'flush-inactive-users!)) x) @@ -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 @@ -392,7 +394,7 @@ (def *directory-listing* (ref [])) (def *per-directory-page* 25) (def *run-update-directory* true) -(def *update-directory-sleep-ms* (* 60 60 1000)) +(def *update-directory-sleep* (minutes 15)) (defn directory-search [offset] (let [directory @*directory-listing* @@ -401,12 +403,15 @@ (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)")] + 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) @@ -414,21 +419,22 @@ (map (fn [u] (let [u-id (u :user_id)] (stringify-and-escape (merge u (dict u-id))))) - users))))) + users)) + []))) (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)) (defn update-directory-agent-func [x] (update-directory!) - (Thread/sleep *update-directory-sleep-ms*) + (Thread/sleep *update-directory-sleep*) (when *run-update-directory* (send *directory-agent* #'update-directory-agent-func)) x) @@ -436,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) @@ -444,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] @@ -823,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)) @@ -855,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 7abed4f..ea0176a 100755 --- a/src/utils.clj +++ b/src/utils.clj @@ -14,11 +14,14 @@ :password "root"})) -(defn kbytes [b] - (* b 1024)) +;; Misc -(defn mbytes [b] - (* b 1024 1024)) +(defn seconds [t] (* t 1000)) +(defn minutes [t] (* t 60 1000)) + +(defn kbytes [b] (* b 1024)) + +(defn mbytes [b] (* b 1024 1024)) ;; JSON responses @@ -47,6 +50,10 @@ (doall rs)))) :count)) +(defn do-delete [table query] + (with-connection *db* + (delete-rows table query))) + ;; Parsing (defn maybe-parse-int diff --git a/template/browser.st b/template/browser.st index e172d15..721bb98 100755 --- a/template/browser.st +++ b/template/browser.st @@ -18,17 +18,23 @@ var growlize = true; </script> - <style> iframe { z-index: 50000; position: fixed; top: 300px; right: 25px; + + width:100%; + height:100%; + padding:0px; + background-color: #fff; + position:absolute; + top:0px; left:0px; + border:none; } </style> - </head> <body> $banner()$ @@ -43,9 +49,9 @@ </div> <div id="messagePane"> <div id="messageList"> - <iframe src="/static/search/browser.html" style="width:100%;height:100%;padding:0px;background-color: #fff; position:absolute; top:0px; left:0px; border:none; allowtransparency="true" scrolling="auto" ></iframe> - - + <iframe src="/static/search/browser.html" + allowtransparency="true" + scrolling="auto" ></iframe> </div> </div> diff --git a/template/chat.st b/template/chat.st index 9dc7d3a..5ad8113 100755 --- a/template/chat.st +++ b/template/chat.st @@ -16,8 +16,6 @@ var IsAdmin = false; $endif$ </script> - <script type="text/javascript"> -</script> <script src="/static/away.js"></script> <script src="/static/js/ajaxupload.js"></script> <script> @@ -34,6 +32,13 @@ function pop(url) } </script> + <style> + #topic { + z-index: 5000; + display: inline; + background-color: white; + } + </style> </head> <body onload="MM_preloadImages('/static/thumbs_up_sm.gif')"> $banner()$ @@ -58,8 +63,7 @@ function pop(url) <div class="msgDiv oldmsg" id="message-$m.message_id$"><b> <a href="/u/$m.nick$">$m.nick$</a>: </b> - <span class="content">$m.content$ -</a><span> + <span class="content">$m.content$<span> <div id="faving" style="display:none;"> diff --git a/template/directory.st b/template/directory.st index 6604368..94fb2cb 100644 --- a/template/directory.st +++ b/template/directory.st @@ -12,10 +12,7 @@ </head> <body> $banner()$ - <div id="chatrap"> - - - + <div id="chatrap"> <div id="log"> <div id="loghead"></div> <br> @@ -24,18 +21,21 @@ <br> <center> - <h2> ✭ ✭ DUMP STARS ✭ ✭</h2> - <div id="lolbanner"> - <img src="/static/welcomebanner.gif"> - </div> - - </center> - - $if(users)$ - $users:{ u | - <div class="logged-dump"> - <a href="/u/$u.nick$"> - <b> $u.nick$</b> + <h2> ✭ ✭ DUMP STARS ✭ ✭</h2> + <div id="lolbanner"> + <img src="/static/welcomebanner.gif"> + </div> + + </center> + + $if(notloaded)$ + <div>Sorry, the directory is being updated. Refresh in a minute!</div> + $elseif(users)$ + + $users:{ u | + <div class="logged-dump"> + <a href="/u/$u.nick$"> + <b> $u.nick$</b> $if(u.avatar)$ <div id="logavatar"> <img height="50" width="50" src="$u.avatar$"></img></div> $endif$ diff --git a/template/topic_list.st b/template/topic_list.st new file mode 100644 index 0000000..dc7199e --- /dev/null +++ b/template/topic_list.st @@ -0,0 +1,57 @@ +<html> + <head> + <title>Topic List</title> + $head()$ + <script src="/static/js/topiclist.js"></script> + <style> + #main { + margin: 75px 2em 0 2em; + } + #main hr { margin-bottom: 0.5em; } + #main label { + display: inline-block; + width: 150px; + } + #main .deadline { + width: 100px; + } + </style> + </head> + <body> + $banner()$ + <div id="main"> + $rooms:{ r | + <div id="room-$r.key$" class="room-section"> + <h1>$r.key$</h1> + <hr> + + $if(r.topic)$ + <b>$r.topic$</b> by <b>$r.maker$</b> expires <b>$r.deadline$ </b> + $else$ + <span>No current topic!</span> + $endif$ + <br><br> + <div><label>New Topic</label><input type="text" name="topic"></div> + <div> + <label>Expires in</label> + <input type="text" class="deadline" name="hours"></input> hours, + <input type="text" class="deadline" name="minutes"></input> + <span>minutes</span> + <span class="deadline-update"> + </div> + <div><label>Maker</label><input type="text" name="maker" value="$user_nick$"></div> + <br> + <div> + <input class="set-topic" type="submit" value="Set new topic!"> + $if(r.topic)$ + <input class="end-topic" type="submit" value="End topic"> + $endif$ + <img class="spinner" src="/static/spinner.gif" style="display: none"/> + </div> + <br><br><br><br> + </div> + }$ + </div> + + </body> +</html> |