diff options
Diffstat (limited to 'src/admin.clj')
| -rw-r--r-- | src/admin.clj | 204 |
1 files changed, 145 insertions, 59 deletions
diff --git a/src/admin.clj b/src/admin.clj index e5d0c8f..c1a6c07 100644 --- a/src/admin.clj +++ b/src/admin.clj @@ -6,63 +6,62 @@ scheduled-agent utils)) -;; 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-vip - (let [st (fetch-template "debug" session)] - (.setAttribute st "flash" (:msg flash)) - (.setAttribute st "mailtemps" (lookup-templates "template/mail" "welcome")) - (.toString st)))) - -(defn debug-commmand! [session params] - (if-vip - (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")]))) - ;; Muting (def *mute-refresh-period-sec* 60) -(def fetch-mutes-query " -SELECT m.*, (m.set_on + m.duration) AS expiry, u.nick AS admin_nick -FROM mutes m, users u +(def fetch-active-mutes-query " +SELECT m.*, + (m.set_on + m.duration) AS expiry, + a.nick AS admin_nick, + o.nick AS nick +FROM mutes m, users a, users o WHERE (m.set_on + m.duration) > now() -AND u.user_id = m.admin_id -AND NOT m.is_canceled +AND a.user_id = m.admin_id +AND o.user_id = m.user_id +AND NOT m.cancelled +") + +(def fetch-inactive-mutes-query " +SELECT m.*, + (m.set_on + m.duration) AS expiry, + a.nick AS admin_nick, + o.nick AS nick, + c.nick AS cancel_nick +FROM mutes m +LEFT OUTER JOIN users o ON (m.user_id = o.user_id) +LEFT OUTER JOIN users a ON (m.admin_id = a.user_id) +LEFT OUTER JOIN users c ON (m.cancel_admin_id = c.user_id) +WHERE m.cancelled OR (m.set_on + m.duration < now()) +") + +(def fetch-mute-query " +SELECT m.*, + (m.set_on + m.duration) AS expiry, + (m.set_on + m.duration) < now() as expired, + a.nick AS admin_nick +FROM mutes m, users a +WHERE mute_id = ? +AND a.user_id = m.admin_id +LIMIT 1 ") -(defn update-mutes [] - (let [res (do-select [fetch-mutes-query])] + +(defn fetch-active-mutes [] + (do-select [fetch-active-mutes-query])) + +(defn fetch-active-mute-map [] + (let [res (fetch-active-mutes)] (zipmap (map :user_id res) res))) +(defn fetch-inactive-mutes [] + (do-select [fetch-inactive-mutes-query])) + +(defn fetch-mute [mute-id] + (first (do-select [fetch-mute-query mute-id]))) + (def *active-mutes* - (scheduled-agent (no-args-adaptor update-mutes) + (scheduled-agent (no-args-adaptor fetch-active-mute-map) *mute-refresh-period-sec* nil)) @@ -74,8 +73,13 @@ AND NOT m.is_canceled (let [t (maybe-parse-int time 0) u (lower-case unit)] (and (> t 0) - (#{"minute" "hour" "day"} u) - (str time " " u)))) + (contains? #{"minutes" "hours" "days"} u) + (str time " " (pluralize (s/butlast u 1) t))))) + +(defn insert-mute! [user-id admin-id reason duration] + (do-prepared! "INSERT INTO mutes (user_id, admin_id, duration, reason) + VALUES (?, ?, CAST (? AS INTERVAL), ?)" [user-id admin-id duration reason]) + (update! *active-mutes*)) (defn mute! [session params] (if-vip @@ -83,22 +87,104 @@ AND NOT m.is_canceled user-id (:user_id (fetch-nick nick)) time (params :time) unit (params :unit) - duration (parse-pos-interval time (s/butlast unit 1)) + duration (parse-pos-interval time unit) reason (params :reason) admin-id (session :user_id) admin-nick (session :nick)] - (cond (not user-id) [400 "INVALID_NICK"] - (not duration) [400 "INVALID_DURATION"] - ;; TODO: Ugly interval hack, w/ no escaping. Totally unsafe. - :else (let [q (format "INSERT INTO mutes (user_id, admin_id, duration, reason) - VALUES (%s, %s, '%s', '%s')" - user-id admin-id duration reason)] - (do-cmds q) - (send-mute-email nick admin-nick reason time unit) - "OK"))))) + (cond (not user-id) [400 "INVALID_NICK"] + (not duration) [400 "INVALID_DURATION"] + :else (do (insert-mute! user-id admin-id reason duration) + (send-mute-email nick admin-nick reason duration) + "OK"))))) +(def mute-cancel-query " +UPDATE mutes +SET cancelled=true, cancel_admin_id=? +WHERE mute_id = ? +AND cancelled = false +") + +(defn- assert-update [res ok err] + (if (zero? (first res)) err ok)) + +(defn cancel-mute! [mute-id admin-id] + (let [mute (fetch-mute mute-id) + active (nor (:expired mute) (:cancelled mute)) + qry "mute_id = ? AND cancelled = false + AND (set_on + duration) > now()"] + (cond (not mute) (resp-error "INVALID_MUTE_ID") + (not active) (resp-error "EXPIRED_MUTE") + :else (assert-update + (do-update :mutes [qry mute-id] + {:cancelled true + :cancel_admin_id admin-id}) + (resp-success "OK") + (resp-error "UPDATE_ERROR"))))) + +(defn handle-cancel-mute! [session params] + (if-vip + (let [mute-id (maybe-parse-int (params :mute_id) 0) + admin-id (session :user_id)] + (cancel-mute! mute-id admin-id)))) (defn format-mute [mute] (format (str "I'm sorry, you've been muted for %s. " "You'll be able to post again on %s EST.") (mute :reason) (mute :expiry))) + +(def mute-formatter {:duration format-interval + :set_on format-date-first-timestamp + :expiry format-date-first-timestamp + :cancelled #(if % "Cancelled" "Expired")}) + +(defn show-mutes [session] + (if-vip + (let [st (fetch-template "mutes" session) + active (fetch-active-mutes) + inactive (fetch-inactive-mutes) + formatter (partial apply-formats mute-formatter) + f #(map (comp stringify-and-escape formatter) %)] + (.setAttribute st "active" (f active)) + (.setAttribute st "inactive" (f inactive)) + (.toString st)))) + + +;; 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-vip + (let [mutes (poll *active-mutes*) + st (fetch-template "debug" session)] + (.setAttribute st "flash" (:msg flash)) + (.setAttribute st "mailtemps" (lookup-templates "template/mail" "welcome")) + (.toString st)))) + +(defn debug-commmand! [session params] + (if-vip + (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")]))) |