diff options
| -rw-r--r-- | db/0-create.psql | 13 | ||||
| -rw-r--r-- | docs/reserved_nicks.txt | 2 | ||||
| -rwxr-xr-x | src/feed.clj | 121 | ||||
| -rw-r--r-- | src/site.clj | 51 | ||||
| -rwxr-xr-x | src/utils.clj | 30 |
5 files changed, 184 insertions, 33 deletions
diff --git a/db/0-create.psql b/db/0-create.psql index 979363d..a90d23e 100644 --- a/db/0-create.psql +++ b/db/0-create.psql @@ -10,6 +10,7 @@ CREATE TABLE users ( avatar text NOT NULL DEFAULT '', contact text NOT NULL DEFAULT '', bio text NOT NULL DEFAULT '', + is_bot NOT NULL DEFAULT false, profile_bg text ); CREATE INDEX users_nick_lowercase_idx ON users (lower(nick)); @@ -74,3 +75,15 @@ INSERT INTO rooms (key, name, description, admin_only) INSERT INTO rooms (key, name, description, admin_only) VALUES ('VIP', 'The VIP Room', 'Command Post', true); +CREATE TABLE feed_images ( + external_url text NOT NULL, + local_url text NOT NULL, + feed_url text NOT NULL, + added_on timestamp NOT NULL DEFAULT now(), + room_id integer REFERENCES rooms +); + +CREATE INDEX feed_images_external_url_idx ON feed_images (external_url); +CREATE INDEX feed_images_image_posted_idx ON feed_images (external_url, room_id); + + diff --git a/docs/reserved_nicks.txt b/docs/reserved_nicks.txt index 4e0312e..eef8023 100644 --- a/docs/reserved_nicks.txt +++ b/docs/reserved_nicks.txt @@ -56,6 +56,8 @@ post privacy refresh reset +room +rooms search shop tag diff --git a/src/feed.clj b/src/feed.clj index 30ff973..e075e69 100755 --- a/src/feed.clj +++ b/src/feed.clj @@ -1 +1,120 @@ -(ns feed) +(ns feed + (:require [clojure.contrib.str-utils2 :as s]) + (:use clojure.contrib.condition + clojure.contrib.duck-streams + compojure + utils)) + +(def *feeds-path* "docs/feeds.csv") + +(defn parse-line [line] + (let [r (s/split line #",")] + (zipmap [:room-name :desc :feed-link :site-link :contact] + (map #(.trim (.replaceAll % "\"" "")) + r)))) + +(defn read-feeds [] + (rest (map parse-line (read-lines *feeds-path*)))) + +(def *image-posted-qry* " +SELECT * +FROM UNNEST(?) as v +WHERE NOT EXISTS (SELECT 1 + FROM feed_images f + WHERE f.external_url = v + AND f.room_id = ?) +") + +(defn filter-posted-images [urls room-id] + (if (empty? urls) + [] + (do-select [*image-posted-qry* + (sql-array "text" urls) + room-id]))) + +; http://stackoverflow.com/questions/169625/regex-to-check-if-valid-url-that-ends-in-jpg-png-or-gif +(def *image-regex* + #"(?i)https?://(?:[a-z\-]+\.)+[a-z]{2,6}(?:/[^/#?]+)+\.(?:jpeg|jpg|gif|png)") + +(defn extract-images [text] + (re-seq *image-regex* text)) + +(defn is-thumbnail? [img] + (boolean (re-find #"(?i)[-._](thumb|small|thumbs)[-._]" img))) + +(def image-filters [["THUMBNAIL" is-thumbnail?]]) + +(defn filter-image [img] + (or (some + (fn [[r f]] (if (f img) [img r])) + image-filters) + [img nil])) + +(defn filter-images [imgs] + (let [filtered (map filter-image imgs)] + [(for [[img r] filtered :when (nil? r)] + img) + (for [[img r] filtered :when r] + [img r])])) + +(defn classify-images-from-feed [feed] + (let [[ms text] (with-timing (slurp* feed)) + [g b] (filter-images (extract-images text))] + [g b ms])) + +(defn download-all-feeds! [] + (doseq [f (read-feeds)] + (try + (when-let [url (:feed-link f)] + (let [c (slurp* url) + images (extract-images c)] + (println url images))) + (catch Exception e + (print-stack-trace e))))) + +(defn download-feed [room-id feed-user-nick feed] + "TODO") + +;; Testing + +(defn feed-test-page [session] + (if-vip + (html [:body + [:h1 "Feed Test"] + [:form {:action "/feed-test" :method "post"} + [:input {:type "text" :name "url"}] + [:input {:type "submit" :value "Send"}]]]))) + +(defn show-bad-images [imgs] + (for [[img reason] imgs] + [:div + reason + [:a {:href img} + [:img {:src img}]]])) + +(defn show-good-images [imgs] + (for [img imgs] + [:div + [:a {:href img} + [:img {:src img}]]])) + + +(defn feed-test [session params] + (if-vip + (if-let [feed (params :url)] + (let [[ms text] (with-timing (slurp* feed)) + imgs (extract-images text) + [good-imgs bad-imgs] (filter-images imgs)] + (html [:body + [:h1 (str "Images for " feed)] + [:div (format "Downloaded in %s ms" ms)] + [:h3 "Images"] + (show-good-images good-imgs) + [:h3 "Filtered Images"] + (show-bad-images bad-imgs) + [:h3 "Raw Feed Contents"] + [:pre (escape-html text)] + ])) + (redirect-to "/feed-test")))) + + diff --git a/src/site.clj b/src/site.clj index baec484..56b7167 100644 --- a/src/site.clj +++ b/src/site.clj @@ -239,19 +239,19 @@ (defn session-map-from-db [user-info] - {:user_id (user-info :user_id) - :nick (user-info :nick) + {:user_id (user-info :user_id) + :nick (user-info :nick) :is_admin (user-info :is_admin) - :avatar (user-info :avatar)}) + :avatar (user-info :avatar)}) (defn session-assoc-from-db [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) + :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)) ;; login-token functions @@ -318,8 +318,8 @@ (defn login [session params cookies] (let [nick (or (params :nick) "") hash (or (params :hash) "") - db-user (authorize-nick-hash nick hash) remember-me (= (params :rememberme) "yes") + db-user (authorize-nick-hash nick hash) login-cookie (if remember-me (make-login-token db-user) (clear-login-token *login-token-key*))] @@ -344,7 +344,7 @@ (defn load-invalid-nicks [] (set (read-lines *reserved-nicks-path*))) -(def *reserved-nicks* +(def *reserved-nicks* (scheduled-agent (no-args-adaptor load-invalid-nicks) *reserved-nicks-refresh-period-sec* (load-invalid-nicks))) @@ -390,7 +390,7 @@ ORDER BY created_on DESC; ") (defn zoeee-nudes [session] - (let [raw-dumps (map tags/parse-tags-from-row-as-tag-map + (let [raw-dumps (map tags/parse-tags-from-row-as-tag-map (do-select [*zoeee-query*])) dumps (map tags/add-favorited-flag raw-dumps (repeat session)) dumps (map tags/remove-tags-for-output dumps) @@ -406,18 +406,21 @@ ORDER BY created_on DESC; (defn profile [session profile-nick offset] (if-let [user-info (fetch-nick profile-nick)] - (let [st (fetch-template "profile" session) - profile-nick (:nick user-info) - nick (session :nick) - logger (make-time-logger) - is-home (and nick (= nick profile-nick)) - has-avatar (non-empty-string? (user-info :avatar)) - offset (maybe-parse-int offset 0) - dump-offset (* offset *dumps-per-page*) - raw-dumps (logger tags/fetch-dumps-by-nick :nick profile-nick :amount (+ 1 *dumps-per-page*) :offset dump-offset) - dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session)) - dumps (map tags/remove-tags-for-output dumps) - dumps (logger doall (map process-message-for-output dumps))] + (let [st (fetch-template "profile" session) + profile-nick (:nick user-info) + nick (session :nick) + logger (make-time-logger) + is-home (and nick (= nick profile-nick)) + has-avatar (non-empty-string? (user-info :avatar)) + offset (maybe-parse-int offset 0) + dump-offset (* offset *dumps-per-page*) + raw-dumps (logger tags/fetch-dumps-by-nick + :nick profile-nick + :amount (+ 1 *dumps-per-page*) + :offset dump-offset) + dumps (map tags/add-favorited-flag (take *dumps-per-page* raw-dumps) (repeat session)) + dumps (map tags/remove-tags-for-output dumps) + dumps (logger doall (map process-message-for-output dumps))] (do (.setAttribute st "is_home" is-home) (doseq [a [:nick :avatar :contact :bio]] @@ -1068,6 +1071,8 @@ ORDER BY msg_count DESC") (GET "/mutes" (show-mutes session)) (POST "/mute" (mute! session params)) (POST "/cancel-mute" (handle-cancel-mute! session params)) + (GET "/feed-test" (feed-test-page session)) + (POST "/feed-test" (feed-test session params)) ;; Footer pages (GET "/about_us" (serve-template "about_us" session)) diff --git a/src/utils.clj b/src/utils.clj index 3f3efab..5d7af94 100755 --- a/src/utils.clj +++ b/src/utils.clj @@ -4,6 +4,8 @@ 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 @@ -12,13 +14,16 @@ 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"})) + 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 3))})) ;; moved this to here which doesn't seem right... maybe a 'settings.clj' or something? (def *dumps-per-page* 20) @@ -26,6 +31,9 @@ ;; Misc +(defn append [& vecs] + (reduce into vecs)) + (declare stringify-and-escape) (defn escape-html-deep [o] (if (map? o) @@ -78,11 +86,11 @@ (defn sha1-hash [& more] (DigestUtils/shaHex (apply str more))) -(defmacro with-timing [e] +(defmacro with-timing [e] `(let [s# (System/nanoTime) r# ~e f# (System/nanoTime)] - [(int (/ (- f# s#) 1000000.0)) r#])) + [(int (/ (- f# s#) 1e6)) r#])) ;; Formatters @@ -185,6 +193,10 @@ ([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)))) + ;; Parsing (defn maybe-parse-int |