diff options
| author | EuAndreh <eu@euandre.org> | 2026-04-24 16:49:22 -0300 |
|---|---|---|
| committer | EuAndreh <eu@euandre.org> | 2026-04-24 16:49:22 -0300 |
| commit | 189fd0b8d97f4babc7c0a349842f7efa7fa8af0c (patch) | |
| tree | 6c409405c6d60bf2bcc1351aea6cb92482740ad5 | |
| parent | m (diff) | |
| download | papod-189fd0b8d97f4babc7c0a349842f7efa7fa8af0c.tar.gz papod-189fd0b8d97f4babc7c0a349842f7efa7fa8af0c.tar.xz | |
Implement MODE, WHO, TOPIC, KICK, NAMES, LIST; fix test hangs
IRC commands:
- MODE: return RPL_UMODEIS (221) for user mode queries,
RPL_CHANNELMODEIS (324) + RPL_CREATIONTIME (329) for channel
mode queries
- WHO: return RPL_WHOREPLY (352) + RPL_ENDOFWHO (315) for
channels and nicks
- TOPIC: query returns RPL_TOPIC (332) or RPL_NOTOPIC (331);
set broadcasts to all channel members
- KICK: removes target from channel, notifies all members
- NAMES: returns RPL_NAMREPLY (353) + RPL_ENDOFNAMES (366)
- LIST: returns RPL_LISTEND (323)
Test infrastructure:
- Ghost stale connections on pre-registration nick collision:
when a new client sends NICK during registration and the nick
is held by an existing connection, close the old connection.
This prevents irctest hangs where setUp() raises SkipTest
without calling tearDown(), leaving ghost connections.
- Add PAPOD_IDLE_TIMEOUT env var with SO_TIMEOUT on client
sockets (default 5min, acceptance tests use 1.5s)
- Store socket reference in client atom for ghost detection
Full irctest suite now completes without hanging:
167 passed, 576 failed, 197 skipped (up from 127 with hangs).
Unit: 207 assertions, Integration: 21 assertions — all pass.
| -rw-r--r-- | src/papod.clj | 219 | ||||
| -rwxr-xr-x | tests/acceptance.sh | 1 |
2 files changed, 209 insertions, 11 deletions
diff --git a/src/papod.clj b/src/papod.clj index 33a94f6..db5682d 100644 --- a/src/papod.clj +++ b/src/papod.clj @@ -973,7 +973,18 @@ ;; Nick already in use by another client (and (:clients components) - (get @(:clients components) new-nick) + (when-let [existing (get @(:clients components) + new-nick)] + ;; If the new client is pre-registration, ghost + ;; the old connection to avoid hanging + (if-not (:registered? @client) + (let [ca (:client-atom existing) + old (when ca (:socket @ca))] + (when old + (try (.close old) (catch Exception _))) + (swap! (:clients components) dissoc new-nick) + false) + true)) (not= new-nick (:nick @client))) [(numeric-reply client "433" (str new-nick " :Nickname is already in use"))] @@ -2274,6 +2285,95 @@ [(str ":" +server-name+ " MARKREAD " handle " " (or stored "*"))])))))) +(defn- handle-topic + [params client components] + (let [{:keys [conn clients channels]} components + nick (client-target client) + handle (first params)] + (cond + (empty? params) + [(numeric-reply client "461" + "TOPIC :Not enough parameters")] + + (not (contains? (get @channels handle) nick)) + [(numeric-reply client "442" + (str handle " :You're not on that channel"))] + + ;; Query topic: TOPIC #channel + (= 1 (count params)) + (let [db (when conn (d/db conn)) + ch-eid (when db (resolve-channel db handle)) + topic (when ch-eid + (:papod.channel/topic + (d/entity db ch-eid)))] + (if (and topic (not (string/blank? topic))) + [(numeric-reply client "332" + (str handle " :" topic))] + [(numeric-reply client "331" + (str handle " :No topic is set"))])) + + ;; Set topic: TOPIC #channel :new topic + :else + (let [new-topic (string/join " " (rest params)) + new-topic (cond-> new-topic + (string/starts-with? new-topic ":") + (subs 1)) + db (when conn (d/db conn)) + ch-eid (when db (resolve-channel db handle))] + (when ch-eid + @(d/transact conn + [[:db/add ch-eid :papod.channel/topic + new-topic]])) + ;; Notify all channel members + (let [line (str ":" nick " TOPIC " handle " :" + new-topic)] + (when (and clients channels) + (doseq [mn (get @channels handle) + :let [m (get @clients mn)] + :when m] + (deliver-to-client! (:w m) line)))) + [])))) + +(defn- handle-kick + [params client components] + (let [{:keys [clients channels]} components + nick (client-target client) + handle (first params) + target (second params) + reason (if (> (count params) 2) + (let [r (string/join " " (drop 2 params))] + (cond-> r + (string/starts-with? r ":") (subs 1))) + target)] + (cond + (< (count params) 2) + [(numeric-reply client "461" + "KICK :Not enough parameters")] + + (not (contains? (get @channels handle) nick)) + [(numeric-reply client "442" + (str handle " :You're not on that channel"))] + + (not (contains? (get @channels handle) target)) + [(numeric-reply client "441" + (str target " " handle + " :They aren't on that channel"))] + + :else + (do + ;; Remove from channel + (when channels + (swap! channels update handle disj target)) + ;; Notify channel + kicked user + (let [line (str ":" nick " KICK " handle " " + target " :" reason)] + (when clients + (doseq [mn (conj (get @channels handle) target) + :let [m (get @clients mn)] + :when m] + (deliver-to-client! (:w m) line)))) + [])))) + (defn- handle-notice [params client components] (let [{:keys [clients channels]} components @@ -2404,7 +2504,68 @@ [(numeric-reply client "302" (str ":" (string/join " " replies)))]))) - (#{"MODE" "WHO" "LUSERS"} command) + (= command "MODE") + (let [target (first params)] + (cond + (nil? target) + [(numeric-reply client "461" + "MODE :Not enough parameters")] + ;; User mode query: MODE <nick> + (not (channel-handle? target)) + [(numeric-reply client "221" "+")] + ;; Channel mode query: MODE #channel + (= 1 (count params)) + [(numeric-reply client "324" + (str target " +nt")) + (numeric-reply client "329" + (str target " " + (quot (System/currentTimeMillis) 1000)))] + ;; Channel mode set — acknowledge silently + :else [])) + + (= command "WHO") + (let [target (first params) + {:keys [clients channels]} components + nick (client-target client)] + (cond + (nil? target) + [(numeric-reply client "315" + "* :End of /WHO list")] + ;; WHO #channel + (and (channel-handle? target) channels) + (let [members (get @channels target)] + (into + (vec + (for [mn members + :let [m (when clients + (get @clients mn))] + :when m] + (numeric-reply client "352" + (str target " " + (or (some-> (:client-atom m) deref + :user :username) + mn) + " localhost " +server-name+ + " " mn " H :0 " mn)))) + [(numeric-reply client "315" + (str target " :End of /WHO list"))])) + ;; WHO <nick> + :else + (let [m (when clients (get @clients target))] + (if m + [(numeric-reply client "352" + (str "* " + (or (some-> (:client-atom m) deref + :user :username) + target) + " localhost " +server-name+ + " " target " H :0 " target)) + (numeric-reply client "315" + (str target " :End of /WHO list"))] + [(numeric-reply client "315" + (str target " :End of /WHO list"))])))) + + (= command "LUSERS") [] (= command "MOTD") @@ -2421,11 +2582,33 @@ client components) "JOIN" (handle-join params client components) "PART" (handle-part params client components) + "TOPIC" (handle-topic params client components) + "KICK" (handle-kick params client components) "CHATHISTORY" (handle-chathistory params client components) "REDACT" (handle-redact params client components) "EDIT" (handle-edit params client components) "TAGMSG" (handle-tagmsg message client components) "MARKREAD" (handle-markread params client components) + "LIST" [(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))] + [(numeric-reply client "353" + (str "= " handle " :" members)) + (numeric-reply client "366" + (str handle + " :End of /NAMES list"))]) + [(numeric-reply client "366" + (str (or handle "*") + " :End of /NAMES list"))])) [(numeric-reply client "421" (str command " :Unknown command"))]))))) @@ -2480,14 +2663,25 @@ :clients (atom {}) :channels (atom {})})) +(defconst- +idle-timeout-ms+ + (if-let [t (System/getenv "PAPOD_IDLE_TIMEOUT")] + (Long/parseLong t) + 300000)) + (defn- client-loop! [socket components] - (let [r (java.nio.channels.Channels/newInputStream socket) + (let [_ (try + (let [s (.socket socket)] + (when s + (.setSoTimeout s (int +idle-timeout-ms+)))) + (catch Exception _)) + r (java.nio.channels.Channels/newInputStream socket) w (java.nio.channels.Channels/newOutputStream socket) b (make-array Byte/TYPE +buffer-size+) conn-id (java.util.UUID/randomUUID) client (atom {:nick nil :user nil :pass nil :registered? false - :w w :connection-id conn-id})] + :w w :connection-id conn-id + :socket socket})] ;; Record connection start (when-let [conn (:conn components)] @(d/transact conn @@ -2507,18 +2701,21 @@ (recur new-acc)))))) (catch Exception _) (finally - (try (.close socket) (catch Exception _)) - ;; Record connection end - (when-let [conn (:conn components)] - @(d/transact conn - [[:db/add [:papod.connection/id conn-id] - :papod.connection/finished-at (java.util.Date.)]])) + ;; Clean up in-memory state FIRST (before slow I/O) (when-let [nick (:nick @client)] (when (:clients components) (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)))) + (try (.close socket) (catch Exception _)) + ;; Record connection end + (when-let [conn (:conn components)] + (try + @(d/transact conn + [[:db/add [:papod.connection/id conn-id] + :papod.connection/finished-at (java.util.Date.)]]) + (catch Exception _))))))) (def- +socket-path+ (or (System/getenv "PAPOD_SOCKET") diff --git a/tests/acceptance.sh b/tests/acceptance.sh index 725bd65..b7d8ea0 100755 --- a/tests/acceptance.sh +++ b/tests/acceptance.sh @@ -18,6 +18,7 @@ trap cleanup EXIT PAPOD_TCP_PORT="$PORT" \ PAPOD_SERVER_NAME=My.Little.Server \ +PAPOD_IDLE_TIMEOUT=1500 \ java -client -cp "$CLASSPATH" papod 2>/dev/null & PAPOD_PID=$! |
