diff options
| -rw-r--r-- | src/papod.clj | 109 | ||||
| -rw-r--r-- | tests/unit.clj | 5 |
2 files changed, 92 insertions, 22 deletions
diff --git a/src/papod.clj b/src/papod.clj index 5e81533..4055e8a 100644 --- a/src/papod.clj +++ b/src/papod.clj @@ -664,13 +664,13 @@ index 0] (if (or (= index (count s)) (= +separator+ (nth s index))) - [(apply str chars) (count chars)] - (let [c (nth s index)] - (if-not (letter? c) - [nil nil {:message "Bad char for non-numerical command" - :data {:c c}}] - (recur (conj chars c) - (inc index))))))) + (if (zero? (count chars)) + [nil nil {:message "Empty command" + :type :empty-command + :data {}}] + [(apply str chars) (count chars)]) + (recur (conj chars (nth s index)) + (inc index))))) (defconst- params-re (java.util.regex.Pattern/compile (str +separator+))) @@ -2063,10 +2063,12 @@ (get @clients target))] (deliver! m))) ;; Build reply vector - (let [echo? (contains? - (or (:caps @client) #{}) - "echo-message") - echo (when echo? [tagged]) + (let [my-caps (or (:caps @client) #{}) + echo? (contains? my-caps "echo-message") + tags? (or (my-caps "message-tags") + (my-caps "server-time")) + echo (when echo? + [(if tags? tagged raw)]) away (when-not chan? (let [m (when clients (get @clients target)) @@ -2578,7 +2580,8 @@ handle (first params) reply-id-str (get tags "+reply") react-emoji (get tags "+draft/react") - unreact-emoji (get tags "+draft/unreact")] + unreact-emoji (get tags "+draft/unreact") + chan? (channel-handle? handle)] (cond (empty? params) [(numeric-reply client "461" "TAGMSG :Not enough parameters")] @@ -2658,7 +2661,54 @@ (deliver-to-client! (:w m) line))) []) - :else []))) + ;; Generic TAGMSG: forward client tags + :else + (let [user-tags (->> tags + (filter (fn [[k _]] + (string/starts-with? k "+"))) + (map (fn [[k v]] (str k "=" v)))) + base-line (str ":" nick " TAGMSG " handle) + recip-line (if (seq user-tags) + (str "@" (string/join ";" user-tags) + " " base-line) + base-line) + my-caps (or (:caps @client) #{}) + tags-cap? (contains? my-caps "message-tags") + recipient-exists? + (cond + chan? (and channels + (seq (get @channels handle))) + :else (and clients + (get @clients handle)))] + (cond + (and (not chan?) (not recipient-exists?)) + [(numeric-reply client "401" + (str handle " :No such nick/channel"))] + + (and chan? (not recipient-exists?)) + [(numeric-reply client "403" + (str handle " :No such channel"))] + + :else + (do + (when tags-cap? + (if chan? + (doseq [mn (get @channels handle) + :when (not= mn nick) + :let [m (get @clients mn) + ca (when m (:client-atom m)) + caps (when ca (or (:caps @ca) #{}))] + :when (and m (caps "message-tags"))] + (deliver-to-client! (:w m) recip-line)) + (when-let [m (get @clients handle)] + (let [ca (:client-atom m) + caps (when ca (or (:caps @ca) #{}))] + (when (caps "message-tags") + (deliver-to-client! (:w m) recip-line)))))) + (if (and (contains? my-caps "echo-message") + tags-cap?) + [recip-line] + []))))))) (defn- handle-markread [params client components] @@ -2921,6 +2971,7 @@ "NICK" (handle-nick params client components) "USER" (handle-user params client components) "PING" (handle-ping params client) + "PONG" [] "CAP" (handle-cap params client components) "AUTHENTICATE" (handle-authenticate params client components) (cond @@ -3755,6 +3806,24 @@ (.write w bytes 0 (count bytes)))) (.flush w)) +(defn- add-label-tag + [line label] + (if (string/starts-with? line "@") + (let [sp (.indexOf line " ")] + (str "@label=" label ";" + (subs line 1 sp) + (subs line sp))) + (str "@label=" label " " line))) + +(defn- add-batch-tag + [line batch-id] + (if (string/starts-with? line "@") + (let [sp (.indexOf line " ")] + (str "@batch=" batch-id ";" + (subs line 1 sp) + (subs line sp))) + (str "@batch=" batch-id " " line))) + (defn- handle-message! [message w client components] (let [label (get (:tags message) "label") @@ -3767,16 +3836,16 @@ (not has-lr?) (send-replies! replies w) - ;; Single reply — add label tag directly - (= 1 (count replies)) + ;; No replies — send ACK with label + (empty? replies) (send-replies! - [(str "@label=" label " " (first replies))] + [(str "@label=" label " ACK")] w) - ;; No replies — send ACK with label - (empty? replies) + ;; Single reply — add label tag directly + (= 1 (count replies)) (send-replies! - [(str "@label=" label " :" +server-name+ " ACK")] + [(add-label-tag (first replies) label)] w) ;; Multiple replies — wrap in BATCH @@ -3788,7 +3857,7 @@ " labeled-response")] (concat (map (fn [r] - (str "@batch=" batch-id " " r)) + (add-batch-tag r batch-id)) replies) [(str "BATCH -" batch-id)])) w))))) diff --git a/tests/unit.clj b/tests/unit.clj index 1345501..c398350 100644 --- a/tests/unit.clj +++ b/tests/unit.clj @@ -1689,8 +1689,9 @@ (let [replies (handle-privmsg ["#test" ":no-echo"] alice components)] (is (empty? replies))) - ;; With echo-message: reply includes the message - (swap! alice assoc :caps #{"echo-message"}) + ;; With echo-message + message-tags: reply has @msgid= + (swap! alice assoc :caps + #{"echo-message" "message-tags"}) (let [replies (handle-privmsg ["#test" ":with-echo"] alice components)] (is (= 1 (count replies))) |