Multi-session SASL: shared-nick collisions and MARKREAD broadcast

When two clients are SASL-authenticated to the same account, they may
now share a nickname instead of getting a 433 ERR_NICKNAMEINUSE on the
second NICK. The first session keeps the canonical :clients[nick] entry
(so nick-keyed PRIVMSG delivery is unchanged); siblings register only
in :account-clients[account]. Disconnect cleanup removes the per-account
slot and only drops the :clients[nick] entry when the disconnecting
session was the canonical one.

handle-markread now fans out the MARKREAD line to every other live
session of the same account that negotiated draft/read-marker, fixing
draft/read-marker §"propagated to other sessions" (previously hung).

Side effect: ZNC playback's reattach-to-same-nick flow no longer hangs
either; the test now fails fast on the missing *playback bot rather
than blocking on the second registration.

1 files changed, 68 insertions, 12 deletions

diff --git a/src/papod.clj b/src/papod.clj
index e59ba7f..f62c363 100644
--- a/src/papod.clj
+++ b/src/papod.clj
@@ -1101,8 +1101,25 @@
           (when-let [n (:n-unreg components)]
             (swap! n (fn [v] (max 0 (dec v)))))
           (when (:clients components)
-            (swap! (:clients components) assoc nick
-                   {:w w :client-atom client}))
+            (swap! (:clients components)
+                   (fn [m]
+                     (let [ex (get m nick)
+                           ex-acct (some-> (:client-atom ex)
+                                           deref
+                                           :account)
+                           same? (and (:account @client)
+                                      ex-acct
+                                      (= ex-acct
+                                         (:account
+                                          @client)))]
+                       ;; A same-account session keeps the
+                       ;; existing canonical entry so that
+                       ;; nick-keyed PRIVMSG delivery does
+                       ;; not get redirected.
+                       (if same?
+                         m
+                         (assoc m nick
+                                {:w w :client-atom client}))))))
           (when-let [mx (:max-users components)]
             (let [n (count
                      (filter
@@ -1201,21 +1218,32 @@
                   (fn [[k _]]
                     (= (string/lower-case k) lower))
                   @(:clients components)))]
-               ;; Only ghost when BOTH sides are stale
-               ;; (neither has finished registration).
                (let [ca   (:client-atom existing)
                      ex   (when ca @ca)
                      old  (:socket ex)
                      stale? (and ex
                                  (not (:registered? ex))
-                                 old)]
-                 (if (and stale?
-                          (not (:registered? @client)))
+                                 old)
+                     same-account?
+                     (and (:authenticated? @client)
+                          (:account @client)
+                          (:authenticated? ex)
+                          (= (:account @client)
+                             (:account ex)))]
+                 (cond
+                   ;; Same SASL account: allow shared nick
+                   ;; (multi-session for the same identity)
+                   same-account? false
+                   ;; Both still mid-registration: ghost the
+                   ;; stale one.
+                   (and stale?
+                        (not (:registered? @client)))
                    (do (try (.close old)
                             (catch Exception _))
                        (swap! (:clients components)
                               dissoc existing-nick)
                        false)
+                   :else
                    (not= existing-nick
                          (:nick @client))))))
            true)
@@ -1408,6 +1436,9 @@
                                    :session-id result
                                    :account authcid)
               (create-session+logon! (:conn components) client result)
+              (when-let [ac (:account-clients components)]
+                (swap! ac update authcid (fnil conj #{})
+                       client))
               [(numeric-reply client "900"
                  (str nick "!" nick "@localhost " authcid
                       " :You are now logged in as " authcid))
@@ -3421,7 +3452,10 @@
                          (re-matches ts-rgx timestamp))
                 stored  (stored-fn)
                 advance? (or (nil? stored)
-                             (pos? (compare ts-only stored)))]
+                             (pos? (compare ts-only stored)))
+                effective (if advance? ts-only stored)
+                line (str ":" +server-name+ " MARKREAD "
+                          handle " timestamp=" effective)]
             (when advance?
               (cond
                 (and chan? conn chan-eid)
@@ -3434,9 +3468,19 @@
                 (when (:user-markers components)
                   (swap! (:user-markers components)
                          assoc user-key ts-only))))
-            [(str ":" +server-name+ " MARKREAD " handle
-                  " timestamp="
-                  (if advance? ts-only stored))])
+            ;; Broadcast to other sessions of the same
+            ;; account that negotiated draft/read-marker.
+            (when advance?
+              (when-let [acct (:account @client)]
+                (when-let [ac (:account-clients
+                               components)]
+                  (doseq [c (get @ac acct #{})
+                          :when (and (not= c client)
+                                     (contains?
+                                      (or (:caps @c) #{})
+                                      "draft/read-marker"))]
+                    (deliver-to-client! (:w @c) line)))))
+            [line])
 
           ;; SET with bad timestamp shape: reject
           (and timestamp
@@ -5173,6 +5217,7 @@
      :cracha      cracha-state
      :process-id  process-id
      :clients     (atom {})
+     :account-clients (atom {})
      :channels    (atom {})
      :ops         (atom {})
      :voiced      (atom {})
@@ -5249,8 +5294,19 @@
                               :host     "localhost"
                               :ts       (System/currentTimeMillis)}]
                          (vec (take 32 (cons entry hist))))))))
+          (when-let [acct (:account @client)]
+            (when (:account-clients components)
+              (swap! (:account-clients components)
+                     update acct
+                     (fnil disj #{}) client)))
+          ;; Only remove from :clients if THIS atom is the
+          ;; canonical session for the nick (other multi-
+          ;; session siblings might still be live).
           (when (:clients components)
-            (swap! (:clients components) dissoc nick))
+            (let [entry (get @(:clients components) nick)]
+              (when (or (nil? entry)
+                        (= client (:client-atom entry)))
+                (swap! (:clients components) dissoc nick))))
           (when (:channels components)
             (doseq [[ch _] @(:channels components)]
               (swap! (:channels components) update ch disj nick)))