From 5ccd9bb3bc8226dce71d5742bc612bcd65f5b17d Mon Sep 17 00:00:00 2001 From: Scott Ostler Date: Fri, 12 Mar 2010 09:20:41 -0500 Subject: Moved iframe style into css --- template/browser.st | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'template') 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; - - $banner()$ @@ -43,9 +49,9 @@

- - - +

-- cgit v1.2.3-70-g09d2 From f475c0a8d00fa860c53fb28b89ad8ff6eacb5352 Mon Sep 17 00:00:00 2001 From: Scott Ostler Date: Mon, 15 Mar 2010 22:35:40 -0400 Subject: src/origin_check.clj --- src/db_populate.clj | 96 ++++++++++++++++++++++++++++++++++++++++++++++++++ src/origin_check.clj | 9 +++++ template/topic_list.st | 57 ++++++++++++++++++++++++++++++ 3 files changed, 162 insertions(+) create mode 100644 src/db_populate.clj create mode 100644 src/origin_check.clj create mode 100644 template/topic_list.st (limited to 'template') 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..3dada54 --- /dev/null +++ b/src/origin_check.clj @@ -0,0 +1,9 @@ +(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] + (println (get-in request [:headers])) + (handler request))) \ No newline at end of file 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 @@ + + + Topic List + $head()$ + + + + + $banner()$ +

+ $rooms:{ r | +

$r.key$

+ + $if(r.topic)$ + $r.topic$ by $r.maker$ expires $r.deadline$ + $else$ + No current topic! + $endif$ +

+

New Topic

+ Expires in + hours, + + minutes + +

Maker

+
+

+ + $if(r.topic)$ + + $endif$ + +

+

+

+ }$ +

+ + + -- cgit v1.2.3-70-g09d2 From 4011f9dcc57678a24cefd7c06cfaeb3d53cc93c7 Mon Sep 17 00:00:00 2001 From: Scott Ostler Date: Mon, 15 Mar 2010 22:39:54 -0400 Subject: Directory query update --- src/site.clj | 83 ++++++++++++++++++++++++++++----------------------- template/directory.st | 4 ++- 2 files changed, 49 insertions(+), 38 deletions(-) (limited to 'template') diff --git a/src/site.clj b/src/site.clj index fe78633..29be221 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,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) @@ -417,11 +422,11 @@ 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)) @@ -436,7 +441,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 +449,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 +830,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 +864,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/template/directory.st b/template/directory.st index 7f78265..5953563 100644 --- a/template/directory.st +++ b/template/directory.st @@ -34,7 +34,9 @@

DUMP STARS

- $if(users)$ + $if(notloaded)$ +

Sorry, the directory is being updated. Refresh in a minute!

+ $elseif(users)$ $users:{ u |

-- cgit v1.2.3-70-g09d2 From 03076bcae8a7b3053624d2cc6c5cef8acf1b9680 Mon Sep 17 00:00:00 2001 From: Scott Ostler Date: Mon, 15 Mar 2010 22:42:26 -0400 Subject: Removed closing a tag --- template/chat.st | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) (limited to 'template') diff --git a/template/chat.st b/template/chat.st index 0d453d8..bfef310 100755 --- a/template/chat.st +++ b/template/chat.st @@ -15,8 +15,6 @@ var IsAdmin = false; $endif$ - + $banner()$ @@ -50,8 +55,7 @@

$m.nick$: - $m.content$ - + $m.content$