(ns utils (:import java.text.SimpleDateFormat java.net.URL java.util.Date java.util.TimeZone java.io.File java.net.URLDecoder javax.sql.DataSource org.postgresql.ds.PGPoolingDataSource org.apache.commons.codec.digest.DigestUtils org.antlr.stringtemplate.StringTemplateGroup) (:use clojure.contrib.json.write clojure.contrib.sql clojure.contrib.duck-streams clojure.contrib.str-utils compojure config)) (let [db-host "localhost" db-name "dumpfm" db-user "postgres" db-pass "root"] ; TODO: use c3p0 for pooling? (def *db* {:datasource (doto (new PGPoolingDataSource) (.setServerName db-host) (.setDatabaseName db-name) (.setUser db-user) (.setPassword db-pass) (.setMaxConnections 20))})) ;; moved this to here which doesn't seem right... maybe a 'settings.clj' or something? (def *dumps-per-page* 20) (def *vip-dumps-per-page* 200) ;; Misc (defn download-http-url [u] (let [url (URL. u)] (if (= (.getProtocol url) "http") (slurp* url) (throw (Exception. (str "Invalid url " u)))))) (defn append [& vecs] (reduce into vecs)) (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 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] (* 60 (seconds t))) (defn hours [t] (* 60 (minutes t))) (defn days [t] (* 24 (hours t))) (defn ms-ago [ms] (- (System/currentTimeMillis) ms)) (defn kbytes [b] (* b 1024)) (defn mbytes [b] (* b 1024 1024)) (defn open-file [dir-comps filename] (let [d (str-join (System/getProperty "file.separator") dir-comps) f (str-join (System/getProperty "file.separator") [d filename])] (.mkdir (new File d)) (new File f))) (defn sha1-hash [& more] (DigestUtils/shaHex (apply str more))) (defmacro with-timing [e] `(let [s# (System/nanoTime) r# ~e f# (System/nanoTime)] [(int (/ (- f# s#) 1e6)) r#])) (def truncation-factor 2) (defn insert-and-truncate! [list-ref item soft-limit] (if (> (count @list-ref) (* soft-limit truncation-factor)) (ref-set list-ref (cons item (take soft-limit @list-ref))) (ref-set list-ref (cons item @list-ref)))) ;; Formatters (defn- comma-helper [s] (let [f (take 3 s) r (drop 3 s)] (if (= (count r) 0) f (append (comma-helper r) [\,] (reverse f))))) (defn comma-format [i] (apply str (reverse (comma-helper (reverse (str i)))))) (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])))) (defn gmt-string ([] (gmt-string (new Date))) ([dt] (let [df (new SimpleDateFormat "EEE, dd MMM yyyy kk:mm:ss z")] (.setTimeZone df (TimeZone/getTimeZone "GMT")) (.format df dt)))) ;; 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 (vec 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))) (defn assert-update ([res ok err] (if (not (= (first res) 1)) err ok)) ([res] (assert-update res true false))) (defn sql-array [type arr] (with-connection *db* (.createArrayOf (connection) type (into-array arr)))) (defn execute-query! [query & objects] (with-connection *db* (let [stmt (.prepareStatement (connection) query)] (doseq [[i o] (map vector (iterate inc 1) objects)] (.setObject stmt i o)) (println "update: " (.executeQuery stmt))))) ;; 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")) ; TODO: this duplicates str-utils, should be removed (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) (defn fetch-template [template session] (try (let [st (.getInstanceOf template-group template)] (if (session :nick) (doto st (.setAttribute "user_email" (session :email)) (.setAttribute "user_nick" (session :nick)) (.setAttribute "user_avatar" (if (non-empty-string? (session :avatar)) (session :avatar) nil)) (.setAttribute "isadmin" (session :is_admin)) (.setAttribute "domain" config/*server-url*)) (doto st (.setAttribute "domain" config/*server-url*)))) (catch Exception e nil))) (defn fetch-template-fragment [template] (.getInstanceOf template-group template)) (defn serve-template [template session] (.toString (fetch-template template session))) (defn first-or-nil [l] (if (empty? l) nil (first l))) ;; VIP (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)))