diff options
Diffstat (limited to 'src/site.clj')
| -rw-r--r-- | src/site.clj | 116 |
1 files changed, 83 insertions, 33 deletions
diff --git a/src/site.clj b/src/site.clj index 9759462..713dc9d 100644 --- a/src/site.clj +++ b/src/site.clj @@ -8,6 +8,7 @@ org.apache.commons.codec.digest.DigestUtils javax.servlet.http.Cookie org.antlr.stringtemplate.StringTemplateGroup) + (:require [clojure.contrib.str-utils2 :as s]) (:use clojure.xml clojure.contrib.command-line clojure.contrib.duck-streams @@ -90,6 +91,11 @@ (.setTimeZone df (TimeZone/getTimeZone "GMT")) (.format df dt)))) +;; 404 + +(defn unknown-page [] + [404 "Page not Found"]) + ;; User authentication (def nick-regex #"^[A-Za-z0-9\-_∆˚†]*$") @@ -236,12 +242,12 @@ (defn fetch-public-message-by-id [id] - (let [query (str "SELECT m.content, m.created_on, m.user_id, u.nick, u.avatar - FROM messages m, users u, rooms r - WHERE m.user_id = u.user_id - AND r.room_id = m.room_id - AND r.admin_only = false - AND m.message_id = ?")] + (let [query "SELECT m.content, m.created_on, m.user_id, u.nick, u.avatar + FROM messages m, users u, rooms r + WHERE m.user_id = u.user_id + AND r.room_id = m.room_id + AND r.admin_only = false + AND m.message_id = ?"] (first (do-select [query (maybe-parse-int id -1)])))) (defn build-room-map-from-db [room-db] @@ -255,22 +261,11 @@ :topic (ref nil) }) -;; Templates - -;; TODO: avoid exception -(defn fetch-template [template session] - (let [st (.getInstanceOf template-group template)] - (if (session :nick) - (do (.setAttribute st "user_nick" (session :nick)) - (if (non-empty-string? (session :avatar)) (.setAttribute st "user_avatar" (session :avatar))) - (.setAttribute st "isadmin" (session :is_admin)))) - st)) - -(defn serve-template [template session] - (.toString (fetch-template template session))) - ;; Login code +(defn is-vip? [session] + (session :is_admin)) + (defn session-map-from-db [user-info] {:user_id (user-info :user_id) @@ -282,10 +277,26 @@ [user-info] (session-assoc :user_id (user-info :user_id) :nick (user-info :nick) + :email (user-info :email) :is_admin (user-info :is_admin) :avatar (user-info :avatar) :password_login true)) +;; Templates + +;; TODO: avoid exception +(defn fetch-template [template session] + (let [st (.getInstanceOf template-group template)] + (if (session :nick) + (do (.setAttribute st "user_email" (session :email)) + (.setAttribute st "user_nick" (session :nick)) + (if (non-empty-string? (session :avatar)) (.setAttribute st "user_avatar" (session :avatar))) + (.setAttribute st "isadmin" (is-vip? session)))) + st)) + +(defn serve-template [template session] + (.toString (fetch-template template session))) + ;; login-token functions (defn logged-in? @@ -309,7 +320,7 @@ (let [db-info (fetch-nick nick) computed-hash (sha1-hash (db-info :hash) expiry)] (if (= token-hash computed-hash) - (select-keys db-info [:user_id :nick :is_admin :avatar])))))) + (select-keys db-info [:user_id :nick :email :is_admin :avatar])))))) (defn make-login-token [{nick :nick hash :hash}] @@ -473,7 +484,7 @@ (defn directory [session offset] (let [st (fetch-template "directory" session) - users (to-array (directory-search offset))] + users (directory-search offset)] (.setAttribute st "users" users) (cond (= offset 0) (.setAttribute st "prev" false) (= offset 1) (.setAttribute st "prev" "") @@ -517,10 +528,10 @@ "maker" (topic :maker)})) (defn validate-topic-list [session] - (if (session :is_admin) + (if (is-vip? session) (let [st (fetch-template "topic_list" session)] (.setAttribute st "rooms" - (to-array (map topic-map-from-room (vals @rooms)))) + (map topic-map-from-room (vals @rooms))) (.toString st)) [404 "UNKNOWN_ROOM"])) @@ -538,7 +549,7 @@ topic (params :topic) deadline (params :deadline) maker (params :maker)] - (cond (not (session :is_admin)) (resp-error "NOT_VIP") + (cond (not (is-vip? session)) (resp-error "NOT_VIP") (not (valid-topic? topic)) (resp-error "INVALID_TOPIC") (not (valid-deadline? deadline)) (resp-error "INVALID_DEADLINE") (not room) (resp-error "INVALID_ROOM") @@ -549,7 +560,7 @@ (defn validate-end-topic [session params] (let [room (@rooms (params :room))] - (cond (not (session :is_admin)) (resp-error "NOT_VIP") + (cond (not (is-vip? :is_admin)) (resp-error "NOT_VIP") (not room) (resp-error "INVALID_ROOM") :else (do (end-topic! room) @@ -561,7 +572,7 @@ (let [room (@rooms room-key)] (and room (or (not (room :admin_only)) - (session :is_admin))))) + (is-vip? session))))) ;; 3/20/10: add template so multiple chat urls for ryder (defn chat [session room template] @@ -575,7 +586,7 @@ (if nick (dosync (login-user (user-struct-from-session session) room))) - (let [user-list (to-array (prepare-user-list room))] + (let [user-list (prepare-user-list room)] (.setAttribute st "users" user-list)) (.setAttribute st "messages" message-list) (.setAttribute st "roomkey" (room :key)) @@ -665,7 +676,7 @@ (if nick (dosync (login-user (user-struct-from-session session) room))) - (let [user-list (to-array (prepare-user-list room))] + (let [user-list (prepare-user-list room)] (.setAttribute st "users" user-list)) (.setAttribute st "roomkey" (room :key)) (.setAttribute st "isadminroom" (room :admin_only)) @@ -766,7 +777,7 @@ (is-image-invalid? f))) (defn do-upload [session image room] - (if-let [err (validate-upload (image :tempfile) (session :is_admin))] + (if-let [err (validate-upload (image :tempfile) (is-vip? session))] (resp-error err) (let [filename (format-filename (:filename image) (session :nick)) date (today) @@ -807,10 +818,47 @@ (not (session :nick)) [200 "NOT_LOGGED_IN"] :else (do-upload-avatar session image)))) -;; 404 +;; Debug Page + +(defn exception-to-string [e] + (let [sw (java.io.StringWriter.) + pw (java.io.PrintWriter. sw)] + (.printStackTrace e pw) + (.toString sw))) + +(defn lookup-templates [dir selected] + (for [f (.listFiles (File. dir)) + :when (and (.isFile f) (.endsWith (.getName f) ".st"))] + (let [n (s/butlast (.getName f) 3)] + {"template" n + "selected" (= selected n)}))) + +(defn debug-page [session flash] + (if (is-vip? session) + (let [st (fetch-template "debug" session)] + (.setAttribute st "flash" (:msg flash)) + (.setAttribute st "mailtemps" (lookup-templates "template/mail" "welcome")) + (.toString st)) + (unknown-page))) + +(defn debug-commmand! [session params] + (if (is-vip? session) + (let [action (:action params) + msg (try + (cond (= action "regemail") + (do (send-registration-email (params :nick) (params :to) (params :template)) + (str "Sent registration mail to " (params :to))) + :else (str "Unknown action: " action)) + (catch Exception e + (str "<h2 color=\"red\">Caught Exception in " action " --" + (.getMessage e) + "</h2><br><pre>" + (exception-to-string e) + "</pre>")))] + [(flash-assoc :msg msg) + (redirect-to "/debug")]) + (unknown-page))) -(defn unknown-page [params] - [404 "Page not Found"]) ;; Compojure Routes @@ -877,6 +925,8 @@ (GET "/reset" (reset-page session)) (POST "/reset-request" (reset-account-request! session params)) (POST "/reset/:key" (reset-account! session (-> request :route-params :key))) + (GET "/debug" (debug-page session flash)) + (POST "/debug" (debug-commmand! session params)) (GET "/about_us" (serve-template "about_us" session)) (GET "/goodies" (serve-template "goodies" session)) (GET "/help" (serve-template "help" session)) |