(ns utils (:import java.text.SimpleDateFormat java.util.Date java.net.URLDecoder org.antlr.stringtemplate.StringTemplateGroup) (:use clojure.contrib.json.write clojure.contrib.sql compojure)) (let [db-host "localhost" db-port 5432 db-name "dumpfm"] (def *db* {:classname "org.postgresql.Driver" :subprotocol "postgresql" :subname (str "//" db-host ":" db-port "/" db-name) :user "postgres" :password "root"})) ;; moved this to here which doesn't seem right... maybe a 'settings.clj' or something? (def *dumps-per-page* 20) ;; Misc (declare stringify-and-escape) (defn escape-html-deep [o] (if (map? o) (stringify-and-escape o) (if (seq? o) (map escape-html-deep o) (escape-html o)))) (defn stringify-and-escape [m] (zipmap (map str* (keys m)) (map escape-html-deep (vals m)))) (defn nor [& args] (not-any? identity args)) (defn no-args-adaptor [f] (fn [& more] (f))) (defn ms-in-future [ms] (+ ms (System/currentTimeMillis))) (defn swap [f] (fn [& more] (apply f (reverse more)))) (defn join [lst int] (apply str (interpose int lst))) (defn non-empty-string? [s] (cond (string? s) (> (count s) 0) :else s)) (defn seconds [t] (* t 1000)) (defn minutes [t] (* t 60 1000)) (defn kbytes [b] (* b 1024)) (defn mbytes [b] (* b 1024 1024)) ;; Formatters (def yyyy-mm-dd-formatter (new SimpleDateFormat "yyyy-MM-dd")) (defn format-yyyy-mm-dd [d] (.format yyyy-mm-dd-formatter d)) (def yymmdd-formatter (new SimpleDateFormat "yyyyMMdd")) (defn format-yyyymmdd [d] (.format yymmdd-formatter d)) (defn today [] (format-yyyymmdd (new Date))) (def timestamp-formatter (new SimpleDateFormat "h:mm a EEE M/d")) (def date-first-timestamp-formatter (new SimpleDateFormat "M/d h:mm a")) (defn format-timestamp [d] (.format timestamp-formatter d)) (defn format-date-first-timestamp [d] (.format date-first-timestamp-formatter d)) (defn pluralize [word val] (if (= val 1) word (str word "s"))) (defn format-interval [i] (let [vals [(.getYears i) (.getMonths i) (.getDays i) (.getHours i) (.getMinutes i)] labels ["year" "month" "day" "hour" "minute"] arr (into [] (for [[l v] (map vector labels vals) :when (> v 0)] (str v " " (pluralize l v))))] (join arr ", "))) (defn apply-formats [formats d] (into {} (for [[k v] d] (if-let [f (formats k)] [k (f v)] [k v])))) ;; JSON responses (defmethod print-json Date [d] (print-json (format-yyyy-mm-dd d))) (defn resp-error [message] {:status 400 :headers {} :body message}) (defn resp-success [message] {:status 200 :headers {} :body (json-str message)}) ;; Database (defn do-cmds [query] (with-connection *db* (do-commands query))) (defn do-prepared! [& args] (with-connection *db* (apply do-prepared args))) (defn do-update [& args] (with-connection *db* (apply update-values args))) (defn do-select [query] (with-connection *db* (with-query-results rs query (doall rs)))) (defn do-count [query] ((first (with-connection *db* (with-query-results rs query (doall rs)))) :count)) (defn do-delete [table query] (with-connection *db* (delete-rows table query))) (defn do-insert [table cols values] (with-connection *db* (insert-values table cols values))) ;; Parsing (defn maybe-parse-int ([s] (Integer/parseInt s)) ([s default] (try (Integer/parseInt s) (catch NumberFormatException _ default)))) (defn maybe-parse-long [s f] (if s (Long/parseLong s) f)) (defn url-decode [text] (URLDecoder/decode text "UTF-8")) (defn #^String lower-case "Converts string to all lower-case." [#^String s] (.toLowerCase s)) ;; 404 (defn unknown-page [& more] [404 "Page not Found"]) ;; Templates (def template-group (new StringTemplateGroup "dumpfm" "template")) (.setRefreshInterval template-group 3) ;; TODO: handle 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" (session :is_admin)))) ;; TODO: consolidate session/user code st)) (defn serve-template [template session] (.toString (fetch-template template session))) ;; User authentication ; TODO: create user module (defn first-or-nil [l] (if (empty? l) nil (first l))) (def nick-regex #"^[A-Za-z0-9\-_∆˚†]*$") (defn is-invalid-nick? [n] (cond (< (count n) 3) "NICK_TOO_SHORT" (not (re-matches nick-regex n)) "NICK_INVALID_CHARS")) (defn check-nick [nick] (let [query "SELECT * FROM users WHERE LOWER(nick) = ? LIMIT 1"] (> (count (do-select [query (lower-case nick)])) 0))) (defn fetch-nick [nick] (let [q1 "SELECT * FROM users WHERE nick = ? LIMIT 1" ; ORDER BY ensures consistent retrieval of ambiguious names q2 "SELECT * FROM users WHERE lower(nick) = ? ORDER BY nick LIMIT 1"] (or (first-or-nil (do-select [q1 nick])) (first-or-nil (do-select [q2 (lower-case nick)]))))) (defn authorize-nick-hash [nick hash] (let [db-user (fetch-nick nick)] (and db-user (= (db-user :hash) hash) db-user))) (defn is-vip? [session] (session :is_admin)) (defmacro if-vip [e] "Evaluates expr if user is vip otherwise returns 404. Can only be used where session is defined." `(if (is-vip? ~'session) ~e (unknown-page)))