summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/papod.clj164
-rw-r--r--tests/integration.clj5
-rw-r--r--tests/unit.clj114
3 files changed, 249 insertions, 34 deletions
diff --git a/src/papod.clj b/src/papod.clj
index ffcf1c2..2c05a0a 100644
--- a/src/papod.clj
+++ b/src/papod.clj
@@ -2030,11 +2030,39 @@
:else mn)))
members)))))
-(defn- join-one!
- [handle client components]
- (let [{:keys [conn clients channels]} components
- nick (client-target client)]
+(defn- chan-modes-for
+ [components handle]
+ (or (when (:chan-modes components)
+ (get @(:chan-modes components) handle))
+ "+nt"))
+
+(defn- chan-symbol
+ [components handle]
+ (let [m (chan-modes-for components handle)]
(cond
+ (string/includes? m "s") "@"
+ (string/includes? m "p") "*"
+ :else "=")))
+
+(defn- join-one!
+ ([handle client components]
+ (join-one! handle nil client components))
+ ([handle key-arg client components]
+ (let [{:keys [conn clients channels]} components
+ nick (client-target client)
+ modes (chan-modes-for components handle)
+ existing? (and channels (seq (get @channels handle)))
+ invited? (when-let [invites (:invites components)]
+ (contains?
+ (get @invites handle #{}) nick))
+ keys-map (some-> components :chan-keys deref)
+ limits (some-> components :chan-limits deref)
+ req-key (when keys-map (get keys-map handle))
+ lim (when limits (get limits handle))
+ full? (and lim
+ (>= (count (get @channels handle))
+ lim))]
+ (cond
;; Validate channel name
(not (channel-handle? handle))
[(numeric-reply client "403"
@@ -2050,6 +2078,30 @@
[(numeric-reply client "403"
(str handle " :No such channel"))]
+ ;; +i (invite-only): require invite
+ (and existing?
+ (not (contains? (get @channels handle) nick))
+ (string/includes? modes "i")
+ (not invited?))
+ [(numeric-reply client "473"
+ (str handle
+ " :Cannot join channel (+i)"))]
+
+ ;; +k (key): require correct key
+ (and existing?
+ (not (contains? (get @channels handle) nick))
+ req-key (not= req-key key-arg))
+ [(numeric-reply client "475"
+ (str handle
+ " :Cannot join channel (+k)"))]
+
+ ;; +l (limit): channel is full
+ (and existing? full?
+ (not (contains? (get @channels handle) nick)))
+ [(numeric-reply client "471"
+ (str handle
+ " :Cannot join channel (+l)"))]
+
:else
(let [db (when conn (d/db conn))
channel-eid (when db (resolve-channel db handle))
@@ -2067,6 +2119,10 @@
:else
(do
+ ;; Consume invite if any
+ (when-let [invites (:invites components)]
+ (swap! invites update handle
+ (fnil disj #{}) nick))
;; PERSIST — single transaction
(let [event-id (java.util.UUID/randomUUID)
already? (and conn channel-eid
@@ -2129,15 +2185,16 @@
"multi-prefix")
members (names-for components handle
:multi-prefix? mp?)
+ sym (chan-symbol components handle)
w (:w @client)]
(when (and w members)
(deliver-to-client! w
(str ":" +server-name+ " 353 " nick
- " = " handle " :" members))
+ " " sym " " handle " :" members))
(deliver-to-client! w
(str ":" +server-name+ " 366 " nick " "
handle " :End of /NAMES list"))))
- [])))))))
+ []))))))))
(defn- handle-join
@@ -2145,9 +2202,14 @@
(if (empty? params)
[(numeric-reply client "461"
"JOIN :Not enough parameters")]
- (let [handles (string/split (first params) #",")]
- (vec (mapcat #(join-one! % client components)
- handles)))))
+ (let [handles (string/split (first params) #",")
+ keys (when (> (count params) 1)
+ (string/split (second params) #","))]
+ (vec
+ (mapcat
+ (fn [i h]
+ (join-one! h (get keys i) client components))
+ (range) handles)))))
(defn- handle-part
[params client components]
@@ -2875,19 +2937,29 @@
;; +l/-l: limit
(= \l mode-char)
- (let [cur (get @(:chan-modes components)
- target "+nt")
+ (let [cur (or (get @(:chan-modes components)
+ target)
+ "+nt")
+ flag "l"
+ new (if adding?
+ (if (string/includes? cur flag)
+ cur
+ (str cur flag))
+ (string/replace cur flag ""))
line (str ":" nick " MODE " target
" " mode-str
- (when mode-arg
+ (when (and adding? mode-arg)
(str " " mode-arg)))]
(when (:chan-modes components)
- (if adding?
- (swap! (:chan-modes components)
- assoc target
- (str "+nt" "l"))
- (swap! (:chan-modes components)
- assoc target "+nt")))
+ (swap! (:chan-modes components)
+ assoc target new))
+ (when-let [limits (:chan-limits components)]
+ (if (and adding? mode-arg)
+ (try
+ (swap! limits assoc target
+ (Integer/parseInt mode-arg))
+ (catch NumberFormatException _ nil))
+ (swap! limits dissoc target)))
(when (and clients channels)
(doseq [mn (get @channels target)
:let [m (get @clients mn)]
@@ -2922,10 +2994,26 @@
;; +k/-k: channel key
(= \k mode-char)
- (let [line (str ":" nick " MODE " target
+ (let [cur (or (get @(:chan-modes components)
+ target)
+ "+nt")
+ flag "k"
+ new (if adding?
+ (if (string/includes? cur flag)
+ cur
+ (str cur flag))
+ (string/replace cur flag ""))
+ line (str ":" nick " MODE " target
" " mode-str
- (when mode-arg
+ (when (and adding? mode-arg)
(str " " mode-arg)))]
+ (when (:chan-modes components)
+ (swap! (:chan-modes components)
+ assoc target new))
+ (when-let [keys (:chan-keys components)]
+ (if (and adding? mode-arg)
+ (swap! keys assoc target mode-arg)
+ (swap! keys dissoc target)))
(when (and clients channels)
(doseq [mn (get @channels target)
:let [m (get @clients mn)]
@@ -3092,6 +3180,9 @@
:else
(let [nick (client-target client)]
+ (when-let [invites (:invites components)]
+ (swap! invites update handle
+ (fnil conj #{}) target))
(when-let [m (and clients
(get @clients target))]
(deliver-to-client! (:w m)
@@ -3147,9 +3238,11 @@
(let [members
(names-for
components handle
- :multi-prefix? mp?)]
+ :multi-prefix? mp?)
+ sym (chan-symbol
+ components handle)]
[(numeric-reply client "353"
- (str "= " handle
+ (str sym " " handle
" :" members))
(numeric-reply client "366"
(str handle
@@ -3172,8 +3265,12 @@
mp?)]
[(numeric-reply
client "353"
- (str "= " ch
- " :" m))]))
+ (str
+ (chan-symbol
+ components
+ ch)
+ " " ch
+ " :" m))]))
@chans))]
(conj replies
(numeric-reply client "366"
@@ -3262,14 +3359,17 @@
:papod.process/hostname (.getHostName
(java.net.InetAddress/getLocalHost))
:papod.process/started-at (java.util.Date.)}])]
- {:conn conn
- :cracha cracha-state
- :process-id process-id
- :clients (atom {})
- :channels (atom {})
- :ops (atom {})
- :voiced (atom {})
- :chan-modes (atom {})}))
+ {:conn conn
+ :cracha cracha-state
+ :process-id process-id
+ :clients (atom {})
+ :channels (atom {})
+ :ops (atom {})
+ :voiced (atom {})
+ :chan-modes (atom {})
+ :chan-keys (atom {})
+ :chan-limits (atom {})
+ :invites (atom {})}))
(defconst- +idle-timeout-ms+
(if-let [t (System/getenv "PAPOD_IDLE_TIMEOUT")]
diff --git a/tests/integration.clj b/tests/integration.clj
index 3e12833..04efc72 100644
--- a/tests/integration.clj
+++ b/tests/integration.clj
@@ -46,7 +46,10 @@
:channels (atom {})
:ops (atom {})
:voiced (atom {})
- :chan-modes (atom {})}))
+ :chan-modes (atom {})
+ :chan-keys (atom {})
+ :chan-limits (atom {})
+ :invites (atom {})}))
(defn- make-client
"Creates a simulated client connection using piped streams.
diff --git a/tests/unit.clj b/tests/unit.clj
index 6b9e36b..5439c71 100644
--- a/tests/unit.clj
+++ b/tests/unit.clj
@@ -112,7 +112,10 @@
{:conn conn :cracha cracha-state :process-id proc-id
:clients (atom {}) :channels (atom {})
:ops (atom {}) :voiced (atom {})
- :chan-modes (atom {})})))
+ :chan-modes (atom {})
+ :chan-keys (atom {})
+ :chan-limits (atom {})
+ :invites (atom {})})))
(defn test-network!
[conn]
@@ -1788,6 +1791,115 @@
(is (= 1 (count replies)))
(is (string/includes? (first replies) "391"))))))
+(deftest test_channel-modes
+ (testing "secret channel (+s) uses @ symbol in NAMES"
+ (let [{:keys [test-network-id] :as components}
+ (test-components-with-network)
+ out (java.io.ByteArrayOutputStream.)
+ c (registered-client "alice" out test-network-id)
+ comp (assoc components
+ :clients
+ (atom {"alice"
+ {:w out :client-atom c}}))]
+ (handle-join ["#sec"] c comp)
+ ;; Mark channel as secret
+ (swap! (:chan-modes comp) assoc "#sec" "+nts")
+ (let [replies (replies-for!
+ {:command "NAMES" :params ["" "#sec"]}
+ c comp)]
+ (is (string/includes? (first replies) "353"))
+ (is (string/includes? (first replies) "@ #sec")))))
+ (testing "+i (invite-only) blocks JOIN with 473"
+ (let [{:keys [test-network-id] :as components}
+ (test-components-with-network)
+ a-out (java.io.ByteArrayOutputStream.)
+ b-out (java.io.ByteArrayOutputStream.)
+ alice (registered-client "alice" a-out test-network-id)
+ bob (registered-client "bob" b-out test-network-id)
+ comp (assoc components
+ :clients (atom
+ {"alice" {:w a-out
+ :client-atom alice}
+ "bob" {:w b-out
+ :client-atom bob}})
+ :channels (atom {}))]
+ (handle-join ["#priv"] alice comp)
+ (swap! (:chan-modes comp) assoc "#priv" "+nti")
+ (let [replies (handle-join ["#priv"] bob comp)]
+ (is (= 1 (count replies)))
+ (is (string/includes? (first replies) "473")))))
+ (testing "INVITE allows +i bypass"
+ (let [{:keys [test-network-id] :as components}
+ (test-components-with-network)
+ a-out (java.io.ByteArrayOutputStream.)
+ b-out (java.io.ByteArrayOutputStream.)
+ alice (registered-client "alice" a-out test-network-id)
+ bob (registered-client "bob" b-out test-network-id)
+ comp (assoc components
+ :clients (atom
+ {"alice" {:w a-out
+ :client-atom alice}
+ "bob" {:w b-out
+ :client-atom bob}})
+ :channels (atom {}))]
+ (handle-join ["#priv"] alice comp)
+ (swap! (:chan-modes comp) assoc "#priv" "+nti")
+ (replies-for!
+ {:command "INVITE" :params ["" "bob" "#priv"]}
+ alice comp)
+ ;; Bob should now be able to join
+ (let [replies (handle-join ["#priv"] bob comp)]
+ (is (empty?
+ (filter #(re-find #" 473 " %) replies))))))
+ (testing "+l limit blocks JOIN with 471"
+ (let [{:keys [test-network-id] :as components}
+ (test-components-with-network)
+ a-out (java.io.ByteArrayOutputStream.)
+ b-out (java.io.ByteArrayOutputStream.)
+ alice (registered-client "alice" a-out test-network-id)
+ bob (registered-client "bob" b-out test-network-id)
+ comp (assoc components
+ :clients (atom
+ {"alice" {:w a-out
+ :client-atom alice}
+ "bob" {:w b-out
+ :client-atom bob}})
+ :channels (atom {}))]
+ (handle-join ["#small"] alice comp)
+ (swap! (:chan-modes comp) assoc "#small" "+ntl")
+ (swap! (:chan-limits comp) assoc "#small" 1)
+ (let [replies (handle-join ["#small"] bob comp)]
+ (is (string/includes? (first replies) "471")))))
+ (testing "+k key blocks JOIN with 475"
+ (let [{:keys [test-network-id] :as components}
+ (test-components-with-network)
+ a-out (java.io.ByteArrayOutputStream.)
+ b-out (java.io.ByteArrayOutputStream.)
+ alice (registered-client "alice" a-out test-network-id)
+ bob (registered-client "bob" b-out test-network-id)
+ comp (assoc components
+ :clients (atom
+ {"alice" {:w a-out
+ :client-atom alice}
+ "bob" {:w b-out
+ :client-atom bob}})
+ :channels (atom {}))]
+ (handle-join ["#locked"] alice comp)
+ (swap! (:chan-modes comp) assoc "#locked" "+ntk")
+ (swap! (:chan-keys comp) assoc "#locked" "secret")
+ ;; No key
+ (let [replies (handle-join ["#locked"] bob comp)]
+ (is (string/includes? (first replies) "475")))
+ ;; Wrong key
+ (let [replies (handle-join ["#locked" "wrong"]
+ bob comp)]
+ (is (string/includes? (first replies) "475")))
+ ;; Right key
+ (let [replies (handle-join ["#locked" "secret"]
+ bob comp)]
+ (is (empty?
+ (filter #(re-find #" 475 " %) replies)))))))
+
(defn -main
[& _args]
(binding [*out* *err*]
generated by cgit v1.3 (git 2.53.0) at 2026-06-21 21:20:56 +0000