diff options
| -rw-r--r-- | src/papod.clj | 253 | ||||
| -rw-r--r-- | tests/integration.clj | 3 | ||||
| -rw-r--r-- | tests/unit.clj | 11 |
3 files changed, 188 insertions, 79 deletions
diff --git a/src/papod.clj b/src/papod.clj index 94c7bb2..4537e33 100644 --- a/src/papod.clj +++ b/src/papod.clj @@ -1045,22 +1045,27 @@ [(str ":" +server-name+ " CAP " nick " LS :sasl=" +sasl-mechanisms+ " message-tags server-time echo-message batch" - " labeled-response draft/multiline=max-bytes=65536,max-lines=100" + " labeled-response multi-prefix" + " draft/multiline=max-bytes=65536,max-lines=100" " draft/read-marker draft/message-redaction" " draft/message-editing")]) "REQ" - (let [requested (set (string/split (string/trim args) #"\s+")) - supported #{"sasl" "message-tags" "server-time" "echo-message" - "batch" "labeled-response" "draft/multiline" - "draft/read-marker" "draft/message-redaction" + (let [raw-args (string/trim args) + requested (string/split raw-args #"\s+") + supported #{"sasl" "message-tags" "server-time" + "echo-message" "batch" + "labeled-response" "multi-prefix" + "draft/multiline" "draft/read-marker" + "draft/message-redaction" "draft/message-editing"}] (if-not (every? supported requested) [(str ":" +server-name+ " CAP " nick - " NAK :" (string/join " " requested))] - (do (swap! client update :caps (fnil into #{}) requested) + " NAK :" raw-args)] + (do (swap! client update :caps + (fnil into #{}) requested) [(str ":" +server-name+ " CAP " nick - " ACK :" (string/join " " requested))]))) + " ACK :" raw-args)]))) "LIST" [(str ":" +server-name+ " CAP " nick @@ -1876,6 +1881,26 @@ [])) [])))))))) +(defn- is-op? + [components handle nick] + (when-let [ops (:ops components)] + (contains? (get @ops handle) nick))) + +(defn- names-for + [components handle] + (let [members (when (:channels components) + (get @(:channels components) handle)) + ops (:ops components)] + (when (seq members) + (string/join + " " + (map (fn [mn] + (if (and ops + (contains? (get @ops handle) mn)) + (str "@" mn) + mn)) + members))))) + (defn- join-one! [handle client components] (let [{:keys [conn clients channels]} components @@ -1952,21 +1977,26 @@ ;; UPDATE in-memory (when channels (swap! channels update handle (fnil conj #{}) nick)) + ;; Auto-op channel creator + (when (and (nil? channel-eid) (:ops components)) + (swap! (:ops components) update handle + (fnil conj #{}) nick)) ;; DELIVER - (let [line (tag-line event-id (str ":" nick " JOIN " handle))] + (let [line (tag-line event-id + (str ":" nick " JOIN " handle))] (when (and clients channels) (doseq [member-nick (get @channels handle) - :let [member (get @clients member-nick)] + :let [member (get @clients + member-nick)] :when member] (deliver-to-client! (:w member) line)))) ;; Send NAMES to the joining client - (let [members (when channels - (string/join " " (get @channels handle))) + (let [members (names-for components handle) w (:w @client)] (when (and w members) (deliver-to-client! w - (str ":" +server-name+ " 353 " nick " = " - handle " :" members)) + (str ":" +server-name+ " 353 " nick + " = " handle " :" members)) (deliver-to-client! w (str ":" +server-name+ " 366 " nick " " handle " :End of /NAMES list")))) @@ -2006,9 +2036,11 @@ :let [m (get @clients mn)] :when m] (deliver-to-client! (:w m) line))) - ;; Remove from channel + ;; Remove from channel and ops (when channels (swap! channels update handle disj nick)) + (when (:ops components) + (swap! (:ops components) update handle disj nick)) [])))) (defn- handle-chathistory @@ -2317,6 +2349,11 @@ [(numeric-reply client "461" "TOPIC :Not enough parameters")] + ;; Channel doesn't exist at all + (and channels (nil? (get @channels handle))) + [(numeric-reply client "403" + (str handle " :No such channel"))] + (not (contains? (get @channels handle) nick)) [(numeric-reply client "442" (str handle " :You're not on that channel"))] @@ -2386,11 +2423,20 @@ (str target " " handle " :They aren't on that channel"))] + ;; Check op privileges + (not (is-op? components handle nick)) + [(numeric-reply client "482" + (str handle + " :You're not channel operator"))] + :else (do - ;; Remove from channel + ;; Remove from channel and ops (when channels (swap! channels update handle disj target)) + (when (:ops components) + (swap! (:ops components) update handle + disj target)) ;; Notify channel + kicked user (let [line (str ":" nick " KICK " handle " " target " :" reason)] @@ -2470,10 +2516,13 @@ :let [m (get @clients member-nick)] :when m] (deliver-to-client! (:w m) quit-line)))) - ;; Remove from channels and clients + ;; Remove from channels, ops, and clients (when channels (doseq [[ch _] @channels] (swap! channels update ch disj nick))) + (when (:ops components) + (doseq [[ch _] @(:ops components)] + (swap! (:ops components) update ch disj nick))) (when clients (swap! clients dissoc nick)) (swap! client assoc :quit? true) @@ -2491,28 +2540,45 @@ (handle-notice params client components) (= command "WHOIS") - (let [target (first params) - {:keys [clients]} components] - (if-let [m (and target clients (get @clients target))] + (let [;; WHOIS supports WHOIS <target> <nick> form + qnick (if (> (count params) 1) + (second params) + (first params)) + {:keys [clients]} components + q-lower (when qnick + (string/lower-case qnick)) + [found-nick m] + (when (and qnick clients) + (first + (filter + (fn [[k _]] + (= (string/lower-case k) q-lower)) + @clients)))] + (if m (let [ca (:client-atom m) - u (when ca (:user @ca)) - uname (or (:username u) target) - rname (or (:realname u) target) - away (when ca (:away @ca))] - (cond-> [(numeric-reply client "311" - (str target " " uname " localhost * :" - rname))] + st (when ca @ca) + u (:user st) + uname (or (:username u) found-nick) + rname (or (:realname u) found-nick) + away (:away st)] + (cond-> + [(numeric-reply client "311" + (str found-nick " " uname + " localhost * :" rname)) + (numeric-reply client "312" + (str found-nick " " +server-name+ + " :papod"))] away (conj (numeric-reply client "301" - (str target " :" away))) + (str found-nick " :" away))) true (conj (numeric-reply client "318" - (str target + (str found-nick " :End of /WHOIS list"))))) [(numeric-reply client "401" - (str (or target "*") " :No such nick")) + (str (or qnick "*") " :No such nick")) (numeric-reply client "318" - (str (or target "*") + (str (or qnick "*") " :End of /WHOIS list"))])) (= command "USERHOST") @@ -2554,7 +2620,24 @@ (= command "WHO") (let [target (first params) {:keys [clients channels]} components - nick (client-target client)] + nick (client-target client) + who-reply + (fn [chan-name mn m] + (let [ca (:client-atom m) + st (when ca @ca) + away (:away st) + flag (str (if away "G" "H") + (when (and chan-name + (is-op? components + chan-name mn)) + "@")) + uname (or (:username (:user st)) mn) + rname (or (:realname (:user st)) mn)] + (numeric-reply client "352" + (str chan-name " " uname + " localhost " +server-name+ + " " mn " " flag + " :0 " rname))))] (cond (nil? target) [(numeric-reply client "315" @@ -2564,39 +2647,35 @@ (let [members (get @channels target)] (into (vec - (for [mn members + (for [mn (or members []) :let [m (when clients (get @clients mn))] - :when m - :let [ca (:client-atom m) - away (when ca (:away @ca)) - flag (if away "G" "H") - uname (or (some-> ca deref - :user :username) - mn)]] - (numeric-reply client "352" - (str target " " uname - " localhost " +server-name+ - " " mn " " flag " :0 " mn)))) + :when m] + (who-reply target mn m))) [(numeric-reply client "315" (str target " :End of /WHO list"))])) - ;; WHO <nick> + ;; WHO * — all visible users + (= "*" target) + (into + (vec + (for [[mn m] (when clients @clients)] + (who-reply "*" mn m))) + [(numeric-reply client "315" + "* :End of /WHO list")]) + ;; WHO <nick> — exact or case-insensitive :else - (let [m (when clients (get @clients target))] + (let [t-lower (string/lower-case target) + [found-nick m] + (when clients + (first + (filter + (fn [[k _]] + (= (string/lower-case k) t-lower)) + @clients)))] (if m - (let [ca (:client-atom m) - away (when ca (:away @ca)) - flag (if away "G" "H") - uname (or (some-> ca deref - :user :username) - target)] - [(numeric-reply client "352" - (str "* " uname - " localhost " +server-name+ - " " target " " flag - " :0 " target)) - (numeric-reply client "315" - (str target " :End of /WHO list"))]) + [(who-reply "*" found-nick m) + (numeric-reply client "315" + (str target " :End of /WHO list"))] [(numeric-reply client "315" (str target " :End of /WHO list"))])))) @@ -2703,24 +2782,46 @@ (count members) " :")))) (numeric-reply client "323" ":End of /LIST"))) - "NAMES" (let [handle (first params)] - (if (and handle - (:channels components) - (get @(:channels components) - handle)) - (let [members - (string/join - " " - (get @(:channels components) - handle))] + "NAMES" (let [handle (first params) + chans (:channels components)] + (cond + ;; NAMES #channel + (and handle chans + (get @chans handle)) + (let [members (names-for + components + handle)] [(numeric-reply client "353" - (str "= " handle " :" members)) + (str "= " handle + " :" members)) (numeric-reply client "366" (str handle " :End of /NAMES list"))]) + ;; NAMES with specific but nonexistent + handle + [(numeric-reply client "366" + (str handle + " :End of /NAMES list"))] + ;; NAMES without args — all channels + chans + (let [replies + (vec + (mapcat + (fn [[ch _]] + (when-let + [m (names-for + components ch)] + [(numeric-reply + client "353" + (str "= " ch + " :" m))])) + @chans))] + (conj replies + (numeric-reply client "366" + "* :End of /NAMES list"))) + :else [(numeric-reply client "366" - (str (or handle "*") - " :End of /NAMES list"))])) + "* :End of /NAMES list")])) [(numeric-reply client "421" (str command " :Unknown command"))]))))) @@ -2773,7 +2874,8 @@ :cracha cracha-state :process-id process-id :clients (atom {}) - :channels (atom {})})) + :channels (atom {}) + :ops (atom {})})) (defconst- +idle-timeout-ms+ (if-let [t (System/getenv "PAPOD_IDLE_TIMEOUT")] @@ -2819,7 +2921,10 @@ (swap! (:clients components) dissoc nick)) (when (:channels components) (doseq [[ch _] @(:channels components)] - (swap! (:channels components) update ch disj nick)))) + (swap! (:channels components) update ch disj nick))) + (when (:ops components) + (doseq [[ch _] @(:ops components)] + (swap! (:ops components) update ch disj nick)))) (try (.close socket) (catch Exception _)) ;; Record connection end (when-let [conn (:conn components)] diff --git a/tests/integration.clj b/tests/integration.clj index 769af90..ed70e4e 100644 --- a/tests/integration.clj +++ b/tests/integration.clj @@ -43,7 +43,8 @@ :process-id process-id :net-id net-id :clients (atom {}) - :channels (atom {})})) + :channels (atom {}) + :ops (atom {})})) (defn- make-client "Creates a simulated client connection using piped streams. diff --git a/tests/unit.clj b/tests/unit.clj index f2718eb..f6a74de 100644 --- a/tests/unit.clj +++ b/tests/unit.clj @@ -110,7 +110,8 @@ :papod.process/hostname "test" :papod.process/started-at (java.util.Date.)}]) {:conn conn :cracha cracha-state :process-id proc-id - :clients (atom {}) :channels (atom {})}))) + :clients (atom {}) :channels (atom {}) + :ops (atom {})}))) (defn test-network! [conn] @@ -587,7 +588,7 @@ (testing "CAP REQ unsupported capability" (let [c (atom {:nick "x" :cap-negotiating? true})] (is (string/includes? - (first (handle-cap ["REQ" ":multi-prefix"] c no-conn)) + (first (handle-cap ["REQ" ":unknown-cap"] c no-conn)) "NAK")))) (testing "already authenticated" (let [c (atom {:nick "x" :caps #{"sasl"} :authenticated? true})] @@ -1258,7 +1259,8 @@ :clients (atom {"alice" {:w alice-out} "bob" {:w bob-out} "baz" {:w baz-out}}) - :channels (atom {"#test" #{"alice" "bob" "baz"}})) + :channels (atom {"#test" #{"alice" "bob" "baz"}}) + :ops (atom {"#test" #{"alice"}})) alice (registered-client "alice" alice-out)] (handle-kick ["#test" "bob" ":bye!"] alice components) ;; bob removed from channel @@ -1278,7 +1280,8 @@ (assoc (test-components) :clients (atom {"alice" {:w alice-out} "bob" {:w bob-out}}) - :channels (atom {"#test" #{"alice" "bob"}})) + :channels (atom {"#test" #{"alice" "bob"}}) + :ops (atom {"#test" #{"alice"}})) alice (registered-client "alice" alice-out)] (handle-kick ["#test" "bob"] alice components) (is (string/includes? (.toString bob-out "UTF-8") |