Added debug email page; removed useless to-array

2 files changed, 97 insertions, 44 deletions

diff --git a/src/email.clj b/src/email.clj
index 2a68e7b..47d05a8 100644
--- a/src/email.clj
+++ b/src/email.clj
@@ -37,7 +37,8 @@
       (.setText msg (:text mail))
       (javax.mail.Transport/send msg))))
 
-(def mail-templates (new StringTemplateGroup "dumpfm-mail" "template/mail"))
+(def mail-templates (StringTemplateGroup. "dumpfm-mail" "template/mail" ))
+;;(.setErrorListener mail-templates StringTemplateGroup/DEFAULT_ERROR_LISTENER)
 (.setRefreshInterval mail-templates 3)
 
 (defn parse-mail-template [temp props]
@@ -58,9 +59,11 @@
              :subject subject
              :text text))
 
-(defn send-registration-email [nick email]
-  (let [[s b] (parse-mail-template "welcome" {"nick" nick})]
-    (dump-mail [email] s b)))
+(defn send-registration-email 
+  ([nick email] (send-registration-email nick email "welcome"))
+  ([nick email temp]
+     (let [[s b] (parse-mail-template temp {"nick" nick})]
+       (dump-mail [email] s b))))
 
 (defn send-reset-email [nick email key]
   (let [[s b] (parse-mail-template "reset" {"nick" nick "key" key})]
diff --git a/src/site.clj b/src/site.clj
index 75b0f52..ef4e773 100755
--- 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
@@ -89,6 +90,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\-_∆˚†]*$")
@@ -199,12 +205,12 @@
        (do-select [query nick *dumps-per-page* offset]))))
 
 (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]
@@ -218,22 +224,12 @@
    :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)
@@ -245,10 +241,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?
@@ -272,7 +284,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}]
@@ -338,7 +350,7 @@
           dumps (fetch-messages-by-nick profile-nick true dump-offset)
           dump-count (count-messages-by-nick profile-nick true)
           st (fetch-template "profile" session)
-          dumps (to-array (map process-message-for-output dumps))]
+          dumps (map process-message-for-output dumps)]
       (do
         (.setAttribute st "is_home" is-home)
         (doseq [a [:nick :avatar :contact :bio]]
@@ -434,7 +446,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" "")
@@ -478,10 +490,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"]))
 
@@ -499,7 +511,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")
@@ -510,7 +522,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)
@@ -522,21 +534,20 @@
   (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]
   (let [now (System/currentTimeMillis)
         nick (session :nick)
         st (fetch-template template session)
-        message-list (to-array
-                      (map process-message-for-output
-                           ; TODO: remove db query
-                           (reverse (fetch-messages-by-room (room :room_id) false))))]
+        message-list (map process-message-for-output
+                          ; TODO: remove db query
+                          (reverse (fetch-messages-by-room (room :room_id) false)))]
     (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))
@@ -626,7 +637,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))
@@ -646,8 +657,8 @@
         dump-offset (* offset *dumps-per-page*)
         image-only (and (not (room :admin_only))
                         (not= (params :show) "all"))
-	dumps (to-array (map process-message-for-output
-			     (fetch-messages-by-room (room :room_id) image-only dump-offset)))
+	dumps (map process-message-for-output
+                   (fetch-messages-by-room (room :room_id) image-only dump-offset))
 	dump-count (count-messages-by-room (room :room_id) image-only)]
     (if (< (+ dump-offset *dumps-per-page*) dump-count)
       (.setAttribute st "next" (inc offset)))
@@ -719,7 +730,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)
@@ -760,10 +771,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
 
@@ -822,12 +870,14 @@
   (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))
   (GET "/privacy" (serve-template "privacy" session))
   (GET "/terms" (serve-template "terms" session))
-  (ANY "*" (unknown-page params)))
+  (ANY "*" (unknown-page)))
 
 (defroutes multipart
   (POST "/upload/message" (upload session params))