Compare commits

..

13 commits

Author SHA1 Message Date
e45af756a2 Merge pull request 'Implement CaseSensitiveQuery' (#39) from CaseSensitiveQuery into stable
Reviewed-on: #39
2024-09-24 02:07:26 +02:00
55ca8f0d47 Fix incorrect number of args 2024-09-24 02:03:53 +02:00
64a0f88ac4 Fixed bug where user-specified port was ignored 2024-09-24 01:58:17 +02:00
a951e4f470 Fix query detector to support Q and all future query types 2024-09-24 01:57:52 +02:00
1890f14f9e Implement support for multiple filters
Allows for adding more filters so regex or searching by thread number
will be much easier
2024-09-24 00:58:53 +02:00
18cc3e730c Refactored that horrible abomination of a code
I don't do drugs but I must have or something, otherwise that is just
unexplainable, I'm sorry if you had to see that, I really am
2024-09-24 00:53:47 +02:00
8d61968dc9 Make filters take the whole thread to be more flexible 2024-09-24 00:28:04 +02:00
817790cfb4 Fix repl-main, add bunch of TODOs 2024-09-24 00:26:28 +02:00
5178ab7366 Improve make-filters function 2024-09-19 16:57:48 +02:00
b88a471a0e Fix case-insensitive-filter 2024-09-19 16:41:51 +02:00
ee3ad0a6e9 Initial filter implementation attempt 2024-09-13 21:18:23 +02:00
2464a66ac7 Add filters for q and Q params 2024-09-13 21:17:48 +02:00
454643675f Add fkmap and vectorize macro 2024-09-13 21:17:23 +02:00
5 changed files with 108 additions and 42 deletions

View file

@ -78,6 +78,8 @@
boards)))) boards))))
(defn config-fill-board-defaults (defn config-fill-board-defaults
;; TODO: must have check that if board is default, it's enabled, if it's not, give some big fat warning
;; that users must always specify board, maybe change the error?
"Fills every enabled board with default config values" "Fills every enabled board with default config values"
[config] [config]
(let [defaults (:boards-defaults config)] (let [defaults (:boards-defaults config)]

View file

@ -72,17 +72,24 @@
(let [config (conf/get-some-config (:config options))] (let [config (conf/get-some-config (:config options))]
;; TODO: probably refactor to use separate config.clj file when validation will be added ;; TODO: probably refactor to use separate config.clj file when validation will be added
;; Init the few globals we have ;; Init the few globals we have
;; TODO: this all needs to go in separate function so it doesnt have to duplicated in repl-main
(reset! conf/GLOBAL-CONFIG config) (reset! conf/GLOBAL-CONFIG config)
(reset! feed/boards-enabled-cache (set (keys (get config :boards-enabled)))) (reset! feed/boards-enabled-cache (set (keys (get config :boards-enabled))))
(reset! watcher/chod-threads-cache (watcher/generate-chod-cache-structure config)) (reset! watcher/chod-threads-cache (watcher/generate-chod-cache-structure config))
(clojure.pprint/pprint config) (clojure.pprint/pprint config)
(jetty/run-jetty (rp/wrap-params feed/http-handler) {:port (:port conf/CONFIG-DEFAULT) (jetty/run-jetty (rp/wrap-params feed/http-handler) {:port (:port config)
:join? true})))) :join? true}))))
;; Docs: https://github.com/ring-clojure/ring/wiki/Getting-Started ;; Docs: https://github.com/ring-clojure/ring/wiki/Getting-Started
(defn repl-main (defn repl-main
"Development entry point" "Development entry point"
[] []
(let [config (conf/get-some-config nil)]
;; TODO: probably refactor to use separate config.clj file when validation will be added
;; Init the few globals we have
(reset! conf/GLOBAL-CONFIG config)
(reset! feed/boards-enabled-cache (set (keys (get config :boards-enabled))))
(reset! watcher/chod-threads-cache (watcher/generate-chod-cache-structure config)))
(jetty/run-jetty (rp/wrap-params #'feed/http-handler) (jetty/run-jetty (rp/wrap-params #'feed/http-handler)
{:port (:port conf/CONFIG-DEFAULT) {:port (:port conf/CONFIG-DEFAULT)
;; Dont block REPL thread ;; Dont block REPL thread

View file

@ -20,7 +20,8 @@
[clojure.string :as s] [clojure.string :as s]
[rss-thread-watch.watcher :as watcher] [rss-thread-watch.watcher :as watcher]
[rss-thread-watch.utils :as ut] [rss-thread-watch.utils :as ut]
[rss-thread-watch.config :as conf]) [rss-thread-watch.config :as conf]
[rss-thread-watch.filters :as f])
(:gen-class)) (:gen-class))
(def boards-enabled-cache (def boards-enabled-cache
@ -34,8 +35,8 @@
This is done by always making new GUID - (concat thread-number UNIX-time-of-data-update)" This is done by always making new GUID - (concat thread-number UNIX-time-of-data-update)"
[thread time] [thread time]
(assoc thread :guid (str (:no thread) (assoc thread :guid (str (:no thread)
"-" "-"
time))) time)))
(defn new-guid-paranoid (defn new-guid-paranoid
"Generate unique GUID on EVERY request to the feed. "Generate unique GUID on EVERY request to the feed.
@ -56,12 +57,20 @@
(:last-modified thread) (:last-modified thread)
(:chod thread)))) (:chod thread))))
(defn make-filters
"Creates map of functions and filters from query string.
Return format is: {filter-fun ['words' 'to' 'filter' 'using this function]}"
[query-string known-filter-map]
(let [filterable (select-keys query-string
(keys known-filter-map))]
(ut/fkmap (fn [k v]
{(get known-filter-map k) (ut/vectorize v)})
filterable)))
(defn filter-chod-posts (defn filter-chod-posts
"Return list of all threads with equal or higher ChoD than requested "Return list of all threads with equal or higher ChoD than requested
READS FROM GLOBALS: watcher.time-of-cache" READS FROM GLOBALS: watcher.time-of-cache"
[query-vec chod-treshold repeat? board-cache] [filters chod-treshold repeat? board-cache]
(let [{time-of-generation :time (let [{time-of-generation :time
cache :data} board-cache cache :data} board-cache
guid-fn (case repeat? guid-fn (case repeat?
@ -69,27 +78,24 @@
"true" (fn [x] (new-guid-always x time-of-generation)) "true" (fn [x] (new-guid-always x time-of-generation))
update-only-guid) update-only-guid)
cache-start-index (first (ut/indices (fn [x] (>= (:chod x) chod-treshold)) cache-start-index (first (ut/indices (fn [x] (>= (:chod x) chod-treshold))
cache)) cache))
;; So we don't have to search thru everything we have cached ;; So we don't have to search thru everything we have cached
needed-cache-part (subvec cache cache-start-index) needed-cache-part (subvec cache cache-start-index)
actuall-matches (keep (fn [t] actuall-matches (keep (fn [thread]
(let [title (:title t)] (some
;; Todo: Man, wouldn't it be cool to know which querry matched the thread? (fn [fun]
;; Would be so much easier for user to figure out why is it showing (when (fun thread (get filters fun))
;; and it would solve the problem of super long titles (or OPs instead of titles) thread))
(when (some (fn [querry] (keys filters)))
(s/includes? (s/lower-case title) (s/lower-case querry)))
query-vec)
t)))
(reverse needed-cache-part))] (reverse needed-cache-part))]
;; Finally generate and append GUIDs ;; Finally generate and append GUIDs
(map guid-fn actuall-matches))) (map guid-fn actuall-matches)))
(defn thread-to-rss-item (defn thread-to-rss-item
"Converts cached thread item to feed item which can be serialized into RSS" "Converts cached thread item to feed item which can be serialized into RSS"
[t host board] [t host]
(let [link-url (s/replace host "{threadnum}" (str (:no t)))] ;Hardcode emergency bugfix (let [link-url (s/replace host "{threadnum}" (str (:no t)))]
{:title (format "%.2f%% - %s" (:chod t) (:title t)) ;TODO: Generate link from the target somehow, or just include it from API response {:title (format "%.2f%% - %s" (:chod t) (:title t))
;; :url link-url <- this is supposed to be for images according to: https://cyber.harvard.edu/rss/rss.html ;; :url link-url <- this is supposed to be for images according to: https://cyber.harvard.edu/rss/rss.html
:description (format "The thread: '%s' has %.2f%% chance of dying" (:title t) (:chod t)) :description (format "The thread: '%s' has %.2f%% chance of dying" (:title t) (:chod t))
:link link-url :link link-url
@ -97,9 +103,8 @@
(defn generate-feed (defn generate-feed
"Generates feed from matching items" "Generates feed from matching items"
[query-vec chod-treshold repeat? cache board-config self-link] [filters chod-treshold repeat? cache board-config self-link]
(let [items (filter-chod-posts query-vec chod-treshold repeat? cache) (let [items (filter-chod-posts filters chod-treshold repeat? cache)
served-filename (get @conf/GLOBAL-CONFIG :served-filename)
head {:title (str "RSS Thread watcher v" conf/VERSION) head {:title (str "RSS Thread watcher v" conf/VERSION)
;; :link is the homepage of the channel ;; :link is the homepage of the channel
:link (get @conf/GLOBAL-CONFIG :homepage) :link (get @conf/GLOBAL-CONFIG :homepage)
@ -108,8 +113,7 @@
:description "RSS based thread watcher"} :description "RSS based thread watcher"}
body (map #(thread-to-rss-item body (map #(thread-to-rss-item
%1 %1
(get board-config :host) (get board-config :host)) items)]
(get board-config :name)) items)]
(rss/channel-xml head body))) (rss/channel-xml head body)))
(defn http-handler (defn http-handler
@ -130,21 +134,17 @@
query :query-string query :query-string
scheme :scheme scheme :scheme
server-name :server-name} rqst server-name :server-name} rqst
qrs (prms "q") filters (make-filters prms f/known-filters)
self-uri (str (s/replace-first scheme ":" "") ;; BUG if local fileserver not running -> FileNotFound exception is thrown and it fucks up the feed generation
;; Should be handled because wrong config and thus url generation could do the same
self-uri (str (s/replace-first scheme ":" "") ;
"://" server-name uri "?" query) "://" server-name uri "?" query)
queries (if (vector? qrs) qrs [qrs]) ; to always return vector
real-chod (if-let [ch (or (and (vector? chod)
(first chod))
chod)]
(try ;If we can't parse number from chod, use default 94
(if (or (vector? chod)
;; TODO: Do we seriously parse this twice?
(<= (Integer/parseInt chod) 60)) ; Never accept chod lower than 60 TODO: don't hardcode this
60 (Integer/parseInt chod))
(catch Exception e
94)))
board-config (get-in @conf/GLOBAL-CONFIG [:boards-enabled board]) board-config (get-in @conf/GLOBAL-CONFIG [:boards-enabled board])
real-chod (try (max (Integer/parseInt (or (and (vector? chod)
(first chod))
chod)) 60) ;HARDCODED CHoD
(catch Exception _
(get board-config :default-chod)))
cache @watcher/chod-threads-cache] cache @watcher/chod-threads-cache]
(println "\n\nRCVD: " rqst) (println "\n\nRCVD: " rqst)
;; (println rqst) ;; (println rqst)
@ -164,13 +164,14 @@
(response/redirect (get @conf/GLOBAL-CONFIG :homepage))))) (response/redirect (get @conf/GLOBAL-CONFIG :homepage)))))
;; No querry specified - don't know what to search for ;; No querry specified - don't know what to search for
(when-not (prms "q") (when-not (some f/known-filter-set (keys prms))
(throw (ex-info "400" {:status 400 (throw (ex-info "400" {:status 400
:header {"Content-Type" "text/plain"} :header {"Content-Type" "text/plain"}
:body (str "400 You MUST specify query with one OR more'q=searchTerm' url parameter(s)\n\n\n" :body (str "400 You MUST specify query with one OR more'q=searchTerm' (or 'Q=SeARChteRm' for case sensitive) url parameter(s)\n\n\n"
"Exmple: '" served-filename "?q=pony&q=IWTCIRD' will show in your feed all threads with 'pony' or 'IWTCIRD'" "Exmple: '" served-filename "?q=pony&q=IWTCIRD' will show in your feed all threads with 'pony' or 'IWTCIRD'"
" in their title that are about to die.")}))) " in their title that are about to die.")})))
;; Whether cache has been generated yet ;; Whether cache has been generated yet
(when (empty? cache) (when (empty? cache)
(throw (ex-info "503" {:status 503 (throw (ex-info "503" {:status 503
:header {"Content-Type" "text/plain"} :header {"Content-Type" "text/plain"}
@ -181,7 +182,7 @@
;; There shouldn't be any problems with this mime type but if there are ;; There shouldn't be any problems with this mime type but if there are
;; replace with "text/xml", or even better, get RSS reader that is not utter shit ;; replace with "text/xml", or even better, get RSS reader that is not utter shit
:header {"Content-Type" "application/rss+xml"} :header {"Content-Type" "application/rss+xml"}
:body (generate-feed queries real-chod repeat? (watcher/get-thread-data board @conf/GLOBAL-CONFIG) board-config self-uri)}) :body (generate-feed filters real-chod repeat? (watcher/get-thread-data board @conf/GLOBAL-CONFIG) board-config self-uri)})
(catch Exception e (catch Exception e
;; Ex-info has been crafted to match HTTP response body so we can send it ;; Ex-info has been crafted to match HTTP response body so we can send it
(if-let [caught (ex-data e)] (if-let [caught (ex-data e)]

View file

@ -0,0 +1,38 @@
;; Copyright (C) 2024 Felisp
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU Affero General Public License as published by
;; the Free Software Foundation, version 3 of the License.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(ns rss-thread-watch.filters
"Functions filtering posts"
(:require [clojure.string :as cs]
[rss-thread-watch.utils :as u])
(:gen-class))
(defn case-sensitive-filter
"Returns true if string [s] is matched by any query. It's case insensitive"
[{:keys [title]} queries]
(some (fn [querry]
(cs/includes? title querry))
queries))
(defn case-insensitive-filter
"Returns true if string [s] is case-matched by query"
[{:keys [title]} queries]
(case-sensitive-filter {:title (cs/lower-case title)} (map cs/lower-case queries)))
(def known-filters
{"Q" case-sensitive-filter
"q" case-insensitive-filter})
(def known-filter-set (set (keys known-filters)))

View file

@ -47,6 +47,11 @@
~x ~x
result#))) result#)))
(defmacro vectorize
"If arg is not a vector, put into vector, otherwise return it"
[v]
(if (vector? v) v [v]))
;; ===== Generic functions ==== ;; ===== Generic functions ====
(defn indices (defn indices
@ -69,15 +74,28 @@
{k (map-apply-defaults conf-val default-val)} {k (map-apply-defaults conf-val default-val)}
{k (nil?-else conf-val default-val)}))))) {k (nil?-else conf-val default-val)})))))
;; This is a shitty version of reduce-kv
(defn fmap (defn fmap
"Applies function [f] to every key and value in map [m] "Applies function [f] to every key and value in map [m]
Function signature should be (f [key value])." Function signature should be (f [key value]).
Key stays unchanged"
[f m] [f m]
(into (into
(empty m) (empty m)
(for [[key val] m] (for [[key val] m]
[key (f key val)]))) [key (f key val)])))
(defn fkmap
;; I am horrible with docstrings, I don't deny that
"Applies function [f] to every key and value in map [m]
Function signature should be (f [key value]).
Unlike fmap, you can change key too, so return both {key value} in map"
[f m]
(into
(empty m)
(for [[key val] m]
(f key val))))
(defn expand-home (defn expand-home
"Expands ~ to home directory" "Expands ~ to home directory"
;;modified from sauce: https://stackoverflow.com/questions/29585928/how-to-substitute-path-to-home-for ;;modified from sauce: https://stackoverflow.com/questions/29585928/how-to-substitute-path-to-home-for