fix/bug-48598 242c8374b0 22/27: Favor network identities in erc-join

[F. Jason Park]

branch: fix/bug-48598
commit 242c8374b095e8326d78caca37c6bafc084a7d16
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Favor network identities in erc-join
    
    * lisp/erc/erc-join.el (erc-autojoin-channels, erc-autojoin-add,
    erc-autojoin-remove): favor network identities, which in practice are
    almost always the same as networks, when dealing with
    `erc-autojoin-alist'.
    
    (erc-autojoin--join): Factor out new helper from hookees
    `erc-autojoin-after-ident' and `erc-autojoin-channels'.
    
    (erc-autojoin-after-ident, erc-autojoin-channels): No longer make a
    point of returning nil because the hooks they're registered on,
    `erc-nickserv-identified-hook' and `erc-after-connect', don't stop on
    success.
---
 lisp/erc/erc-join.el            | 117 ++++++--------
 test/lisp/erc/erc-join-tests.el | 347 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 394 insertions(+), 70 deletions(-)

diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el
index 425de4dc56..fcfb961bff 100644
--- a/lisp/erc/erc-join.el
+++ b/lisp/erc/erc-join.el
@@ -33,8 +33,6 @@
 ;;; Code:
 
 (require 'erc)
-(require 'auth-source)
-(require 'erc-networks)
 
 (defgroup erc-autojoin nil
   "Enable autojoining."
@@ -123,33 +121,33 @@ This is called from a timer set up by 
`erc-autojoin-channels'."
       (erc-autojoin-channels server nick))))
 
 (defun erc-autojoin-server-match (candidate)
-  "Match the current network or server against CANDIDATE.
-This should be a key from `erc-autojoin-channels-alist'."
-  (or (eq candidate (erc-network))
-      (and (stringp candidate)
-          (string-match-p candidate
-                           (or erc-server-announced-name
-                              erc-session-server)))))
+  "Match the current session ID or server against CANDIDATE.
+CANDIDATE is a key from `erc-autojoin-channels-alist'.  Return the
+matching entity, either a string or a non-nil symbol, in the case of a
+network or a session ID.  Return nil on failure."
+  (if (symbolp candidate)
+      (when-let ((esid (erc-networks--id-symbol erc-networks--id))
+                 ((eq esid candidate)))
+        esid)
+    (when (stringp candidate)
+      (string-match-p candidate (or erc-server-announced-name
+                                    erc-session-server)))))
+
+(defun erc-autojoin--join ()
+  ;; This is called in the server buffer
+  (pcase-dolist (`(,name . ,channels) erc-autojoin-channels-alist)
+    (when-let ((match (erc-autojoin-server-match name)))
+      (dolist (chan channels)
+        (let ((buf (erc-get-buffer chan erc-server-process)))
+          (unless (and buf (with-current-buffer buf
+                             (erc--current-buffer-joined-p)))
+            (erc-server-join-channel match chan)))))))
 
 (defun erc-autojoin-after-ident (_network _nick)
   "Autojoin channels in `erc-autojoin-channels-alist'.
 This function is run from `erc-nickserv-identified-hook'."
-  (if erc--autojoin-timer
-      (setq erc--autojoin-timer
-           (cancel-timer erc--autojoin-timer)))
   (when (eq erc-autojoin-timing 'ident)
-    (let ((server (or erc-session-server erc-server-announced-name))
-         (joined (mapcar (lambda (buf)
-                           (with-current-buffer buf (erc-default-target)))
-                         (erc-channel-list erc-server-process))))
-      ;; We may already be in these channels, e.g. because the
-      ;; autojoin timer went off.
-      (dolist (l erc-autojoin-channels-alist)
-       (when (erc-autojoin-server-match (car l))
-         (dolist (chan (cdr l))
-           (unless (erc-member-ignore-case chan joined)
-             (erc-server-join-channel server chan)))))))
-  nil)
+    (erc-autojoin--join)))
 
 (defun erc-autojoin-channels (server nick)
   "Autojoin channels in `erc-autojoin-channels-alist'."
@@ -162,24 +160,7 @@ This function is run from `erc-nickserv-identified-hook'."
                              #'erc-autojoin-channels-delayed
                              server nick (current-buffer))))
     ;; `erc-autojoin-timing' is `connect':
-    (let ((server (or erc-session-server erc-server-announced-name)))
-      (dolist (l erc-autojoin-channels-alist)
-        (when (erc-autojoin-server-match (car l))
-         (dolist (chan (cdr l))
-           (let ((buffer
-                   (car (erc-buffer-filter
-                         (lambda ()
-                           (let ((current (erc-default-target)))
-                             (and (stringp current)
-                                  (erc-autojoin-server-match (car l))
-                                  (string-equal (erc-downcase chan)
-                                                (erc-downcase current)))))))))
-             (when (or (not buffer)
-                       (not (with-current-buffer buffer
-                               (erc--current-buffer-joined-p))))
-               (erc-server-join-channel server chan))))))))
-  ;; Return nil to avoid stomping on any other hook funcs.
-  nil)
+    (erc-autojoin--join)))
 
 (defun erc-autojoin-current-server ()
   "Compute the current server for lookup in `erc-autojoin-channels-alist'.
@@ -192,22 +173,17 @@ Respects `erc-autojoin-domain-only'."
 
 (defun erc-autojoin-add (proc parsed)
   "Add the channel being joined to `erc-autojoin-channels-alist'."
-  (let* ((chnl (erc-response.contents parsed))
-        (nick (car (erc-parse-user (erc-response.sender parsed))))
-        (server (with-current-buffer (process-buffer proc)
-                  (erc-autojoin-current-server))))
-    (when (erc-current-nick-p nick)
-      (let ((elem (or (assoc (erc-network) erc-autojoin-channels-alist)
-                     (assoc server erc-autojoin-channels-alist))))
-       (if elem
-           (unless (member chnl (cdr elem))
-             (setcdr elem (cons chnl (cdr elem))))
-         ;; This always keys on server, not network -- user can
-         ;; override by simply adding a network to
-         ;; `erc-autojoin-channels-alist'
-         (setq erc-autojoin-channels-alist
-               (cons (list server chnl)
-                     erc-autojoin-channels-alist))))))
+  (when-let* ((nick (car (erc-parse-user (erc-response.sender parsed))))
+              ((erc-current-nick-p nick))
+              (chnl (erc-response.contents parsed))
+              (elem (or (and (erc-valid-local-channel-p chnl)
+                             (regexp-quote erc-server-announced-name))
+                        (erc-networks--id-symbol erc-networks--id)
+                        (with-current-buffer (process-buffer proc)
+                          (erc-autojoin-current-server)))))
+    (cl-pushnew chnl (alist-get elem erc-autojoin-channels-alist
+                                nil nil (if (symbolp elem) #'eq #'equal))
+                :test #'equal))
   ;; We must return nil to tell ERC to continue running the other
   ;; functions.
   nil)
@@ -216,18 +192,19 @@ Respects `erc-autojoin-domain-only'."
 
 (defun erc-autojoin-remove (proc parsed)
   "Remove the channel being left from `erc-autojoin-channels-alist'."
-  (let* ((chnl (car (erc-response.command-args parsed)))
-        (nick (car (erc-parse-user (erc-response.sender parsed))))
-        (server (with-current-buffer (process-buffer proc)
-                  (erc-autojoin-current-server))))
-    (when (erc-current-nick-p nick)
-      (let ((elem (or (assoc (erc-network) erc-autojoin-channels-alist)
-                     (assoc server erc-autojoin-channels-alist))))
-       (when elem
-         (setcdr elem (delete chnl (cdr elem)))
-         (unless (cdr elem)
-           (setq erc-autojoin-channels-alist
-                 (delete elem erc-autojoin-channels-alist)))))))
+  (when-let* ((nick (car (erc-parse-user (erc-response.sender parsed))))
+              ((erc-current-nick-p nick))
+              (chnl (car (erc-response.command-args parsed)))
+              (elem (or (and (erc-valid-local-channel-p chnl)
+                             (regexp-quote erc-server-announced-name))
+                        (erc-networks--id-symbol erc-networks--id)
+                        (with-current-buffer (process-buffer proc)
+                          (erc-autojoin-current-server))))
+              (test (if (symbolp elem) #'eq #'equal)))
+    (let ((chans (delete chnl (assoc-default elem erc-autojoin-channels-alist
+                                             test))))
+      (setf (alist-get elem erc-autojoin-channels-alist nil (null chans) test)
+            chans)))
   ;; We must return nil to tell ERC to continue running the other
   ;; functions.
   nil)
diff --git a/test/lisp/erc/erc-join-tests.el b/test/lisp/erc/erc-join-tests.el
new file mode 100644
index 0000000000..e9c432b4a2
--- /dev/null
+++ b/test/lisp/erc/erc-join-tests.el
@@ -0,0 +1,347 @@
+;;; erc-join-tests.el --- Tests for erc-join.  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020-2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published
+;; by the Free Software Foundation, either version 3 of the License,
+;; or (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert-x)
+(require 'erc-join)
+(require 'erc-networks)
+
+(ert-deftest erc-autojoin-channels--connect ()
+  (should (eq erc-autojoin-timing 'connect))
+  (should (= erc-autojoin-delay 30))
+  (should-not erc--autojoin-timer)
+
+  (let (calls
+        common
+        erc-kill-server-hook)
+
+    (cl-letf (((symbol-function 'erc-server-send)
+               (lambda (line) (push line calls))))
+
+      (setq common
+            (lambda ()
+              (ert-with-test-buffer (:name "foonet")
+                (erc-mode)
+                (setq erc-server-process
+                      (start-process "true" (current-buffer) "true")
+                      erc-network 'FooNet
+                      erc-session-server "irc.gnu.chat"
+                      erc-server-current-nick "tester"
+                      erc-networks--id (erc-networks--id-create nil)
+                      erc-server-announced-name "foo.gnu.chat")
+                (set-process-query-on-exit-flag erc-server-process nil)
+                (erc-autojoin-channels erc-server-announced-name
+                                       "tester")
+                (should-not erc--autojoin-timer))))
+
+      (ert-info ("Join immediately on connect; server")
+        (let ((erc-autojoin-channels-alist '(("\\.gnu\\.chat\\'" "#chan"))))
+          (funcall common))
+        (should (equal (pop calls) "JOIN #chan")))
+
+      (ert-info ("Join immediately on connect; network")
+        (let ((erc-autojoin-channels-alist '((FooNet "#chan"))))
+          (funcall common))
+        (should (equal (pop calls) "JOIN #chan")))
+
+      (ert-info ("Do nothing; server")
+        (let ((erc-autojoin-channels-alist '(("bar\\.gnu\\.chat" "#chan"))))
+          (funcall common))
+        (should-not calls))
+
+      (ert-info ("Do nothing; network")
+        (let ((erc-autojoin-channels-alist '((BarNet "#chan"))))
+          (funcall common))
+        (should-not calls)))))
+
+(ert-deftest erc-autojoin-channels--delay ()
+  (should (eq erc-autojoin-timing 'connect))
+  (should (= erc-autojoin-delay 30))
+  (should-not erc--autojoin-timer)
+
+  (let (calls
+        common
+        erc-kill-server-hook
+        (erc-autojoin-timing 'ident)
+        (erc-autojoin-delay 0.05))
+
+    (cl-letf (((symbol-function 'erc-server-send)
+               (lambda (line) (push line calls)))
+              ((symbol-function 'erc-autojoin-after-ident)
+               (lambda (&rest _r) (error "I ran but shouldn't have"))))
+
+      (setq common
+            (lambda ()
+              (ert-with-test-buffer (:name "foonet")
+                (erc-mode)
+                (setq erc-server-process
+                      (start-process "true" (current-buffer) "true")
+                      erc-network 'FooNet
+                      erc-session-server "irc.gnu.chat"
+                      erc-server-current-nick "tester"
+                      erc-networks--id (erc-networks--id-create nil)
+                      erc-server-announced-name "foo.gnu.chat")
+                (set-process-query-on-exit-flag erc-server-process nil)
+                (should-not erc--autojoin-timer)
+                (erc-autojoin-channels erc-server-announced-name "tester")
+                (should erc--autojoin-timer)
+                (should-not calls)
+                (sleep-for 0.1))))
+
+      (ert-info ("Deferred on connect; server")
+        (let ((erc-autojoin-channels-alist '(("\\.gnu\\.chat\\'" "#chan"))))
+          (funcall common))
+        (should (equal (pop calls) "JOIN #chan")))
+
+      (ert-info ("Deferred on connect; network")
+        (let ((erc-autojoin-channels-alist '((FooNet "#chan"))))
+          (funcall common))
+        (should (equal (pop calls) "JOIN #chan")))
+
+      (ert-info ("Do nothing; server")
+        (let ((erc-autojoin-channels-alist '(("bar\\.gnu\\.chat" "#chan"))))
+          (funcall common))
+        (should-not calls)))))
+
+(ert-deftest erc-autojoin-channels--ident ()
+  (should (eq erc-autojoin-timing 'connect))
+  (should (= erc-autojoin-delay 30))
+  (should-not erc--autojoin-timer)
+
+  (let (calls
+        common
+        erc-kill-server-hook
+        (erc-autojoin-timing 'ident))
+
+    (cl-letf (((symbol-function 'erc-server-send)
+               (lambda (line) (push line calls))))
+
+      (setq common
+            (lambda ()
+              (ert-with-test-buffer (:name "foonet")
+                (erc-mode)
+                (setq erc-server-process
+                      (start-process "true" (current-buffer) "true")
+                      erc-network 'FooNet
+                      erc-server-current-nick "tester"
+                      erc-networks--id (erc-networks--id-create nil)
+                      erc-server-announced-name "foo.gnu.chat")
+                (set-process-query-on-exit-flag erc-server-process nil)
+                (erc-autojoin-after-ident 'FooNet "tester")
+                (should-not erc--autojoin-timer))))
+
+      (ert-info ("Join on NickServ hook; server")
+        (let ((erc-autojoin-channels-alist '(("\\.gnu\\.chat\\'" "#chan"))))
+          (funcall common))
+        (should (equal (pop calls) "JOIN #chan")))
+
+      (ert-info ("Join on NickServ hook; network")
+        (let ((erc-autojoin-channels-alist '((FooNet "#chan"))))
+          (funcall common))
+        (should (equal (pop calls) "JOIN #chan"))))))
+
+(defun erc-join-tests--autojoin-add--common (setup)
+  (let (calls
+        erc-autojoin-channels-alist)
+
+    (cl-letf (((symbol-function 'erc-handle-parsed-server-response)
+               (lambda (_p m) (push m calls))))
+
+      (ert-with-test-buffer (:name "foonet")
+        (erc-mode)
+        (setq erc-server-process
+              (start-process "true" (current-buffer) "true")
+              erc-server-current-nick "tester"
+              erc--isupport-params (make-hash-table)
+              erc-server-announced-name "foo.gnu.chat")
+        (puthash 'CHANTYPES '("&#") erc--isupport-params)
+        (funcall setup)
+        (set-process-query-on-exit-flag erc-server-process nil)
+        (should-not calls)
+
+        (ert-info ("Add #chan")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u JOIN #chan")
+          (should calls)
+          (erc-autojoin-add erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist '((FooNet "#chan")))))
+
+        (ert-info ("More recently joined chans are prepended")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u JOIN #spam")
+          (should calls)
+          (erc-autojoin-add erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '((FooNet "#spam" "#chan")))))
+
+        (ert-info ("Duplicates skipped")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u JOIN #chan")
+          (should calls)
+          (erc-autojoin-add erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '((FooNet "#spam" "#chan")))))
+
+        (ert-info ("Server used for local channel")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u JOIN &local")
+          (should calls)
+          (erc-autojoin-add erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '(("foo\\.gnu\\.chat" "&local")
+                           (FooNet "#spam" "#chan")))))))))
+
+(ert-deftest erc-autojoin-add--network ()
+  (erc-join-tests--autojoin-add--common
+   (lambda () (setq erc-network 'FooNet
+                    erc-networks--id (erc-networks--id-create nil)))))
+
+(ert-deftest erc-autojoin-add--network-id ()
+  (erc-join-tests--autojoin-add--common
+   (lambda () (setq erc-network 'invalid
+                    erc-networks--id (erc-networks--id-create 'FooNet)))))
+
+(ert-deftest erc-autojoin-add--server ()
+  (let (calls
+        erc-autojoin-channels-alist)
+
+    (cl-letf (((symbol-function 'erc-handle-parsed-server-response)
+               (lambda (_p m) (push m calls))))
+
+      (ert-info ("Network unavailable, announced name used")
+        (setq erc-autojoin-channels-alist nil)
+        (ert-with-test-buffer (:name "foonet")
+          (erc-mode)
+          (setq erc-server-process
+                (start-process "true" (current-buffer) "true")
+                erc-server-current-nick "tester"
+                erc-server-announced-name "foo.gnu.chat"
+                erc-networks--id (make-erc-networks--id)) ; assume too early
+          (set-process-query-on-exit-flag erc-server-process nil)
+          (should-not calls)
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~u@q6ddatxcq6txy.irc JOIN #chan")
+          (should calls)
+          (erc-autojoin-add erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '(("gnu.chat" "#chan")))))))))
+
+(defun erc-join-tests--autojoin-remove--common (setup)
+  (let (calls
+        erc-autojoin-channels-alist)
+
+    (cl-letf (((symbol-function 'erc-handle-parsed-server-response)
+               (lambda (_p m) (push m calls))))
+
+      (setq erc-autojoin-channels-alist ; mutated, so can't quote whole thing
+            (list '(FooNet "#spam" "##chan")
+                  '(BarNet "#bar" "##bar")
+                  '("foo\\.gnu\\.chat" "&local")))
+
+      (ert-with-test-buffer (:name "foonet")
+        (erc-mode)
+        (setq erc-server-process
+              (start-process "true" (current-buffer) "true")
+              erc-server-current-nick "tester"
+              erc--isupport-params (make-hash-table)
+              erc-server-announced-name "foo.gnu.chat")
+        (puthash 'CHANTYPES '("&#") erc--isupport-params)
+        (funcall setup)
+        (set-process-query-on-exit-flag erc-server-process nil)
+        (should-not calls)
+
+        (ert-info ("Remove #chan")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u PART ##chan")
+          (should calls)
+          (erc-autojoin-remove erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '((FooNet "#spam")
+                           (BarNet "#bar" "##bar")
+                           ("foo\\.gnu\\.chat" "&local")))))
+
+        (ert-info ("Wrong network, nothing done")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u PART #bar")
+          (should calls)
+          (erc-autojoin-remove erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '((FooNet "#spam")
+                           (BarNet "#bar" "##bar")
+                           ("foo\\.gnu\\.chat" "&local")))))
+
+        (ert-info ("Local channel keyed by server found")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u PART &local")
+          (should calls)
+          (erc-autojoin-remove erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '((FooNet "#spam") (BarNet "#bar" "##bar")))))))))
+
+(ert-deftest erc-autojoin-remove--network ()
+  (erc-join-tests--autojoin-remove--common
+   (lambda () (setq erc-network 'FooNet
+                    erc-networks--id (erc-networks--id-create nil)))))
+
+(ert-deftest erc-autojoin-remove--network-id ()
+  (erc-join-tests--autojoin-remove--common
+   (lambda () (setq erc-network 'fake-a-roo
+                    erc-networks--id (erc-networks--id-create 'FooNet)))))
+
+(ert-deftest erc-autojoin-remove--server ()
+  (let (calls
+        erc-autojoin-channels-alist)
+
+    (cl-letf (((symbol-function 'erc-handle-parsed-server-response)
+               (lambda (_p m) (push m calls))))
+
+      (setq erc-autojoin-channels-alist (list '("gnu.chat" "#spam" "##chan")
+                                              '("fsf.chat" "#bar" "##bar")))
+
+      (ert-with-test-buffer (:name "foonet")
+        (erc-mode)
+        (setq erc-server-process
+              (start-process "true" (current-buffer) "true")
+              erc-server-current-nick "tester"
+              erc-server-announced-name "foo.gnu.chat"
+              ;; Assume special case w/o known network
+              erc-networks--id (make-erc-networks--id))
+        (set-process-query-on-exit-flag erc-server-process nil)
+        (should-not calls)
+
+        (ert-info ("Announced name matched, #chan removed")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u PART ##chan")
+          (should calls)
+          (erc-autojoin-remove erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '(("gnu.chat" "#spam")
+                           ("fsf.chat" "#bar" "##bar")))))
+
+        (ert-info ("Wrong announced name, nothing done")
+          (erc-parse-server-response erc-server-process
+                                     ":tester!~i@c.u PART #bar")
+          (should calls)
+          (erc-autojoin-remove erc-server-process (pop calls))
+          (should (equal erc-autojoin-channels-alist
+                         '(("gnu.chat" "#spam")
+                           ("fsf.chat" "#bar" "##bar")))))))))
+
+;;; erc-join-tests.el ends here