diff options
| -rw-r--r-- | src/papod.clj | 80 |
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))) |