* test/lisp/erc/resources/erc-d/erc-d.el: New file.
* test/lisp/erc/resources/erc-d/erc-d-u.el: New file.
* test/lisp/erc/resources/erc-d/erc-d-i.el: New file.
* test/lisp/erc/resources/erc-d/erc-d-t.el: New file.
* test/lisp/erc/resources/erc-d/erc-d-tests.el: New file.
* test/lisp/erc/erc-scenarios-internal.el: New file to serve as
discoverable proxy for erc-d-tests.
--- /dev/null
+;;; erc-scenarios-internal.el --- Proxy file for erc-d tests -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program 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.
+;;
+;; This program 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 this program. If not, see
+;; <https://www.gnu.org/licenses/>.
+
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (expand-file-name "erc-d" (ert-resource-directory))
+ load-path)))
+ (load "erc-d-tests" nil 'silent)))
+
+;;; erc-scenarios-internal.el ends here
--- /dev/null
+;;; erc-d-i.el --- IRC helpers for ERC test server -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program 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.
+;;
+;; This program 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 this program. If not, see
+;; <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+
+(cl-defstruct (erc-d-i-message (:conc-name erc-d-i-message.))
+ "Identical to `erc-response'.
+When member `compat' is nil, it means the raw message was decoded as
+UTF-8 text before parsing, which is nonstandard."
+ (unparsed "" :type string)
+ (sender "" :type string)
+ (command "" :type string)
+ (command-args nil :type (list-of string))
+ (contents "" :type string)
+ (tags nil :type (list-of (cons symbol string)))
+ (compat t :type boolean))
+
+(defconst erc-d-i--tag-escapes
+ '((";" . "\\:") (" " . "\\s") ("\\" . "\\\\") ("\r" . "\\r") ("\n" . "\\n")))
+
+;; XXX these are not mirror inverses; unescaping may degenerate
+;; original by dropping stranded/misplaced backslashes.
+
+(defconst erc-d-i--tag-escaped-regexp (rx (or ?\; ?\ ?\\ ?\r ?\n)))
+
+(defconst erc-d-i--tag-unescaped-regexp
+ (rx (or "\\:" "\\s" "\\\\" "\\r" "\\n"
+ (seq "\\" (or string-end (not (or ":" "n" "r" "\\")))))))
+
+(defun erc-d-i--unescape-tag-value (str)
+ "Undo substitution of char placeholders in raw tag value STR."
+ (replace-regexp-in-string erc-d-i--tag-unescaped-regexp
+ (lambda (s)
+ (or (car (rassoc s erc-d-i--tag-escapes))
+ (substring s 1)))
+ str t t))
+
+(defun erc-d-i--escape-tag-value (str)
+ "Swap out banned chars in tag value STR with message representation."
+ (replace-regexp-in-string erc-d-i--tag-escaped-regexp
+ (lambda (s)
+ (cdr (assoc s erc-d-i--tag-escapes)))
+ str t t))
+
+(defconst erc-d-i--invalid-tag-regexp (rx (any "\0\7\r\n; ")))
+
+;; This is `erc-v3-message-tags' with fatal errors.
+
+(defun erc-d-i--validate-tags (raw)
+ "Validate tags portion of some RAW incoming message.
+RAW must not have a leading \"@\" or a trailing space. The spec says
+validation shouldn't be performed on keys and that undecodeable values
+or ones with illegal (unescaped) chars may be dropped. This does not
+respect any of that. Its purpose is to catch bad input created by us."
+ (unless (> 4094 (string-bytes raw))
+ ;; 417 ERR_INPUTTOOLONG Input line was too long
+ (error "Message tags exceed 4094 bytes: %S" raw))
+ (let (tags
+ (tag-strings (split-string raw ";")))
+ (dolist (s tag-strings (nreverse tags))
+ (let* ((m (if (>= emacs-major-version 28)
+ (string-search "=" s)
+ (string-match-p "=" s)))
+ (key (if m (substring s 0 m) s))
+ (val (when-let* (m ; check first, like (m), but shadow
+ (v (substring s (1+ m)))
+ ((not (string-equal v ""))))
+ (when (string-match-p erc-d-i--invalid-tag-regexp v)
+ (error "Bad tag: %s" s))
+ (thread-first v
+ (decode-coding-string 'utf-8 t)
+ (erc-d-i--unescape-tag-value)))))
+ (when (string-empty-p key)
+ (error "Tag missing key: %S" s))
+ (setf (alist-get (intern key) tags) val)))))
+
+(defun erc-d-i--parse-message (s &optional decode)
+ "Parse string S into `erc-d-i-message' object.
+With DECODE, decode as UTF-8 text."
+ (when (string-suffix-p "\r\n" s)
+ (error "Unstripped message encountered"))
+ (when decode
+ (setq s (decode-coding-string s 'utf-8 t)))
+ (let ((mes (make-erc-d-i-message :unparsed s :compat (not decode)))
+ tokens)
+ (when-let* (((not (string-empty-p s)))
+ ((eq ?@ (aref s 0)))
+ (m (string-match " " s))
+ (u (substring s 1 m)))
+ (setf (erc-d-i-message.tags mes) (erc-d-i--validate-tags u)
+ s (substring s (1+ m))))
+ (if-let* ((m (string-match " :" s))
+ (other-toks (split-string (substring s 0 m) " " t))
+ (rest (substring s (+ 2 m))))
+ (setf (erc-d-i-message.contents mes) rest
+ tokens (nconc other-toks (list rest)))
+ (setq tokens (split-string s " " t " ")))
+ (when (and tokens (eq ?: (aref (car tokens) 0)))
+ (setf (erc-d-i-message.sender mes) (substring (pop tokens) 1)))
+ (setf (erc-d-i-message.command mes) (or (pop tokens) "")
+ (erc-d-i-message.command-args mes) tokens)
+ mes))
+
+(provide 'erc-d-i)
+;;; erc-d-i.el ends here
--- /dev/null
+;;; erc-d-t.el --- ERT helpers for ERC test server -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program 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.
+;;
+;; This program 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 this program. If not, see
+;; <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(eval-and-compile
+ (let* ((d (file-name-directory (or (macroexp-file-name) buffer-file-name)))
+ (load-path (cons (directory-file-name d) load-path)))
+ (require 'erc-d-u)))
+
+(require 'ert)
+
+(defun erc-d-t-kill-related-buffers ()
+ "Kill all erc- or erc-d- related buffers."
+ (let (buflist)
+ (dolist (buf (buffer-list))
+ (with-current-buffer buf
+ (when (or erc-d-u--process-buffer
+ (derived-mode-p 'erc-mode))
+ (push buf buflist))))
+ (dolist (buf buflist)
+ (when (and (boundp 'erc-server-flood-timer)
+ (timerp erc-server-flood-timer))
+ (cancel-timer erc-server-flood-timer))
+ (when-let ((proc (get-buffer-process buf)))
+ (delete-process proc))
+ (when (buffer-live-p buf)
+ (kill-buffer buf))))
+ (while (when-let ((buf (pop erc-d-u--canned-buffers)))
+ (kill-buffer buf))))
+
+(defun erc-d-t-silence-around (orig &rest args)
+ "Run ORIG function with ARGS silently.
+Use this on `erc-handle-login' and `erc-server-connect'."
+ (let ((inhibit-message t))
+ (apply orig args)))
+
+(defvar erc-d-t-cleanup-sleep-secs 0.1)
+
+(defmacro erc-d-t-with-cleanup (bindings cleanup &rest body)
+ "Execute BODY and run CLEANUP form regardless of outcome.
+`let*'-bind BINDINGS and make them available in BODY and CLEANUP.
+After CLEANUP, destroy any values in BINDINGS that remain bound to
+buffers or processes. Sleep `erc-d-t-cleanup-sleep-secs' before
+returning."
+ (declare (indent 2))
+ `(let* ,bindings
+ (unwind-protect
+ (progn ,@body)
+ ,cleanup
+ (when noninteractive
+ (let (bufs procs)
+ (dolist (o (list ,@(mapcar (lambda (b) (or (car-safe b) b))
+ bindings)))
+ (when (bufferp o)
+ (push o bufs))
+ (when (processp o)
+ (push o procs)))
+ (dolist (proc procs)
+ (delete-process proc)
+ (when-let ((buf (process-buffer proc)))
+ (push buf bufs)))
+ (dolist (buf bufs)
+ (when-let ((proc (get-buffer-process buf)))
+ (delete-process proc))
+ (when (bufferp buf)
+ (ignore-errors (kill-buffer buf)))))
+ (sleep-for erc-d-t-cleanup-sleep-secs)))))
+
+(defmacro erc-d-t-wait-for (max-secs msg &rest body)
+ "Wait for BODY to become non-nil.
+Or signal error with MSG after MAX-SECS. When MAX-SECS is negative,
+signal if BODY is ever non-nil before MAX-SECS elapses. On success,
+return BODY's value.
+
+Note: this assumes BODY is waiting on a peer's output. It tends to
+artificially accelerate consumption of all process output, which may not
+be desirable."
+ (declare (indent 2))
+ (unless (or (stringp msg) (memq (car-safe msg) '(format concat)))
+ (push msg body)
+ (setq msg (prin1-to-string body)))
+ (let ((inverted (make-symbol "inverted"))
+ (time-out (make-symbol "time-out"))
+ (result (make-symbol "result")))
+ `(ert-info ((concat "Awaiting: " ,msg))
+ (let ((,time-out (abs ,max-secs))
+ (,inverted (< ,max-secs 0))
+ (,result ',result))
+ (with-timeout (,time-out (if ,inverted
+ (setq ,inverted nil)
+ (error "Failed awaiting: %s" ,msg)))
+ (while (not (setq ,result (progn ,@body)))
+ (when (and (accept-process-output nil 0.1) (not noninteractive))
+ (redisplay))))
+ (when ,inverted
+ (error "Failed awaiting: %s" ,msg))
+ ,result))))
+
+(defmacro erc-d-t-ensure-for (max-secs msg &rest body)
+ "Ensure BODY remains non-nil for MAX-SECS.
+On failure, emit MSG."
+ (declare (indent 2))
+ (unless (or (stringp msg) (memq (car-safe msg) '(format concat)))
+ (push msg body)
+ (setq msg (prin1-to-string body)))
+ `(erc-d-t-wait-for (- (abs ,max-secs)) ,msg (not (progn ,@body))))
+
+(defun erc-d-t-search-for (timeout text &optional from on-success)
+ "Wait for TEXT to appear in current buffer before TIMEOUT secs.
+With marker or number FROM, only consider the portion of the buffer from
+that point forward. If TEXT is a cons, interpret it as an RX regular
+expression. If ON-SUCCESS is a function, call it when TEXT is found."
+ (save-restriction
+ (widen)
+ (let* ((rxp (consp text))
+ (fun (if rxp #'search-forward-regexp #'search-forward))
+ (pat (if rxp (rx-to-string text) text))
+ res)
+ (erc-d-t-wait-for timeout (format "string: %s" text)
+ (goto-char (or from (point-min)))
+ (setq res (funcall fun pat nil t))
+ (if (and on-success res)
+ (funcall on-success)
+ res)))))
+
+(defun erc-d-t-absent-for (timeout text &optional from on-success)
+ "Assert TEXT doesn't appear in current buffer for TIMEOUT secs."
+ (erc-d-t-search-for (- (abs timeout)) text from on-success))
+
+(defun erc-d-t-make-expecter ()
+ "Return function to search for new output in buffer.
+Assume new text is only inserted at or after `erc-insert-marker'.
+
+The returned function works like `erc-d-t-search-for', but it never
+revisits previously covered territory, and the optional fourth argument,
+ON-SUCCESS, is nonexistent. To reset, specify a FROM argument."
+ (let (positions)
+ (lambda (timeout text &optional reset-from)
+ (let* ((pos (cdr (assq (current-buffer) positions)))
+ (cb (lambda ()
+ (unless pos
+ (push (cons (current-buffer) (setq pos (make-marker)))
+ positions))
+ (marker-position
+ (set-marker pos (min (point) (1- (point-max))))))))
+ (when reset-from
+ (set-marker pos reset-from))
+ (erc-d-t-search-for timeout text pos cb)))))
+
+(provide 'erc-d-t)
+;;; erc-d-t.el ends here
--- /dev/null
+;;; erc-d-tests.el --- tests for erc-d -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program 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.
+;;
+;; This program 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 this program. If not, see
+;; <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+(require 'ert-x)
+(eval-and-compile
+ (let ((load-path (cons (expand-file-name ".." (ert-resource-directory))
+ load-path)))
+ (require 'erc-d)
+ (require 'erc-d-t)))
+
+(require 'erc)
+
+;; Temporary kludge to silence warning
+(put 'erc-parse-tags 'erc-v3-warned-p t)
+
+(ert-deftest erc-d-u--canned-load-dialog--basic ()
+ (should-not (get-buffer "basic.eld"))
+ (should-not erc-d-u--canned-buffers)
+ (let* ((exes (erc-d-u--canned-load-dialog 'basic))
+ (reap (lambda ()
+ (cl-loop with e = (erc-d-u--read-dialog exes)
+ for s = (erc-d-u--read-exchange e)
+ while s collect s))))
+ (should (get-buffer "basic.eld"))
+ (should (memq (get-buffer "basic.eld") erc-d-u--canned-buffers))
+ (should (equal (funcall reap) '((pass 10.0 "PASS " (? ?:) "changeme"))))
+ (should (equal (funcall reap) '((nick 0.2 "NICK tester"))))
+ (let ((r (funcall reap)))
+ (should (equal (car r) '(user 0.2 "USER user 0 * :tester")))
+ (should (equal
+ (car (last r))
+ '(0 ":irc.example.org 422 tester :MOTD File is missing"))))
+ (should (equal (car (funcall reap)) '(mode-user 5 "MODE tester +i")))
+ (should (equal (funcall reap)
+ '((mode-chan 1.2 "MODE #chan")
+ (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))))
+ ;; See `define-error' site for `iter-end-of-sequence'
+ (ert-info ("EOB detected") (should-not (erc-d-u--read-dialog exes))))
+ (should-not (get-buffer "basic.eld"))
+ (should-not erc-d-u--canned-buffers))
+
+(defun erc-d-tests--make-hunk-reader (hunks)
+ (let ((p (erc-d-u--read-dialog hunks)))
+ (lambda () (erc-d-u--read-exchange p))))
+
+;; Fuzzies need to be able to access any non-exhausted genny.
+(ert-deftest erc-d-u--canned-load-dialog--intermingled ()
+ (should-not (get-buffer "basic.eld"))
+ (should-not erc-d-u--canned-buffers)
+ (let* ((exes (erc-d-u--canned-load-dialog 'basic))
+ (pass (erc-d-tests--make-hunk-reader exes))
+ (nick (erc-d-tests--make-hunk-reader exes))
+ (user (erc-d-tests--make-hunk-reader exes))
+ (modu (erc-d-tests--make-hunk-reader exes))
+ (modc (erc-d-tests--make-hunk-reader exes)))
+
+ (should (equal (funcall user) '(user 0.2 "USER user 0 * :tester")))
+ (should (equal (funcall modu) '(mode-user 5 "MODE tester +i")))
+ (should (equal (funcall modc) '(mode-chan 1.2 "MODE #chan")))
+
+ (cl-loop repeat 8 do (funcall user)) ; skip a few
+ (should (equal (funcall user)
+ '(0 ":irc.example.org 254 tester 1 :channels formed")))
+ (should (equal (funcall modu)
+ '(0 ":irc.example.org 221 tester +Zi")))
+ (should (equal (cl-loop for s = (funcall modc) while s collect s) ; done
+ '((0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))))
+
+ (cl-loop repeat 3 do (funcall user))
+ (cl-loop repeat 3 do (funcall modu))
+
+ (ert-info ("Change up the order")
+ (should
+ (equal (funcall modu)
+ '(0 ":irc.example.org 366 alice #chan :End of NAMES list")))
+ (should
+ (equal (funcall user)
+ '(0 ":irc.example.org 422 tester :MOTD File is missing"))))
+
+ ;; Exhaust these
+ (should (equal (cl-loop for s = (funcall pass) while s collect s) ; done
+ '((pass 10.0 "PASS " (? ?:) "changeme"))))
+ (should (equal (cl-loop for s = (funcall nick) while s collect s) ; done
+ '((nick 0.2 "NICK tester"))))
+
+ (ert-info ("End of file but no teardown because hunks outstanding")
+ (should-not (erc-d-u--read-dialog exes))
+ (should (get-buffer "basic.eld")))
+
+ ;; Finish
+ (should-not (funcall user))
+ (should-not (funcall modu)))
+
+ (should-not (get-buffer "basic.eld"))
+ (should-not erc-d-u--canned-buffers))
+
+;; This indirectly tests `erc-d-u--canned-read' cleanup/teardown
+
+(ert-deftest erc-d-u--rewrite-for-slow-mo ()
+ (should-not (get-buffer "basic.eld"))
+ (should-not (get-buffer "basic.eld<2>"))
+ (should-not (get-buffer "basic.eld<3>"))
+ (should-not erc-d-u--canned-buffers)
+ (let ((exes (erc-d-u--canned-load-dialog 'basic))
+ (exes-lower (erc-d-u--canned-load-dialog 'basic))
+ (exes-custom (erc-d-u--canned-load-dialog 'basic))
+ (reap (lambda (e) (cl-loop with p = (erc-d-u--read-dialog e)
+ for s = (erc-d-u--read-exchange p)
+ while s collect s))))
+ (should (get-buffer "basic.eld"))
+ (should (get-buffer "basic.eld<2>"))
+ (should (get-buffer "basic.eld<3>"))
+ (should (equal (list (get-buffer "basic.eld<3>")
+ (get-buffer "basic.eld<2>")
+ (get-buffer "basic.eld"))
+ erc-d-u--canned-buffers))
+
+ (ert-info ("Rewrite for slowmo basic")
+ (setq exes (erc-d-u--rewrite-for-slow-mo 10 exes))
+ (should (equal (funcall reap exes)
+ '((pass 20.0 "PASS " (? ?:) "changeme"))))
+ (should (equal (funcall reap exes)
+ '((nick 10.2 "NICK tester"))))
+ (let ((r (funcall reap exes)))
+ (should (equal (car r) '(user 10.2 "USER user 0 * :tester")))
+ (should (equal
+ (car (last r))
+ '(0 ":irc.example.org 422 tester :MOTD File is missing"))))
+ (should (equal (car (funcall reap exes))
+ '(mode-user 15 "MODE tester +i")))
+ (should (equal (car (funcall reap exes))
+ '(mode-chan 11.2 "MODE #chan")))
+ (should-not (erc-d-u--read-dialog exes)))
+
+ (ert-info ("Rewrite for slowmo bounded")
+ (setq exes-lower (erc-d-u--rewrite-for-slow-mo -5 exes-lower))
+ (should (equal (funcall reap exes-lower)
+ '((pass 10.0 "PASS " (? ?:) "changeme"))))
+ (should (equal (funcall reap exes-lower)
+ '((nick 5 "NICK tester"))))
+ (should (equal (car (funcall reap exes-lower))
+ '(user 5 "USER user 0 * :tester")))
+ (should (equal (car (funcall reap exes-lower))
+ '(mode-user 5 "MODE tester +i")))
+ (should (equal (car (funcall reap exes-lower))
+ '(mode-chan 5 "MODE #chan")))
+ (should-not (erc-d-u--read-dialog exes-lower)))
+
+ (ert-info ("Rewrite for slowmo custom")
+ (setq exes-custom (erc-d-u--rewrite-for-slow-mo
+ (lambda (n) (* 2 n)) exes-custom))
+ (should (equal (funcall reap exes-custom)
+ '((pass 20.0 "PASS " (? ?:) "changeme"))))
+ (should (equal (funcall reap exes-custom)
+ '((nick 0.4 "NICK tester"))))
+ (should (equal (car (funcall reap exes-custom))
+ '(user 0.4 "USER user 0 * :tester")))
+ (should (equal (car (funcall reap exes-custom))
+ '(mode-user 10 "MODE tester +i")))
+ (should (equal (car (funcall reap exes-custom))
+ '(mode-chan 2.4 "MODE #chan")))
+ (should-not (erc-d-u--read-dialog exes-custom))))
+
+ (should-not (get-buffer "basic.eld"))
+ (should-not (get-buffer "basic.eld<2>"))
+ (should-not (get-buffer "basic.eld<3>"))
+ (should-not erc-d-u--canned-buffers))
+
+(ert-deftest erc-d--active-ex-p ()
+ (let ((ring (make-ring 5)))
+ (ert-info ("Empty ring returns nil for not active")
+ (should-not (erc-d--active-ex-p ring)))
+ (ert-info ("One fuzzy member returns nil for not active")
+ (ring-insert ring (make-erc-d-exchange :tag '~foo))
+ (should-not (erc-d--active-ex-p ring)))
+ (ert-info ("One active member returns t for active")
+ (ring-insert-at-beginning ring (make-erc-d-exchange :tag 'bar))
+ (should (erc-d--active-ex-p ring)))))
+
+(defun erc-d-tests--parse-message-upstream (raw)
+ "Hack shim for parsing RAW line recvd from peer."
+ (cl-letf (((symbol-function #'erc-handle-parsed-server-response)
+ (lambda (_ p) p)))
+ (let ((erc-active-buffer nil))
+ (erc-parse-server-response nil raw))))
+
+(ert-deftest erc-d-i--validate-tags ()
+ (should (erc-d-i--validate-tags
+ (concat "batch=4cc99692bf24a4bec4aa03da437364f5;"
+ "time=2021-01-04T00:32:13.839Z")))
+ (should (erc-d-i--validate-tags "+foo=bar;baz=spam"))
+ (should (erc-d-i--validate-tags "foo=\\:ok;baz=\\s"))
+ (should (erc-d-i--validate-tags "foo=\303\247edilla"))
+ (should (erc-d-i--validate-tags "foo=\\"))
+ (should (erc-d-i--validate-tags "foo=bar\\baz"))
+ (should-error (erc-d-i--validate-tags "foo=\\\\;baz=\\\r\\\n"))
+ (should-error (erc-d-i--validate-tags "foo=\n"))
+ (should-error (erc-d-i--validate-tags "foo=\0ok"))
+ (should-error (erc-d-i--validate-tags "foo=bar baz"))
+ (should-error (erc-d-i--validate-tags "foo=bar\r"))
+ (should-error (erc-d-i--validate-tags "foo=bar;")))
+
+(ert-deftest erc-d-i--parse-message ()
+ (let* ((raw (concat "@time=2020-11-23T09:10:33.088Z "
+ ":tilde.chat BATCH +1 chathistory :#meta"))
+ (upstream (erc-d-tests--parse-message-upstream raw))
+ (ours (erc-d-i--parse-message raw)))
+
+ (ert-info ("Baseline upstream")
+ (should (equal (erc-response.unparsed upstream) raw))
+ (should (equal (erc-response.sender upstream) "tilde.chat"))
+ (should (equal (erc-response.command upstream) "BATCH"))
+ (should (equal (erc-response.command-args upstream)
+ '("+1" "chathistory" "#meta")))
+ (should (equal (erc-response.contents upstream) "#meta")))
+
+ (ert-info ("Ours my not compare cl-equalp but is otherwise the same")
+ (should (equal (erc-d-i-message.unparsed ours) raw))
+ (should (equal (erc-d-i-message.sender ours) "tilde.chat"))
+ (should (equal (erc-d-i-message.command ours) "BATCH"))
+ (should (equal (erc-d-i-message.command-args ours)
+ '("+1" "chathistory" "#meta")))
+ (should (equal (erc-d-i-message.contents ours) "#meta"))
+ (should (equal (erc-d-i-message.tags ours)
+ '((time . "2020-11-23T09:10:33.088Z")))))
+
+ (ert-info ("No compat decodes the whole message as utf-8")
+ (setq ours (erc-d-i--parse-message
+ "@foo=\303\247edilla TAGMSG #ch\303\240n"
+ 'decode))
+ (should-not (erc-d-i-message.compat ours))
+ (should (equal (erc-d-i-message.command-args ours) '("#chà n")))
+ (should (equal (erc-d-i-message.contents ours) ""))
+ (should (equal (erc-d-i-message.tags ours) '((foo . "çedilla")))))))
+
+(ert-deftest erc-d-i--unescape-tag-value ()
+ (should (equal (erc-d-i--unescape-tag-value
+ "\\sabc\\sdef\\s\\sxyz\\s")
+ " abc def xyz "))
+ (should (equal (erc-d-i--unescape-tag-value
+ "\\\\abc\\\\def\\\\\\\\xyz\\\\")
+ "\\abc\\def\\\\xyz\\"))
+ (should (equal (erc-d-i--unescape-tag-value "a\\bc") "abc"))
+ (should (equal (erc-d-i--unescape-tag-value
+ "\\\\abc\\\\def\\\\\\\\xyz\\")
+ "\\abc\\def\\\\xyz"))
+ (should (equal (erc-d-i--unescape-tag-value "a\\:b\\r\\nc\\sd")
+ "a;b\r\nc d")))
+
+(ert-deftest erc-d-i--escape-tag-value ()
+ (should (equal (erc-d-i--escape-tag-value " abc def xyz ")
+ "\\sabc\\sdef\\s\\sxyz\\s"))
+ (should (equal (erc-d-i--escape-tag-value "\\abc\\def\\\\xyz\\")
+ "\\\\abc\\\\def\\\\\\\\xyz\\\\"))
+ (should (equal (erc-d-i--escape-tag-value "a;b\r\nc d")
+ "a\\:b\\r\\nc\\sd")))
+
+;; TODO add tests for msg-join, mask-match, userhost-split,
+;; validate-hostname
+
+(ert-deftest erc-d-i--parse-message--irc-parser-tests ()
+ (let* ((data (with-temp-buffer
+ (insert-file-contents
+ (expand-file-name "irc-parser-tests.eld"
+ (ert-resource-directory)))
+ (read (current-buffer))))
+ (tests (assoc-default 'tests (assoc-default 'msg-split data)))
+ input atoms m ours)
+ (dolist (test tests)
+ (setq input (assoc-default 'input test)
+ atoms (assoc-default 'atoms test)
+ m (erc-d-i--parse-message input))
+ (ert-info ("Parses tags correctly")
+ (setq ours (erc-d-i-message.tags m))
+ (if-let ((tags (assoc-default 'tags atoms)))
+ (pcase-dolist (`(,key . ,value) ours)
+ (should (string= (cdr (assq key tags)) (or value ""))))
+ (should-not ours)))
+ (ert-info ("Parses verbs correctly")
+ (setq ours (erc-d-i-message.command m))
+ (if-let ((verbs (assoc-default 'verb atoms)))
+ (should (string= (downcase verbs) (downcase ours)))
+ (should (string-empty-p ours))))
+ (ert-info ("Parses sources correctly")
+ (setq ours (erc-d-i-message.sender m))
+ (if-let ((source (assoc-default 'source atoms)))
+ (should (string= source ours))
+ (should (string-empty-p ours))))
+ (ert-info ("Parses params correctly")
+ (setq ours (erc-d-i-message.command-args m))
+ (if-let ((params (assoc-default 'params atoms)))
+ (should (equal ours params))
+ (should-not ours))))))
+
+(defun erc-d-tests--new-ex (existing raw-hunk)
+ (let* ((f (lambda (_) (pop raw-hunk)))
+ (sd (make-erc-d-u-scan-d :f f)))
+ (setf (erc-d-exchange-hunk existing) (make-erc-d-u-scan-e :sd sd)
+ (erc-d-exchange-spec existing) (make-erc-d-spec)))
+ (erc-d--iter existing))
+
+(ert-deftest erc-d--render-entries ()
+ (let* ((erc-nick "foo")
+ (dialog (make-erc-d-dialog :vars `((:a . 1)
+ (c . ((a b) (: a space b)))
+ (d . (c alpha digit))
+ (bee . 2)
+ (f . ,(lambda () "3"))
+ (i . erc-nick))))
+ (exchange (make-erc-d-exchange :dialog dialog))
+ (mex (apply-partially #'erc-d-tests--new-ex exchange))
+ it)
+
+ (erc-d-exchange-reload dialog exchange)
+
+ (ert-info ("Baseline Outgoing")
+ (setq it (funcall mex '((0 "abc"))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "abc")))
+
+ (ert-info ("Incoming are regexp escaped")
+ (setq it (funcall mex '((i 0.0 "fsf" ".org"))))
+ (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
+ (should (equal (funcall it) "\\`fsf\\.org")))
+
+ (ert-info ("Incoming can access vars via rx-let")
+ (setq it (funcall mex '((i 0.0 bee))))
+ (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
+ (should (equal (funcall it) "\\`\002")))
+
+ (ert-info ("Incoming rx-let params")
+ (setq it (funcall mex '((i 0.0 d))))
+ (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
+ (should (equal (funcall it) "\\`[[:alpha:]][[:space:]][[:digit:]]")))
+
+ (ert-info ("Incoming literal rx forms")
+ (setq it (funcall mex '((i 0.0 (= 3 alpha) ".org"))))
+ (should (equal (cons (funcall it) (funcall it)) '(i . 0.0)))
+ (should (equal (funcall it) "\\`[[:alpha:]]\\{3\\}\\.org")))
+
+ (ert-info ("Self-quoting disallowed")
+ (setq it (funcall mex '((0 :a "abc"))))
+ (should (equal (funcall it) 0))
+ (should-error (funcall it)))
+
+ (ert-info ("Global vars and short vars")
+ (setq it (funcall mex '((0 i f erc-nick))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "foo3foo")))
+
+ (ert-info ("Exits clean")
+ (when (listp (alist-get 'f (erc-d-dialog-vars dialog))) ; may be compiled
+ (should (eq 'closure (car (alist-get 'f (erc-d-dialog-vars dialog))))))
+ (should-not (funcall it))
+ (should (equal (erc-d-dialog-vars dialog)
+ `((:a . 1)
+ (c . ((a b) (: a space b)))
+ (d . (c alpha digit))
+ (bee . 2)
+ (f . ,(alist-get 'f (erc-d-dialog-vars dialog)))
+ (i . erc-nick)))))))
+
+(ert-deftest erc-d--render-entries--matches ()
+ (let* ((alist (list
+ (cons 'f (lambda (a) (funcall a :match 1)))
+ (cons 'g (lambda () (match-string 2 "foo bar baz")))
+ (cons 'h (lambda (a) (concat (funcall a :match 0)
+ (funcall a :request))))
+ (cons 'i (lambda (_ e) (erc-d-exchange-request e)))
+ (cons 'j (lambda ()
+ (set-match-data '(0 1))
+ (match-string 0 "j")))))
+ (dialog (make-erc-d-dialog :vars alist))
+ (exchange (make-erc-d-exchange :dialog dialog
+ :request "foo bar baz"
+ ;; 11 222
+ :match-data '(4 11 4 6 8 11)))
+ (mex (apply-partially #'erc-d-tests--new-ex exchange))
+ it)
+
+ (erc-d-exchange-reload dialog exchange)
+
+ (ert-info ("One arg, match")
+ (setq it (funcall mex '((0 f))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "ba")))
+
+ (ert-info ("No args")
+ (setq it (funcall mex '((0 g))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "baz")))
+
+ (ert-info ("Second arg is exchange object")
+ (setq it (funcall mex '((0 i))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "foo bar baz")))
+
+ (ert-info ("One arg, multiple calls")
+ (setq it (funcall mex '((0 h))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "bar bazfoo bar baz")))
+
+ (ert-info ("Match data restored")
+ (setq it (funcall mex '((0 j))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "j"))
+
+ (setq it (funcall mex '((0 g))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "baz")))
+
+ (ert-info ("Bad signature")
+ (let ((qlist (list 'f '(lambda (p q x) (ignore)))))
+ (setf (erc-d-dialog-vars dialog) qlist)
+ (should-error (erc-d-exchange-reload dialog exchange))))))
+
+(ert-deftest erc-d--render-entries--dynamic ()
+ (let* ((alist (list
+ (cons 'foo "foo")
+ (cons 'f (lambda (a) (funcall a :get-binding 'foo)))
+ (cons 'h (lambda (a) (upcase (funcall a :get-var 'foo))))
+ (cons 'g (lambda (a)
+ (funcall a :rebind 'g (funcall a :get-var 'f))
+ "bar"))
+ (cons 'j (lambda (a) (funcall a :set "123") "abc"))
+ (cons 'k (lambda () "abc"))))
+ (dialog (make-erc-d-dialog :vars alist))
+ (exchange (make-erc-d-exchange :dialog dialog))
+ (mex (apply-partially #'erc-d-tests--new-ex exchange))
+ it)
+
+ (erc-d-exchange-reload dialog exchange)
+
+ (ert-info ("Initial reference calls function")
+ (setq it (funcall mex '((0 j) (0 j))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "abc")))
+
+ (ert-info ("Subsequent reference expands to string")
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "123")))
+
+ (ert-info ("Outside manipulation: initial reference calls function")
+ (setq it (funcall mex '((0 k) (0 k))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "abc")))
+
+ (ert-info ("Outside manipulation: subsequent reference expands to string")
+ (erc-d-exchange-rebind dialog exchange 'k "123")
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "123")))
+
+ (ert-info ("Swap one function for another")
+ (setq it (funcall mex '((0 g) (0 g))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "bar"))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "foo")))
+
+ (ert-info ("Bindings accessible inside functions")
+ (setq it (funcall mex '((0 f h))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "fooFOO")))
+
+ (ert-info ("Rebuild alist by sending flag")
+ (setq it (funcall mex '((0 f) (1 f) (2 f) (i 3 f))))
+ (should (equal (funcall it) 0))
+ (should (equal (funcall it) "foo"))
+ (erc-d-exchange-rebind dialog exchange 'f "bar")
+ (should (equal (funcall it) 1))
+ (should (equal (funcall it) "bar"))
+ (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog))
+ (lambda nil "baz")))
+ (should (eq (funcall it) 2))
+ (should (equal (funcall it 'reload) "baz"))
+ (setq alist (setf (alist-get 'f (erc-d-dialog-vars dialog)) "spam"))
+ (should (eq (funcall it) 'i))
+ (should (eq (funcall it 'reload) 3))
+ (should (equal (funcall it) "\\`spam")))))
+
+(ert-deftest erc-d-t-with-cleanup ()
+ (should-not (get-buffer "*echo*"))
+ (should-not (get-buffer "*foo*"))
+ (should-not (get-buffer "*bar*"))
+ (should-not (get-buffer "*baz*"))
+ (erc-d-t-with-cleanup
+ ((echo (start-process "echo" (get-buffer-create "*echo*") "sleep" "1"))
+ (buffer-foo (get-buffer-create "*foo*"))
+ (buffer-bar (get-buffer-create "*bar*"))
+ (clean-up (list (intern (process-name echo)))) ; let*
+ buffer-baz)
+ (ert-info ("Clean Up")
+ (should (equal clean-up '(ran echo)))
+ (should (bufferp buffer-baz))
+ (should (bufferp buffer-foo))
+ (setq buffer-foo nil))
+ (setq buffer-baz (get-buffer-create "*baz*"))
+ (push 'ran clean-up))
+ (ert-info ("Buffers and procs destroyed")
+ (should-not (get-buffer "*echo*"))
+ (should-not (get-buffer "*bar*"))
+ (should-not (get-buffer "*baz*")))
+ (ert-info ("Buffer foo spared")
+ (should (get-buffer "*foo*"))
+ (kill-buffer "*foo*")))
+
+(ert-deftest erc-d-t-wait-for ()
+ :tags '(:unstable)
+ (let (v)
+ (run-at-time 0.2 nil (lambda () (setq v t)))
+ (should (erc-d-t-wait-for 0.4 "result becomes non-nil" v))
+ (should-error (erc-d-t-wait-for 0.4 "result stays nil" (not v)))
+ (setq v nil)
+ (should-not (erc-d-t-wait-for -0.4 "inverted stays nil" v))
+ (run-at-time 0.2 nil (lambda () (setq v t)))
+ (setq v nil)
+ (should-error (erc-d-t-wait-for -0.4 "inverted becomes non-nil" v))))
+
+(defvar erc-d-tests-with-server-password "changeme")
+
+;; Compromise between removing `autojoin' from `erc-modules' entirely
+;; and allowing side effects to meddle excessively
+(defvar erc-autojoin-channels-alist)
+
+;; This is only meant to be used by tests in this file.
+(cl-defmacro erc-d-tests-with-server ((dumb-server-var erc-server-buffer-var)
+ dialog &rest body)
+ "Create server for DIALOG and run BODY.
+DIALOG may also be a list of dialogs. ERC-SERVER-BUFFER-VAR and
+DUMB-SERVER-VAR are bound accordingly in BODY."
+ (declare (indent 2))
+ (when (eq '_ dumb-server-var)
+ (setq dumb-server-var (make-symbol "dumb-server-var")))
+ (when (eq '_ erc-server-buffer-var)
+ (setq erc-server-buffer-var (make-symbol "erc-server-buffer-var")))
+ (if (listp dialog)
+ (setq dialog (mapcar (lambda (f) (list 'quote f)) dialog))
+ (setq dialog `((quote ,dialog))))
+ `(let* (auth-source-do-cache
+ (,dumb-server-var (erc-d-run "localhost" t ,@dialog))
+ ,erc-server-buffer-var
+ ;;
+ (erc-server-flood-penalty 0.05)
+ erc-autojoin-channels-alist
+ erc-server-auto-reconnect)
+ (should-not erc-d--slow-mo)
+ (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
+ ;; Allow important messages through, even in -batch mode.
+ (advice-add #'erc-handle-login :around #'erc-d-t-silence-around)
+ (advice-add #'erc-server-connect :around #'erc-d-t-silence-around)
+ (unless (or noninteractive erc-debug-irc-protocol)
+ (erc-toggle-debug-irc-protocol))
+ (setq ,erc-server-buffer-var
+ (erc :server "localhost"
+ :password erc-d-tests-with-server-password
+ :port (process-contact ,dumb-server-var :service)
+ :nick "tester"
+ :full-name "tester"))
+ (unwind-protect
+ (progn
+ ,@body
+ (erc-d-t-wait-for 1 "dumb-server death"
+ (not (process-live-p ,dumb-server-var))))
+ (when (process-live-p erc-server-process)
+ (delete-process erc-server-process))
+ (advice-remove #'erc-handle-login #'erc-d-t-silence-around)
+ (advice-remove #'erc-server-connect #'erc-d-t-silence-around)
+ (when noninteractive
+ (kill-buffer ,erc-server-buffer-var)
+ (erc-d-t-kill-related-buffers)))))
+
+(defmacro erc-d-tests-with-failure-spy (found func-syms &rest body)
+ "Wrap functions with advice for inspecting errors caused by BODY.
+Do this for functions whose names appear in FUNC-SYMS. When running
+advice code, add errors to list FOUND. Note: the teardown finalizer is
+not added by default. Also, `erc-d-linger-secs' likely has to be
+nonzero for this to work."
+ (declare (indent 2))
+ ;; Catch errors thrown by timers that `should-error'ignores
+ `(progn
+ (let ((ad (lambda (f o &rest r)
+ (condition-case err
+ (apply o r)
+ (error (push err ,found)
+ (advice-remove f 'spy))))))
+ (dolist (sym ,func-syms)
+ (advice-add sym :around (apply-partially ad sym) '((name . spy)))))
+ (progn ,@body)
+ (dolist (sym ,func-syms)
+ (advice-remove sym 'spy))
+ (setq ,found (nreverse ,found))))
+
+(ert-deftest erc-d-run-nonstandard-messages ()
+ :tags '(:expensive-test)
+ (let* ((erc-d-linger-secs 0.2)
+ (dumb-server (erc-d-run "localhost" t 'nonstandard))
+ (dumb-server-buffer (get-buffer "*erc-d-server*"))
+ (expect (erc-d-t-make-expecter))
+ client)
+ (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
+ (setq client (open-network-stream "erc-d-client" nil
+ "localhost"
+ (process-contact dumb-server :service)
+ :coding 'binary))
+ (ert-info ("Server splits CRLF delimited lines")
+ (process-send-string client "ONE one\r\nTWO two\r\n")
+ (with-current-buffer dumb-server-buffer
+ (funcall expect 1 '(: "<- nonstandard:" (+ digit) " ONE one" eol))
+ (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ TWO two$"))))
+ (ert-info ("Server doesn't discard empty lines")
+ (process-send-string client "\r\n")
+ (with-current-buffer dumb-server-buffer
+ (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ $"))))
+ (ert-info ("Server preserves spaces")
+ (process-send-string client " \r\n")
+ (with-current-buffer dumb-server-buffer
+ (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ \\{2\\}$")))
+ (process-send-string client " \r\n")
+ (with-current-buffer dumb-server-buffer
+ (funcall expect 1 '(regex "<- nonstandard:[[:digit:]]+ \\{3\\}$"))))
+ (erc-d-t-wait-for 3 "dumb-server death"
+ (not (process-live-p dumb-server)))
+ (delete-process client)
+ (when noninteractive
+ (kill-buffer dumb-server-buffer))))
+
+(ert-deftest erc-d-run-basic ()
+ :tags '(:expensive-test)
+ (erc-d-tests-with-server (_ _) basic
+ (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
+ (erc-d-t-search-for 2 "hey"))
+ (when noninteractive
+ (kill-buffer "#chan"))))
+
+(ert-deftest erc-d-run-eof ()
+ :tags '(:expensive-test)
+ (skip-unless noninteractive)
+ (erc-d-tests-with-server (_ erc-s-buf) eof
+ (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
+ (erc-d-t-search-for 2 "hey"))
+ (with-current-buffer erc-s-buf
+ (process-send-eof erc-server-process))))
+
+(ert-deftest erc-d-run-eof-fail ()
+ :tags '(:expensive-test)
+ (let (errors)
+ (erc-d-tests-with-failure-spy errors '(erc-d--teardown)
+ (erc-d-tests-with-server (_ _) eof
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (erc-d-t-search-for 2 "hey"))
+ (erc-d-t-wait-for 10 errors)))
+ (should (string-match-p "Timed out awaiting request.*__EOF__"
+ (cadr (pop errors))))))
+
+(ert-deftest erc-d-run-linger ()
+ :tags '(:expensive-test)
+ (erc-d-tests-with-server (dumb-s _) linger
+ (with-current-buffer (erc-d-t-wait-for 6 (get-buffer "#chan"))
+ (erc-d-t-search-for 2 "hey"))
+ (with-current-buffer (process-buffer dumb-s)
+ (erc-d-t-search-for 2 "Lingering for 1.00 seconds"))
+ (with-current-buffer (process-buffer dumb-s)
+ (erc-d-t-search-for 3 "Lingered for 1.00 seconds"))))
+
+(ert-deftest erc-d-run-linger-fail ()
+ :tags '(:expensive-test)
+ (let ((erc-server-flood-penalty 0.1)
+ errors)
+ (erc-d-tests-with-failure-spy
+ errors '(erc-d--teardown erc-d-command)
+ (erc-d-tests-with-server (_ _) linger
+ (with-current-buffer (erc-d-t-wait-for 5 (get-buffer "#chan"))
+ (erc-d-t-search-for 2 "hey")
+ (erc-cmd-MSG "#chan hi"))
+ (erc-d-t-wait-for 10 "Bad match" errors)))
+ (should (string-match-p "Match failed.*hi" (cadr (pop errors))))))
+
+(ert-deftest erc-d-run-linger-direct ()
+ :tags '(:expensive-test)
+ (let* ((dumb-server (erc-d-run "localhost" t
+ 'linger-multi-a 'linger-multi-b))
+ (port (process-contact dumb-server :service))
+ (dumb-server-buffer (get-buffer "*erc-d-server*"))
+ (client-buffer-a (get-buffer-create "*erc-d-client-a*"))
+ (client-buffer-b (get-buffer-create "*erc-d-client-b*"))
+ (start (current-time))
+ client-a client-b)
+ (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
+ (setq client-a (open-network-stream "erc-d-client-a" client-buffer-a
+ "localhost" port
+ :coding 'binary)
+ client-b (open-network-stream "erc-d-client-b" client-buffer-b
+ "localhost" port
+ :coding 'binary))
+ (process-send-string client-a "PASS :a\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-b "PASS :b\r\n")
+ (sleep-for 0.01)
+ (erc-d-t-wait-for 3 "dumb-server death"
+ (not (process-live-p dumb-server)))
+ (ert-info ("Ensure linger of one second")
+ (should (time-less-p 1 (time-subtract (current-time) start)))
+ (should (time-less-p (time-subtract (current-time) start) 1.5)))
+ (delete-process client-a)
+ (delete-process client-b)
+ (when noninteractive
+ (kill-buffer client-buffer-a)
+ (kill-buffer client-buffer-b)
+ (kill-buffer dumb-server-buffer))))
+
+(ert-deftest erc-d-run-drop-direct ()
+ :tags '(:unstable)
+ (let* ((dumb-server (erc-d-run "localhost" t 'drop-a 'drop-b))
+ (port (process-contact dumb-server :service))
+ (dumb-server-buffer (get-buffer "*erc-d-server*"))
+ (client-buffer-a (get-buffer-create "*erc-d-client-a*"))
+ (client-buffer-b (get-buffer-create "*erc-d-client-b*"))
+ (start (current-time))
+ client-a client-b)
+ (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
+ (setq client-a (open-network-stream "erc-d-client-a" client-buffer-a
+ "localhost" port
+ :coding 'binary)
+ client-b (open-network-stream "erc-d-client-b" client-buffer-b
+ "localhost" port
+ :coding 'binary))
+ (process-send-string client-a "PASS :a\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-b "PASS :b\r\n")
+ (erc-d-t-wait-for 3 "client-a dies" (not (process-live-p client-a)))
+ (should (time-less-p (time-subtract (current-time) start) 0.32))
+ (erc-d-t-wait-for 3 "dumb-server death"
+ (not (process-live-p dumb-server)))
+ (ert-info ("Ensure linger of one second")
+ (should (time-less-p 1 (time-subtract (current-time) start))))
+ (delete-process client-a)
+ (delete-process client-b)
+ (when noninteractive
+ (kill-buffer client-buffer-a)
+ (kill-buffer client-buffer-b)
+ (kill-buffer dumb-server-buffer))))
+
+(ert-deftest erc-d-run-no-match ()
+ :tags '(:expensive-test)
+ (let ((erc-d-linger-secs 1)
+ erc-server-auto-reconnect
+ errors)
+ (erc-d-tests-with-failure-spy errors '(erc-d--teardown erc-d-command)
+ (erc-d-tests-with-server (_ erc-server-buffer) no-match
+ (with-current-buffer erc-server-buffer
+ (erc-d-t-search-for 2 "away")
+ (erc-cmd-JOIN "#foo")
+ (erc-d-t-wait-for 10 "Bad match" errors))))
+ (should (string-match-p "Match failed.*foo.*chan" (cadr (pop errors))))
+ (should-not (get-buffer "#foo"))))
+
+(ert-deftest erc-d-run-timeout ()
+ :tags '(:expensive-test)
+ (let ((erc-d-linger-secs 1)
+ err errors)
+ (erc-d-tests-with-failure-spy errors '(erc-d--teardown)
+ (erc-d-tests-with-server (_ _) timeout
+ (erc-d-t-wait-for 10 "error caught" errors)))
+ (setq err (pop errors))
+ (should (eq (car err) 'erc-d-timeout))
+ (should (string-match-p "Timed out" (cadr err)))))
+
+(ert-deftest erc-d-run-unexpected ()
+ :tags '(:expensive-test)
+ (let ((erc-d-linger-secs 2)
+ errors)
+ (erc-d-tests-with-failure-spy
+ errors '(erc-d--teardown erc-d-command)
+ (erc-d-tests-with-server (_ _) unexpected
+ (ert-info ("All specs consumed when more input arrives")
+ (erc-d-t-wait-for 10 "error caught" (cdr errors)))))
+ (should (string-match-p "unexpected.*MODE" (cadr (pop errors))))
+ ;; Nonsensical normally because func would have already exited when
+ ;; first error was thrown
+ (should (string-match-p "Match failed" (cadr (pop errors))))))
+
+(ert-deftest erc-d-run-unexpected-depleted ()
+ :tags '(:expensive-test)
+ (let ((erc-d-linger-secs 3)
+ errors)
+ (erc-d-tests-with-failure-spy errors '(erc-d--teardown erc-d-command)
+ (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*"))
+ (dumb-server (erc-d-run "localhost" t 'depleted))
+ (expect (erc-d-t-make-expecter))
+ (client-buf (get-buffer-create "*erc-d-client*"))
+ client-proc)
+ (with-current-buffer dumb-server-buffer
+ (erc-d-t-search-for 3 "Starting"))
+ (setq client-proc (make-network-process
+ :buffer client-buf
+ :name "erc-d-client"
+ :family 'ipv4
+ :noquery t
+ :coding 'binary
+ :service (process-contact dumb-server :service)
+ :host "localhost"))
+ (with-current-buffer dumb-server-buffer
+ (funcall expect 3 "open from"))
+ (process-send-string client-proc "PASS :changeme\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-proc "NICK tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-proc "USER user 0 * :tester\r\n")
+ (sleep-for 0.01)
+ (when (process-live-p client-proc)
+ (process-send-string client-proc "BLAH :too much\r\n")
+ (sleep-for 0.01))
+ (with-current-buffer client-buf
+ (funcall expect 3 "Welcome to the Internet"))
+ (erc-d-t-wait-for 2 "dumb-server death"
+ (not (process-live-p dumb-server)))
+ (delete-process client-proc)
+ (when noninteractive
+ (kill-buffer client-buf)
+ (kill-buffer dumb-server-buffer))))
+ (should (string-match-p "unexpected.*BLAH" (cadr (pop errors))))
+ ;; Wouldn't happen IRL
+ (should (string-match-p "unexpected.*BLAH" (cadr (pop errors))))
+ (should-not errors)))
+
+(defun erc-d-tests--dynamic-match-user (_dialog exchange)
+ "Shared pattern/response handler for canned dynamic DIALOG test."
+ (should (string= (match-string 1 (erc-d-exchange-request exchange))
+ "tester")))
+
+(defun erc-d-tests--run-dynamic ()
+ "Perform common assertions for \"dynamic\" dialog."
+ (erc-d-tests-with-server (dumb-server erc-server-buffer) dynamic
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (erc-d-t-search-for 2 "tester: hey"))
+ (with-current-buffer erc-server-buffer
+ (let ((expect (erc-d-t-make-expecter)))
+ (funcall expect 2 "host is irc.fsf.org")
+ (funcall expect 2 "modes for tester")))
+ (with-current-buffer (process-buffer dumb-server)
+ (erc-d-t-search-for 2 "irc.fsf.org"))
+ (when noninteractive
+ (kill-buffer "#chan"))))
+
+(ert-deftest erc-d-run-dynamic-default-match ()
+ :tags '(:expensive-test)
+ (let* (dynamic-tally
+ (erc-d-tmpl-vars '((user . "user")
+ (ignored . ((a b) (: a space b)))
+ (realname . (group (+ graph)))))
+ (nick (lambda (a)
+ (push '(nick . match-user) dynamic-tally)
+ (funcall a :set (funcall a :match 1) 'export)))
+ (dom (lambda (a)
+ (push '(dom . match-user) dynamic-tally)
+ (funcall a :set erc-d-server-fqdn)))
+ (erc-d-match-handlers
+ (list :user (lambda (d e)
+ (erc-d-exchange-rebind d e 'nick nick)
+ (erc-d-exchange-rebind d e 'dom dom)
+ (erc-d-tests--dynamic-match-user d e))
+ :mode-user (lambda (d e)
+ (erc-d-exchange-rebind d e 'nick "tester")
+ (erc-d-exchange-rebind d e 'dom dom))))
+ (erc-d-server-fqdn "irc.fsf.org"))
+ (erc-d-tests--run-dynamic)
+ (should (equal '((dom . match-user) (nick . match-user) (dom . match-user))
+ dynamic-tally))))
+
+(ert-deftest erc-d-run-dynamic-default-match-rebind ()
+ :tags '(:expensive-test)
+ (let* (tally
+ ;;
+ (erc-d-tmpl-vars '((user . "user")
+ (ignored . ((a b) (: a space b)))
+ (realname . (group (+ graph)))))
+ (erc-d-match-handlers
+ (list :user
+ (lambda (d e)
+ (erc-d-exchange-rebind
+ d e 'nick
+ (lambda (a)
+ (push 'bind-nick tally)
+ (funcall a :rebind 'nick (funcall a :match 1) 'export)))
+ (erc-d-exchange-rebind
+ d e 'dom
+ (lambda ()
+ (push 'bind-dom tally)
+ (erc-d-exchange-rebind d e 'dom erc-d-server-fqdn)))
+ (erc-d-tests--dynamic-match-user d e))
+ :mode-user
+ (lambda (d e)
+ (erc-d-exchange-rebind d e 'nick "tester")
+ (erc-d-exchange-rebind d e 'dom erc-d-server-fqdn))))
+ (erc-d-server-fqdn "irc.fsf.org"))
+ (erc-d-tests--run-dynamic)
+ (should (equal '(bind-nick bind-dom) tally))))
+
+(ert-deftest erc-d-run-dynamic-runtime-stub ()
+ :tags '(:expensive-test)
+ (let ((erc-d-tmpl-vars '((token . (group (or "barnet" "foonet")))))
+ (erc-d-match-handlers
+ (list :pass (lambda (d _e)
+ (erc-d-load-replacement-dialog d 'dynamic-foonet))))
+ (erc-d-tests-with-server-password "foonet:changeme"))
+ (erc-d-tests-with-server (_ erc-server-buffer)
+ (dynamic-stub dynamic-foonet)
+ (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
+ (erc-d-t-search-for 2 "alice:")
+ (erc-d-t-absent-for 0.1 "joe"))
+ (with-current-buffer erc-server-buffer
+ (let ((expect (erc-d-t-make-expecter)))
+ (funcall expect 2 "host is irc.foonet.org")
+ (funcall expect 2 "NETWORK=FooNet")))
+ (when noninteractive
+ (kill-buffer "#chan")))))
+
+(ert-deftest erc-d-run-dynamic-runtime-stub-skip ()
+ :tags '(:expensive-test)
+ (let ((erc-d-tmpl-vars '((token . "barnet")))
+ (erc-d-match-handlers
+ (list :pass (lambda (d _e)
+ (erc-d-load-replacement-dialog
+ d 'dynamic-barnet 1))))
+ (erc-d-tests-with-server-password "barnet:changeme"))
+ (erc-d-tests-with-server (_ erc-server-buffer)
+ (dynamic-stub dynamic-barnet)
+ (with-current-buffer (erc-d-t-wait-for 3 (get-buffer "#chan"))
+ (erc-d-t-search-for 2 "joe:")
+ (erc-d-t-absent-for 0.1 "alice"))
+ (with-current-buffer erc-server-buffer
+ (let ((expect (erc-d-t-make-expecter)))
+ (funcall expect 2 "host is irc.barnet.org")
+ (funcall expect 2 "NETWORK=BarNet")))
+ (when noninteractive
+ (kill-buffer "#chan")))))
+
+;; Two servers, in-process, one client per
+(ert-deftest erc-d-run-dual-direct ()
+ :tags '(:expensive-test)
+ (let* ((erc-d--slow-mo -1)
+ (server-a (erc-d-run "localhost" t "erc-d-server-a" 'dynamic-foonet))
+ (server-b (erc-d-run "localhost" t "erc-d-server-b" 'dynamic-barnet))
+ (server-a-buffer (get-buffer "*erc-d-server-a*"))
+ (server-b-buffer (get-buffer "*erc-d-server-b*"))
+ (client-a-buffer (get-buffer-create "*erc-d-client-a*"))
+ (client-b-buffer (get-buffer-create "*erc-d-client-b*"))
+ client-a client-b)
+ (with-current-buffer server-a-buffer (erc-d-t-search-for 4 "Starting"))
+ (with-current-buffer server-b-buffer (erc-d-t-search-for 4 "Starting"))
+ (setq client-a (make-network-process
+ :buffer client-a-buffer
+ :name "erc-d-client-a"
+ :family 'ipv4
+ :noquery t
+ :coding 'binary
+ :service (process-contact server-a :service)
+ :host "localhost")
+ client-b (make-network-process
+ :buffer client-b-buffer
+ :name "erc-d-client-b"
+ :family 'ipv4
+ :noquery t
+ :coding 'binary
+ :service (process-contact server-b :service)
+ :host "localhost"))
+ ;; Also tests slo-mo indirectly because FAKE would fail without it
+ (process-send-string client-a "NICK tester\r\n")
+ (process-send-string client-b "FAKE noop\r\nNICK tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-a "USER user 0 * :tester\r\n")
+ (process-send-string client-b "USER user 0 * :tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-a "MODE tester +i\r\n")
+ (process-send-string client-b "MODE tester +i\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-a "MODE #chan\r\n")
+ (process-send-string client-b "MODE #chan\r\n")
+ (sleep-for 0.01)
+ (erc-d-t-wait-for 2 "server-a death" (not (process-live-p server-a)))
+ (erc-d-t-wait-for 2 "server-b death" (not (process-live-p server-b)))
+ (when noninteractive
+ (kill-buffer client-a-buffer)
+ (kill-buffer client-b-buffer)
+ (kill-buffer server-a-buffer)
+ (kill-buffer server-b-buffer))))
+
+;; This can be removed; only exists to get a baseline for next test
+(ert-deftest erc-d-run-fuzzy-direct ()
+ :tags '(:expensive-test)
+ (let* ((erc-d-tmpl-vars
+ `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))
+ (dumb-server (erc-d-run "localhost" t 'fuzzy))
+ (dumb-server-buffer (get-buffer "*erc-d-server*"))
+ (client-buffer (get-buffer-create "*erc-d-client*"))
+ client)
+ (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
+ (setq client (make-network-process
+ :buffer client-buffer
+ :name "erc-d-client"
+ :family 'ipv4
+ :noquery t
+ :coding 'binary
+ :service (process-contact dumb-server :service)
+ :host "localhost"))
+ ;; We could also just send this as a single fatty
+ (process-send-string client "PASS :changeme\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "NICK tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "USER user 0 * :tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "MODE tester +i\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "JOIN #bar\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "JOIN #foo\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "MODE #bar\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "MODE #foo\r\n")
+ (sleep-for 0.01)
+ (erc-d-t-wait-for 1 "dumb-server death"
+ (not (process-live-p dumb-server)))
+ (when noninteractive
+ (kill-buffer client-buffer)
+ (kill-buffer dumb-server-buffer))))
+
+;; Without adjusting penalty, takes ~15 secs. With is comprable to direct ^.
+(ert-deftest erc-d-run-fuzzy ()
+ :tags '(:expensive-test)
+ (let ((erc-server-flood-penalty 1.2) ; penalty < margin/sends is basically 0
+ (erc-d-linger-secs 0.1)
+ (erc-d-tmpl-vars
+ `((now . ,(lambda () (format-time-string "%FT%T.%3NZ" nil t)))))
+ erc-server-auto-reconnect)
+ (erc-d-tests-with-server (_ erc-server-buffer) fuzzy
+ (with-current-buffer erc-server-buffer
+ (erc-d-t-search-for 2 "away")
+ (goto-char erc-input-marker)
+ (erc-cmd-JOIN "#bar"))
+ (erc-d-t-wait-for 2 (get-buffer "#bar"))
+ (with-current-buffer erc-server-buffer
+ (erc-cmd-JOIN "#foo"))
+ (erc-d-t-wait-for 20 (get-buffer "#foo"))
+ (with-current-buffer "#bar"
+ (erc-d-t-search-for 1 "was created on"))
+ (with-current-buffer "#foo"
+ (erc-d-t-search-for 5 "was created on")))))
+
+(ert-deftest erc-d-run-no-block ()
+ :tags '(:expensive-test)
+ (let ((erc-server-flood-penalty 1)
+ (erc-d-linger-secs 1.2)
+ (expect (erc-d-t-make-expecter))
+ erc-server-auto-reconnect)
+ (erc-d-tests-with-server (_ erc-server-buffer) no-block
+ (with-current-buffer erc-server-buffer
+ (funcall expect 2 "away")
+ (funcall expect 1 erc-prompt)
+ (with-current-buffer erc-server-buffer (erc-cmd-JOIN "#foo")))
+ (with-current-buffer (erc-d-t-wait-for 2 (get-buffer "#foo"))
+ (funcall expect 2 "was created on"))
+
+ (ert-info ("Join #bar")
+ (with-current-buffer erc-server-buffer (erc-cmd-JOIN "#bar"))
+ (erc-d-t-wait-for 2 (get-buffer "#bar")))
+
+ (with-current-buffer "#bar" (funcall expect 1 "was created on"))
+
+ (ert-info ("Server expects next pattern but keeps sending")
+ (with-current-buffer "#foo" (funcall expect 2 "Rosalind, I will "))
+ (with-current-buffer "#bar" (funcall expect 1 "hi 123"))
+ (with-current-buffer "#foo"
+ (should-not (search-forward "<bob> I am heard" nil t))
+ (funcall expect 1.5 "<bob> I am heard"))))))
+
+(defun erc-d-tests--run-proxy-direct (dumb-server dumb-server-buffer port)
+ "Start DUMB-SERVER with DUMB-SERVER-BUFFER and PORT.
+These are steps shared by in-proc and subproc variants testing a
+bouncer-like setup."
+ (when (version< emacs-version "28") (ert-skip "TODO connection refused"))
+ (let ((client-buffer-foo (get-buffer-create "*erc-d-client-foo*"))
+ (client-buffer-bar (get-buffer-create "*erc-d-client-bar*"))
+ (expect (erc-d-t-make-expecter))
+ client-foo
+ client-bar)
+ (setq client-foo (make-network-process
+ :buffer client-buffer-foo
+ :name "erc-d-client-foo"
+ :family 'ipv4
+ :noquery t
+ :coding 'binary
+ :service port
+ :host "localhost")
+ client-bar (make-network-process
+ :buffer client-buffer-bar
+ :name "erc-d-client-bar"
+ :family 'ipv4
+ :noquery t
+ :coding 'binary
+ :service port
+ :host "localhost"))
+ (with-current-buffer dumb-server-buffer
+ (funcall expect 3 "open from"))
+ (process-send-string client-foo "PASS :foo:changeme\r\n")
+ (process-send-string client-bar "PASS :bar:changeme\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-foo "NICK tester\r\n")
+ (process-send-string client-bar "NICK tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-foo "USER user 0 * :tester\r\n")
+ (process-send-string client-bar "USER user 0 * :tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-foo "MODE tester +i\r\n")
+ (process-send-string client-bar "MODE tester +i\r\n")
+ (sleep-for 0.01)
+ (with-current-buffer client-buffer-foo
+ (funcall expect 3 "FooNet")
+ (funcall expect 3 "irc.foo.net")
+ (funcall expect 3 "marked as being away")
+ (goto-char (point-min))
+ (should-not (search-forward "bar" nil t)))
+ (with-current-buffer client-buffer-bar
+ (funcall expect 3 "BarNet")
+ (funcall expect 3 "irc.bar.net")
+ (funcall expect 3 "marked as being away")
+ (goto-char (point-min))
+ (should-not (search-forward "foo" nil t)))
+ (erc-d-t-wait-for 2 "dumb-server death"
+ (not (process-live-p dumb-server)))
+ (delete-process client-foo)
+ (delete-process client-bar)
+ (when noninteractive
+ (kill-buffer client-buffer-foo)
+ (kill-buffer client-buffer-bar)
+ (kill-buffer dumb-server-buffer))))
+
+;; This test shows the simplest way to set up template variables: put
+;; everything needed for the whole session in `erc-d-tmpl-vars' before
+;; starting the server.
+
+(ert-deftest erc-d-run-proxy-direct-spec-vars ()
+ :tags '(:expensive-test)
+ (let* ((dumb-server-buffer (get-buffer-create "*erc-d-server*"))
+ (erc-d-linger-secs 0.5)
+ (erc-d-tmpl-vars
+ `((network . (group (+ alpha)))
+ (fqdn . ,(lambda (a)
+ (let ((network (funcall a :match 1 'pass)))
+ (should (member network '("foo" "bar")))
+ (funcall a :set (concat "irc." network ".net")))))
+ (net . ,(lambda (a)
+ (let ((network (funcall a :match 1 'pass)))
+ (should (member network '("foo" "bar")))
+ (concat (capitalize network) "Net"))))))
+ (dumb-server (erc-d-run "localhost" t 'proxy-foonet 'proxy-barnet))
+ (port (process-contact dumb-server :service)))
+ (with-current-buffer dumb-server-buffer
+ (erc-d-t-search-for 3 "Starting"))
+ (erc-d-tests--run-proxy-direct dumb-server dumb-server-buffer port)))
+
+(cl-defun erc-d-tests--start-server (&key dialogs buffer linger program libs)
+ "Start and return a server in a subprocess using BUFFER and PORT.
+DIALOGS are symbols representing the base names of dialog files in
+`erc-d-u-canned-dialog-dir'. LIBS are extra files to load."
+ (push (locate-library "erc-d" nil (list erc-d-u--library-directory)) libs)
+ (cl-assert (car libs))
+ (let* ((args `("erc-d-server" ,buffer
+ ,(concat invocation-directory invocation-name)
+ "-Q" "-batch" "-L" ,erc-d-u--library-directory
+ ,@(let (o) (while libs (push (pop libs) o) (push "-l" o)) o)
+ "-eval" ,(format "%S" program) "-f" "erc-d-serve"
+ ,@(when linger (list "--linger" (number-to-string linger)))
+ ,@(mapcar #'erc-d-u--expand-dialog-symbol dialogs)))
+ (proc (apply #'start-process args)))
+ (set-process-query-on-exit-flag proc nil)
+ (with-current-buffer buffer
+ (erc-d-t-search-for 5 "Starting")
+ (search-forward " (")
+ (backward-char))
+ (let ((pair (read buffer)))
+ (cons proc (cdr pair)))))
+
+(ert-deftest erc-d-run-proxy-direct-subprocess ()
+ :tags '(:expensive-test)
+ (let* ((buffer (get-buffer-create "*erc-d-server*"))
+ ;; These are quoted because they're passed as printed forms to subproc
+ (fqdn '(lambda (a e)
+ (let* ((d (erc-d-exchange-dialog e))
+ (name (erc-d-dialog-name d)))
+ (funcall a :set (if (eq name 'proxy-foonet)
+ "irc.foo.net"
+ "irc.bar.net")))))
+ (net '(lambda (a)
+ (funcall a :rebind 'net
+ (if (eq (funcall a :dialog-name) 'proxy-foonet)
+ "FooNet"
+ "BarNet"))))
+ (program `(setq erc-d-tmpl-vars '((fqdn . ,fqdn)
+ (net . ,net)
+ (network . (group (+ alpha))))))
+ (port (erc-d-tests--start-server
+ :linger 0.3
+ :program program
+ :buffer buffer
+ :dialogs '(proxy-foonet proxy-barnet)))
+ (server (pop port)))
+ (erc-d-tests--run-proxy-direct server buffer port)))
+
+(ert-deftest erc-d-run-proxy-direct-subprocess-lib ()
+ :tags '(:expensive-test)
+ (let* ((buffer (get-buffer-create "*erc-d-server*"))
+ (lib (expand-file-name "proxy-subprocess.el"
+ (ert-resource-directory)))
+ (port (erc-d-tests--start-server :linger 0.3
+ :buffer buffer
+ :dialogs '(proxy-foonet proxy-barnet)
+ :libs (list lib)))
+ (server (pop port)))
+ (erc-d-tests--run-proxy-direct server buffer port)))
+
+(ert-deftest erc-d-run-no-pong ()
+ :tags '(:expensive-test)
+ (let* (erc-d-auto-pong
+ ;;
+ (erc-d-tmpl-vars
+ `((nonce . (group (: digit digit)))
+ (echo . ,(lambda (a)
+ (should (string= (funcall a :match 1) "42")) "42"))))
+ (dumb-server-buffer (get-buffer-create "*erc-d-server*"))
+ (dumb-server (erc-d-run "localhost" t 'no-pong))
+ (expect (erc-d-t-make-expecter))
+ (client-buf (get-buffer-create "*erc-d-client*"))
+ client-proc)
+ (with-current-buffer dumb-server-buffer
+ (erc-d-t-search-for 3 "Starting"))
+ (setq client-proc (make-network-process
+ :buffer client-buf
+ :name "erc-d-client"
+ :family 'ipv4
+ :noquery t
+ :coding 'binary
+ :service (process-contact dumb-server :service)
+ :host "localhost"))
+ (with-current-buffer dumb-server-buffer
+ (funcall expect 3 "open from"))
+ (process-send-string client-proc "PASS :changeme\r\nNICK tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-proc "USER user 0 * :tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client-proc "MODE tester +i\r\n")
+ (sleep-for 0.01)
+ (with-current-buffer client-buf
+ (funcall expect 3 "ExampleOrg")
+ (funcall expect 3 "irc.example.org")
+ (funcall expect 3 "marked as being away"))
+ (ert-info ("PING is not intercepted by specialized method")
+ (process-send-string client-proc "PING 42\r\n")
+ (with-current-buffer client-buf
+ (funcall expect 3 "PONG")))
+ (erc-d-t-wait-for 2 "dumb-server death"
+ (not (process-live-p dumb-server)))
+ (delete-process client-proc)
+ (when noninteractive
+ (kill-buffer client-buf)
+ (kill-buffer dumb-server-buffer))))
+
+;; Inspect replies as they arrive within a single exchange, i.e., ensure we
+;; don't regress to prior buggy version in which inspection wasn't possible
+;; until all replies had been sent by the server.
+(ert-deftest erc-d-run-incremental ()
+ :tags '(:expensive-test)
+ (let ((erc-server-flood-penalty 0)
+ (expect (erc-d-t-make-expecter))
+ erc-d-linger-secs)
+ (erc-d-tests-with-server (_ erc-server-buffer) incremental
+ (with-current-buffer erc-server-buffer
+ (funcall expect 3 "marked as being away"))
+ (with-current-buffer erc-server-buffer
+ (erc-cmd-JOIN "#foo"))
+ (with-current-buffer (erc-d-t-wait-for 1 (get-buffer "#foo"))
+ (funcall expect 1 "Users on #foo")
+ (funcall expect 1 "Look for me")
+ (not (search-forward "Done" nil t))
+ (funcall expect 10 "Done")
+ (erc-send-message "Hi")))))
+
+(ert-deftest erc-d-unix-socket-direct ()
+ :tags '(:expensive-test)
+ (skip-unless (featurep 'make-network-process '(:family local)))
+ (let* ((erc-d-linger-secs 0.1)
+ (sock (expand-file-name "erc-d.sock" temporary-file-directory))
+ (dumb-server (erc-d-run nil sock 'basic))
+ (dumb-server-buffer (get-buffer "*erc-d-server*"))
+ (client-buffer (get-buffer-create "*erc-d-client*"))
+ client)
+ (with-current-buffer "*erc-d-server*"
+ (erc-d-t-search-for 4 "Starting"))
+ (unwind-protect
+ (progn
+ (setq client (make-network-process
+ :buffer client-buffer
+ :name "erc-d-client"
+ :family 'local
+ :noquery t
+ :coding 'binary
+ :service sock))
+ (process-send-string client "PASS :changeme\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "NICK tester\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "USER user 0 * :tester\r\n")
+ (sleep-for 0.1)
+ (process-send-string client "MODE tester +i\r\n")
+ (sleep-for 0.01)
+ (process-send-string client "MODE #chan\r\n")
+ (sleep-for 0.01)
+ (erc-d-t-wait-for 1 "dumb-server death"
+ (not (process-live-p dumb-server)))
+ (when noninteractive
+ (kill-buffer client-buffer)
+ (kill-buffer dumb-server-buffer)))
+ (delete-file sock))))
+
+;;; erc-d-tests.el ends here
--- /dev/null
+;;; erc-d-u.el --- Helpers for ERC test server -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program 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.
+;;
+;; This program 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 this program. If not, see
+;; <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The utilities here are kept separate from those in `erc-d' so that
+;; tests running the server in a subprocess can use them without
+;; having to require the main lib. If migrating outside of test/lisp,
+;; there may be no reason to continue this.
+;;
+;; Another (perhaps misguided) goal here is to avoid having ERC itself
+;; as a dependency.
+;;
+;; FIXME this ^ is no longer the case (ERC is not a dependency)
+
+;;; Code:
+(require 'rx)
+(require 'subr-x)
+(eval-when-compile (require 'ert))
+
+(defvar erc-d-u--canned-buffers nil
+ "List of canned dialog buffers currently open for reading.")
+
+(cl-defstruct (erc-d-u-scan-d) ; dialog scanner
+ (buf nil :type buffer)
+ (done nil :type boolean)
+ (last nil :type integer)
+ (hunks nil :type (list-of marker))
+ (f #'erc-d-u--read-exchange-default :type function))
+
+(cl-defstruct (erc-d-u-scan-e) ; exchange scanner
+ (sd nil :type erc-d-u-scan-d)
+ (pos nil :type marker))
+
+(defun erc-d-u--read-dialog (info)
+ "Read dialog file and stash relevant state in `erc-d-u-scan-d' INFO."
+ (if (and (buffer-live-p (erc-d-u-scan-d-buf info))
+ (with-current-buffer (erc-d-u-scan-d-buf info)
+ (condition-case _err
+ (progn
+ (when (erc-d-u-scan-d-last info)
+ (goto-char (erc-d-u-scan-d-last info))
+ (forward-list))
+ (setf (erc-d-u-scan-d-last info) (point))
+ (down-list)
+ (push (set-marker (make-marker) (point))
+ (erc-d-u-scan-d-hunks info)))
+ ((end-of-buffer scan-error)
+ (setf (erc-d-u-scan-d-done info) t)
+ nil))))
+ (make-erc-d-u-scan-e :sd info :pos (car (erc-d-u-scan-d-hunks info)))
+ (unless (erc-d-u-scan-d-hunks info)
+ (kill-buffer (erc-d-u-scan-d-buf info))
+ nil)))
+
+(defun erc-d-u--read-exchange-default (info)
+ "Read from marker in exchange `erc-d-u-scan-e' object INFO."
+ (let ((hunks (erc-d-u-scan-e-sd info))
+ (pos (erc-d-u-scan-e-pos info)))
+ (or (and (erc-d-u-scan-d-hunks hunks)
+ (with-current-buffer (erc-d-u-scan-d-buf hunks)
+ (goto-char pos)
+ (condition-case _err
+ (read pos)
+ ;; Raised unless malformed
+ (invalid-read-syntax
+ nil))))
+ (unless (or (cl-callf (lambda (s) (delq pos s)) ; flip
+ (erc-d-u-scan-d-hunks hunks))
+ (not (erc-d-u-scan-d-done hunks)))
+ (kill-buffer (erc-d-u-scan-d-buf hunks))
+ nil))))
+
+(defun erc-d-u--read-exchange (info)
+ "Call exchange reader assigned in `erc-d-u-scan-e' object INFO."
+ (funcall (erc-d-u-scan-d-f (erc-d-u-scan-e-sd info)) info))
+
+(defun erc-d-u--canned-read (file)
+ "Dispense a reader for each exchange in dialog FILE."
+ (let ((buf (generate-new-buffer (file-name-nondirectory file))))
+ (push buf erc-d-u--canned-buffers)
+ (with-current-buffer buf
+ (setq-local parse-sexp-ignore-comments t
+ coding-system-for-read 'utf-8)
+ (add-hook 'kill-buffer-hook
+ (lambda () (setq erc-d-u--canned-buffers
+ (delq buf erc-d-u--canned-buffers)))
+ nil 'local)
+ (insert-file-contents-literally file)
+ (lisp-data-mode))
+ (make-erc-d-u-scan-d :buf buf)))
+
+(defvar erc-d-u--library-directory (file-name-directory load-file-name))
+(defvar erc-d-u-canned-dialog-dir
+ (file-name-as-directory (expand-file-name "resources"
+ erc-d-u--library-directory)))
+
+(defun erc-d-u--normalize-canned-name (dialog)
+ "Return DIALOG name as a symbol without validating it."
+ (if (symbolp dialog)
+ dialog
+ (intern (file-name-base dialog))))
+
+(defvar erc-d-u-canned-file-name-extension ".eld")
+
+(defun erc-d-u--expand-dialog-symbol (dialog)
+ "Return filename based on symbol DIALOG."
+ (let ((name (symbol-name dialog)))
+ (unless (equal (file-name-extension name)
+ erc-d-u-canned-file-name-extension)
+ (setq name (concat name erc-d-u-canned-file-name-extension)))
+ (expand-file-name name erc-d-u-canned-dialog-dir)))
+
+(defun erc-d-u--massage-canned-name (dialog)
+ "Return DIALOG in a form acceptable to `erc-d-run'."
+ (if (or (symbolp dialog) (file-exists-p dialog))
+ dialog
+ (erc-d-u--expand-dialog-symbol (intern dialog))))
+
+(defun erc-d-u--canned-load-dialog (dialog)
+ "Load dispensing exchanges from DIALOG.
+If DIALOG is a string, consider it a filename. Otherwise find a file
+in `erc-d-u-canned-dialog-dir' with a base name matching the symbol's
+name.
+
+Return an iterator that yields exchanges, each one an iterator of spec
+forms. The first is a so-called request spec and the rest are composed
+of zero or more response specs."
+ (when (symbolp dialog)
+ (setq dialog (erc-d-u--expand-dialog-symbol dialog)))
+ (unless (file-exists-p dialog)
+ (error "File not found: %s" dialog))
+ (erc-d-u--canned-read dialog))
+
+(defun erc-d-u--read-exchange-slowly (num orig info)
+ (when-let ((spec (funcall orig info)))
+ (when (symbolp (car spec))
+ (setf spec (copy-sequence spec)
+ (nth 1 spec) (cond ((functionp num) (funcall num (nth 1 spec)))
+ ((< num 0) (max (nth 1 spec) (- num)))
+ (t (+ (nth 1 spec) num)))))
+ spec))
+
+(defun erc-d-u--rewrite-for-slow-mo (num read-info)
+ "Return READ-INFO with a modified reader.
+When NUM is a positive number, delay incoming requests by NUM more
+seconds. If NUM is negative, raise insufficient incoming delays to at
+least -NUM seconds. If NUM is a function, set each delay to whatever it
+returns when called with the existing value."
+ (let ((orig (erc-d-u-scan-d-f read-info)))
+ (setf (erc-d-u-scan-d-f read-info)
+ (apply-partially #'erc-d-u--read-exchange-slowly num orig))
+ read-info))
+
+(defun erc-d-u--get-remote-port (process)
+ "Return peer TCP port for client PROCESS.
+When absent, just generate an id."
+ (let ((remote (plist-get (process-contact process t) :remote)))
+ (if (vectorp remote)
+ (aref remote (1- (length remote)))
+ (format "%s:%d" (process-contact process :local)
+ (logand 1023 (time-convert nil 'integer))))))
+
+(defun erc-d-u--format-bind-address (process)
+ "Return string or (STRING . INT) for bind address of network PROCESS."
+ (let ((local (process-contact process :local)))
+ (if (vectorp local) ; inet
+ (cons (mapconcat #'number-to-string (seq-subseq local 0 -1) ".")
+ (aref local (1- (length local))))
+ local)))
+
+(defun erc-d-u--unkeyword (plist)
+ "Return a copy of PLIST with keywords keys converted to non-keywords."
+ (cl-loop for (key value) on plist by #'cddr
+ when (keywordp key)
+ do (setq key (intern (substring (symbol-name key) 1)))
+ append (list key value)))
+
+(defun erc-d-u--massage-rx-args (key val)
+ " Massage val so it's suitable for an `rx-let' binding.
+Handle cases in which VAL is ([ARGLIST] RX-FORM) rather than just
+RX-FORM. KEY becomes the binding name."
+ (if (and (listp val)
+ (cdr val)
+ (not (cddr val))
+ (consp (car val)))
+ (cons key val)
+ (list key val)))
+
+(defvar-local erc-d-u--process-buffer nil
+ "Beacon for erc-d process buffers.
+The server process is usually deleted first, but we may want to examine
+the buffer afterward.")
+
+(provide 'erc-d-u)
+;;; erc-d-u.el ends here
--- /dev/null
+;;; erc-d.el --- A dumb test server for ERC -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program 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.
+;;
+;; This program 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 this program. If not, see
+;; <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a netcat style server for testing ERC. The "d" in the name
+;; stands for "daemon" as well as for "dialog" (as well as for "dumb"
+;; because this server isn't very smart). It either spits out a
+;; canned reply when an incoming request matches the expected regexp
+;; or signals an error and dies. The entry point function is
+;; `erc-d-run'.
+;;
+;; Canned scripts, or "dialogs," should be Lisp-Data files containing
+;; one or more request/reply forms like this:
+;;
+;; | ((mode-chan 1.5 "MODE #chan") ; request: tag, expr, regex
+;; | (0.1 ":irc.org 324 bob #chan +Cint") ; reply: delay, content
+;; | (0.0 ":irc.org 329 bob #chan 12345")) ; reply: ...
+;;
+;; These are referred to as "exchanges." The first element is a list
+;; whose CAR is a descriptive "tag" and whose CDR is an incoming
+;; "spec" representing an inbound message from the client. The rest
+;; of the exchange is composed of outgoing specs representing
+;; server-to-client messages. A tag can be any symbol (ideally unique
+;; in the dialog), but a leading tilde means the request should be
+;; allowed to arrive out of order (within the allotted time).
+;;
+;; The first element in an incoming spec is a number indicating the
+;; maximum number of seconds to wait for a match before raising an
+;; error. The CDR is interpreted as the collective arguments of an
+;; `rx' form to be matched against the raw request (stripped of its
+;; CRLF line ending). A "string-start" backslash assertion, "\\`", is
+;; prepended to all patterns.
+;;
+;; Similarly, the leading number in an *outgoing* spec indicates how
+;; many seconds to wait before sending the line, which is rendered by
+;; concatenating the other members after evaluating each in place.
+;; CRLF line endings are appended on the way out and should be absent.
+;;
+;; Recall that IRC is "asynchronous," meaning some flow intervals
+;; don't jibe with lockstep request-reply semantics. However, for our
+;; purposes, grouping things as [input, output1, ..., outputN] makes
+;; sense, even though input and output may be completely unrelated.
+;;
+;; Template interpolation:
+;;
+;; A rudimentary templating facility is provided for additional
+;; flexibility. However, it's best to keep things simple (even if
+;; overly verbose), so others can easily tell what's going on at a
+;; glance. If necessary, consult existing tests for examples (grep
+;; for the variables `erc-d-tmpl-vars' and `erc-d-match-handlers').
+;;
+;; Subprocess or in-process?:
+;;
+;; Running in-process confers better visibility and easier setup at
+;; the cost of additional cleanup and resource wrangling. With a
+;; subprocess, cleanup happens by pulling the plug, but configuration
+;; means loading a separate file or passing -eval "(forms...)" during
+;; invocation. In some cases, a subprocess may be the only option,
+;; like when trying to avoid `require'ing this file.
+;;
+;; Dialog objects:
+;;
+;; For a given exchange, the first argument passed to a request
+;; handler is the `erc-d-dialog' object representing the overall
+;; conversation with the connecting peer. It can be used to pass
+;; information between handlers during a session. Some important
+;; items are:
+;;
+;; * name (symbol); name of the current dialog
+;;
+;; * queue (ring); a backlog of unhandled raw requests, minus CRLF
+;; endings.
+;;
+;; * timers (list of timers); when run, these send messages originally
+;; deferred as per the most recently matched exchange's delay info.
+;; Normally, all outgoing messages must be sent before another request
+;; is considered. (See `erc-d--send-outgoing' for an escape hatch.)
+;;
+;; * hunks (iterator of iterators); unconsumed exchanges as read from
+;; a Lisp-Data dialog file. The exchange iterators being dispensed
+;; themselves yield portions of member forms as a 2- or 3-part
+;; sequence: [tag] spec. (Here, "hunk" just means "list of raw,
+;; unrendered exchange elements")
+;;
+;; * vars (alist of cons pairs); for sharing state among template
+;; functions during the lifetime of an exchange. Initially populated
+;; by `erc-d-tmpl-vars', these KEY/VALUE pairs are expanded in the
+;; templates and optionally updated by "exchange handlers" (see
+;; `erc-d-match-handlers'). When VALUE is a function, occurrences of
+;; KEY in an outgoing spec are replaced with the result of calling
+;; VALUE with match data set appropriately. See
+;; `erc-d--render-entries' for details.
+;;
+;; * exchanges (ring of erc-d-exchange objects); activated hunks
+;; allowed to match out of order, plus the current active exchange
+;; being yielded from, if any. See `erc-d-exchange'.
+;;
+;; TODO
+;;
+;; - Remove un(der)used functionality and simplify API
+;; - Maybe migrate d-u and d-i dependencies here
+
+;;; Code:
+(eval-and-compile
+ (let* ((d (file-name-directory (or (macroexp-file-name) buffer-file-name)))
+ (load-path (cons (directory-file-name d) load-path)))
+ (require 'erc-d-i)
+ (require 'erc-d-u)))
+
+(require 'ring)
+
+(defvar erc-d-server-name "erc-d-server"
+ "Default name of a server process and basis for its buffer name.
+Only relevant when starting a server with `erc-d-run'.")
+
+(defvar erc-d-server-fqdn "irc.example.org"
+ "Usually the same as the server's RPL_MYINFO \"announced name\".
+Possibly used by overriding handlers, like the one for PING, and/or
+dialog templates for the sender portion of a reply message.")
+
+(defvar erc-d-linger-secs nil
+ "Seconds to wait before quitting for all dialogs.
+For more granular control, use the provided LINGER `rx' variable (alone)
+as the incoming template spec of a dialog's last exchange.")
+
+(defvar erc-d-tmpl-vars nil
+ "An alist of template bindings available to client dialogs.
+Populate it when calling `erc-d-run', and the contents will be made
+available to all client dialogs through the `erc-d-dialog' \"vars\"
+field and (therefore) to all templates as variables when rendering. For
+example, a key/value pair like (network . \"oftc\") will cause instances
+of the (unquoted) symbol `network' to be replaced with \"oftc\" in the
+rendered template string.
+
+This list provides default template bindings common to all dialogs.
+Each new client-connection process makes a shallow copy on init, but the
+usual precautions apply when mutating member items. Within the span of
+a dialog, updates not applicable to all exchanges should die with their
+exchange. See `erc-d--render-entries' for details. In the unlikely
+event that an exchange-specific handler is needed, see
+`erc-d-match-handlers'.")
+
+(defvar erc-d-match-handlers nil
+ "A plist of exchange-tag symbols mapped to request-handler functions.
+This is meant to address edge cases for which `erc-d-tmpl-vars' comes up
+short. These may include (1) needing access to the client process
+itself and/or (2) adding or altering outgoing response templates before
+rendering. Note that (2) requires using `erc-d-exchange-rebind' instead
+of manipulating exchange bindings directly.
+
+The hook-like function `erc-d-on-match' calls any handler whose key is
+`eq' to the tag of the currently matched exchange (passing the client
+`erc-d-dialog' as the first argument and the current `erc-d-exchange'
+object as the second). The handler runs just prior to sending the first
+response.")
+
+(defvar erc-d-auto-pong t
+ "Handle PING requests automatically.")
+
+(defvar erc-d--in-process t
+ "Whether the server is running in the same Emacs as ERT.")
+
+(defvar erc-d--slow-mo nil
+ "Adjustment for all incoming timeouts.
+This is to allow for human interaction or a slow Emacs or CI runner.
+The value is the number of seconds to extend all incoming spec timeouts
+by on init. If the value is a negative number, it's negated and
+interpreted as a lower bound to raise all incoming timeouts to. If the
+value is a function, it should take an existing timeout in seconds and
+return a replacement.")
+
+(defconst erc-d--eof-sentinel "__EOF__")
+(defconst erc-d--linger-sentinel "__LINGER__")
+(defconst erc-d--drop-sentinel "__DROP__")
+
+(defvar erc-d--clients nil
+ "List containing all clients for this server session.")
+
+;; Some :type names may just be made up (not actual CL types)
+
+(cl-defstruct (erc-d-spec) ; see `erc-d--render-entries'
+ (head nil :type symbol) ; or number?
+ (entry nil :type list)
+ (state 0 :type integer))
+
+(cl-defstruct (erc-d-exchange)
+ "Object representing a request/response unit from a canned dialog."
+ (dialog nil :type erc-d-dialog) ; owning dialog
+ (tag nil :type symbol) ; a.k.a. tag, the caar
+ (pattern nil :type string) ; regexp to match requests against
+ (inspec nil :type list) ; original unrendered incoming spec
+ (hunk nil :type erc-d-u-scan-e) ; active raw exchange hunk being yielded
+ (spec nil :type erc-d-spec) ; active spec, see `erc-d--render-entries'
+ (timeout nil :type number) ; time allotted for current request
+ (timer nil :type timer) ; match timer fires when timeout expires
+ (bindings nil :type list) ; `eval'-style env pairs (KEY . VAL) ...
+ (rx-bindings nil :type list) ; rx-let bindings
+ (deferred nil :type boolean) ; whether sender is paused
+ ;; Post-match
+ (match-data nil :type match-data) ; from the latest matched request
+ (request nil :type string)) ; the original request sans CRLF
+
+(cl-defstruct (erc-d-dialog)
+ "Session state for managing a client conversation."
+ (process nil :type process) ; client-connection process
+ (name nil :type symbol) ; likely the interned stem of the file
+ (queue nil :type ring) ; backlog of incoming lines to process
+ (hunks nil :type erc-d-u-scan-d) ; nil when done; info on raw exchange hunks
+ (timers nil :type list) ; unsent replies
+ (vars nil :type list) ; template bindings for rendering
+ (exchanges nil :type ring) ; ring of erc-d-exchange objects
+ (state nil :type symbol) ; handler's last recorded control state
+ (matched nil :type erc-d-exchange) ; currently matched exchange
+ (message nil :type erc-d-i-message) ; `erc-d-i-message'
+ (match-handlers nil :type list) ; copy of `erc-d-match-handlers'
+ (server-fqdn nil :type string) ; copy of `erc-d-server-fqdn'
+ (finalizer nil :type function) ; custom teardown, passed dialog and exchange
+ ;; Post-match history is a plist whose keys are exchange tags
+ ;; (symbols) and whose values are a cons of match-data and request
+ ;; values from prior matches.
+ (history nil :type list))
+
+(defun erc-d--initialize-client (process)
+ "Initialize state variables used by a client PROCESS."
+ ;; Discard server-only/owned props
+ (process-put process :dialog-dialogs nil)
+ (let* ((server (process-get process :server))
+ (reader (pop (process-get server :dialog-dialogs)))
+ (name (pop reader))
+ ;; Copy handlers so they can self-mutate per process
+ (mat-h (copy-sequence (process-get process :dialog-match-handlers)))
+ (fqdn (copy-sequence (process-get process :dialog-server-fqdn)))
+ (vars (copy-sequence (process-get process :dialog-vars)))
+ (dialog (make-erc-d-dialog :name name
+ :process process
+ :queue (make-ring 5)
+ :exchanges (make-ring 10)
+ :match-handlers mat-h
+ :server-fqdn fqdn)))
+ ;; Add items expected by convenience commands like `erc-d-exchange-reload'.
+ (setf (alist-get 'EOF vars) `(: ,erc-d--eof-sentinel eot)
+ (alist-get 'LINGER vars) `(: ,erc-d--linger-sentinel eot)
+ (alist-get 'DROP vars) `(: ,erc-d--drop-sentinel eot)
+ (erc-d-dialog-vars dialog) vars
+ (erc-d-dialog-hunks dialog) reader)
+ ;; Add reverse link, register client, launch
+ (process-put process :dialog dialog)
+ (push process erc-d--clients)
+ (erc-d--command-refresh dialog nil)
+ (erc-d--on-request process)))
+
+(defun erc-d-load-replacement-dialog (dialog replacement &optional skip)
+ "Find REPLACEMENT among backlog and swap out current DIALOG's iterator.
+With int SKIP, advance past that many exchanges."
+ (let* ((process (erc-d-dialog-process dialog))
+ (server (process-get process :server))
+ (reader (assoc-default replacement
+ (process-get server :dialog-dialogs)
+ #'eq)))
+ (when skip (while (not (zerop skip))
+ (erc-d-u--read-dialog reader)
+ (cl-decf skip)))
+ (dolist (timer (erc-d-dialog-timers dialog))
+ (cancel-timer timer))
+ (dolist (exchange (ring-elements (erc-d-dialog-exchanges dialog)))
+ (cancel-timer (erc-d-exchange-timer exchange)))
+ (setf (erc-d-dialog-hunks dialog) reader)
+ (erc-d--command-refresh dialog nil)))
+
+(defvar erc-d--m-debug (getenv "ERC_D_DEBUG"))
+
+(defmacro erc-d--m (process format-string &rest args)
+ "Output ARGS using FORMAT-STRING somewhere depending on context.
+PROCESS should be a client connection or a server network process."
+ `(let ((format-string (if erc-d--m-debug
+ (concat (format-time-string "%s.%N: ")
+ ,format-string)
+ ,format-string))
+ (want-insert (and ,process erc-d--in-process)))
+ (when want-insert
+ (with-current-buffer (process-buffer (process-get ,process :server))
+ (goto-char (point-max))
+ (insert (concat (format ,format-string ,@args) "\n"))))
+ (when (or erc-d--m-debug (not want-insert))
+ (message format-string ,@args))))
+
+(defmacro erc-d--log (process string &optional outbound)
+ "Log STRING sent to (OUTBOUND) or received from PROCESS peer."
+ `(let ((id (or (process-get ,process :log-id)
+ (let ((port (erc-d-u--get-remote-port ,process)))
+ (process-put ,process :log-id port)
+ port)))
+ (name (erc-d-dialog-name (process-get ,process :dialog))))
+ (if ,outbound
+ (erc-d--m process "-> %s:%s %s" name id ,string)
+ (dolist (line (split-string ,string "\r\n"))
+ (erc-d--m process "<- %s:%s %s" name id line)))))
+
+(defun erc-d--log-process-event (server process msg)
+ (erc-d--m server "%s: %s" process (string-trim-right msg)))
+
+(defun erc-d--send (process string)
+ "Send STRING to PROCESS peer."
+ (erc-d--log process string 'outbound)
+ (process-send-string process (concat string "\r\n")))
+
+(define-inline erc-d--fuzzy-p (exchange)
+ (inline-letevals (exchange)
+ (inline-quote
+ (let ((tag (symbol-name (erc-d-exchange-tag ,exchange))))
+ (eq ?~ (aref tag 0))))))
+
+(define-error 'erc-d-timeout "Timed out awaiting expected request")
+
+(defun erc-d--finalize-dialog (dialog)
+ "Delete client-connection and finalize DIALOG.
+Return associated server."
+ (let ((process (erc-d-dialog-process dialog)))
+ (setq erc-d--clients (delq process erc-d--clients))
+ (dolist (timer (erc-d-dialog-timers dialog))
+ (cancel-timer timer))
+ (dolist (exchange (ring-elements (erc-d-dialog-exchanges dialog)))
+ (cancel-timer (erc-d-exchange-timer exchange)))
+ (prog1 (process-get process :server)
+ (delete-process process))))
+
+(defun erc-d--teardown (&optional sig &rest msg)
+ "Clean up processes and maybe send signal SIG using MSG."
+ (unless erc-d--in-process
+ (when sig
+ (erc-d--m nil "%s %s" sig (apply #'format-message msg)))
+ (kill-emacs (if msg 1 0)))
+ (let (process servers)
+ (while (setq process (pop erc-d--clients))
+ (push (erc-d--finalize-dialog (process-get process :dialog)) servers))
+ (dolist (server servers)
+ (delete-process server)))
+ (dolist (timer timer-list)
+ (when (memq (timer--function timer)
+ '(erc-d--send erc-d--command-handle-all))
+ (erc-d--m nil "Stray timer found: %S" (timer--function timer))
+ (cancel-timer timer)))
+ (when sig
+ (dolist (buf erc-d-u--canned-buffers)
+ (kill-buffer buf))
+ (setq erc-d-u--canned-buffers nil)
+ (signal sig (list (apply #'format-message msg)))))
+
+(defun erc-d--teardown-this-dialog-at-least (dialog)
+ "Run `erc-d--teardown' after destroying DIALOG if it's the last one."
+ (let ((server (process-get (erc-d-dialog-process dialog) :server))
+ (us (erc-d-dialog-process dialog)))
+ (erc-d--finalize-dialog dialog)
+ (cl-assert (not (memq us erc-d--clients)))
+ (unless (or (process-get server :dialog-dialogs)
+ (catch 'other
+ (dolist (process erc-d--clients)
+ (when (eq (process-get process :server) server)
+ (throw 'other process)))))
+ (push us erc-d--clients)
+ (erc-d--teardown))))
+
+(defun erc-d--expire (dialog exchange)
+ "Raise timeout error for EXCHANGE.
+This will start the teardown for DIALOG."
+ (setf (erc-d-exchange-spec exchange) nil)
+ (if-let ((finalizer (erc-d-dialog-finalizer dialog)))
+ (funcall finalizer dialog exchange)
+ (erc-d--teardown 'erc-d-timeout "Timed out awaiting request: %s"
+ (list :name (erc-d-exchange-tag exchange)
+ :pattern (erc-d-exchange-pattern exchange)
+ :timeout (erc-d-exchange-timeout exchange)
+ :dialog (erc-d-dialog-name dialog)))))
+
+;; Using `run-at-time' here allows test cases to examine replies as
+;; they arrive instead of forcing tests to wait until an exchange
+;; completes. The `run-at-time' in `erc-d--command-meter-replies'
+;; does the same. When running as a subprocess, a normal while loop
+;; with a `sleep-for' works fine (including with multiple dialogs).
+;; FYI, this issue was still present in older versions that called
+;; this directly from `erc-d--filter'.
+
+(defun erc-d--on-request (process)
+ "Handle one request for client-connection PROCESS."
+ (when (process-live-p process)
+ (let* ((dialog (process-get process :dialog))
+ (queue (erc-d-dialog-queue dialog)))
+ (unless (ring-empty-p queue)
+ (let* ((parsed (ring-remove queue))
+ (cmd (intern (erc-d-i-message.command parsed))))
+ (setf (erc-d-dialog-message dialog) parsed)
+ (erc-d-command dialog cmd)))
+ (run-at-time nil nil #'erc-d--on-request process))))
+
+(defun erc-d--drop-p (exchange)
+ (memq 'DROP (erc-d-exchange-inspec exchange)))
+
+(defun erc-d--linger-p (exchange)
+ (memq 'LINGER (erc-d-exchange-inspec exchange)))
+
+(defun erc-d--fake-eof (dialog)
+ "Simulate receiving a fictitious \"EOF\" message from peer."
+ (setf (erc-d-dialog-message dialog) ; use downcase for internal cmds
+ (make-erc-d-i-message :command "eof" :unparsed erc-d--eof-sentinel))
+ (run-at-time nil nil #'erc-d-command dialog 'eof))
+
+(defun erc-d--process-sentinel (process event)
+ "Set up or tear down client-connection PROCESS depending on EVENT."
+ (erc-d--log-process-event process process event)
+ (if (eq 'open (process-status process))
+ (erc-d--initialize-client process)
+ (let* ((dialog (process-get process :dialog))
+ (exes (and dialog (erc-d-dialog-exchanges dialog))))
+ (if (and exes (not (ring-empty-p exes)))
+ (cond ((string-prefix-p "connection broken" event)
+ (erc-d--fake-eof dialog))
+ ;; Ignore disconnecting peer when pattern is DROP
+ ((and (string-prefix-p "deleted" event)
+ (erc-d--drop-p (ring-ref exes -1))))
+ (t (erc-d--teardown)))
+ (erc-d--teardown)))))
+
+(defun erc-d--filter (process string)
+ "Handle input received from peer.
+PROCESS represents a client peer connection and STRING is a raw request
+including line delimiters."
+ (let ((queue (erc-d-dialog-queue (process-get process :dialog))))
+ (setq string (concat (process-get process :stashed-input) string))
+ (while (and string (string-match (rx (+ "\r\n")) string))
+ (let ((line (substring string 0 (match-beginning 0))))
+ (setq string (unless (= (match-end 0) (length string))
+ (substring string (match-end 0))))
+ (erc-d--log process line nil)
+ (ring-insert queue (erc-d-i--parse-message line 'decode))))
+ (when string
+ (setf (process-get process :stashed-input) string))))
+
+;; Misc process properties:
+;;
+;; The server property `:dialog-dialogs' is an alist of (symbol
+;; . erc-d-u-scan-d) conses, each of which pairs a dialogs name with
+;; info on its read progress (described above in the Commentary).
+;; This list is populated by `erc-d-run' at the start of each session.
+;;
+;; Client-connection processes keep a reference to their server via a
+;; `:server' property, which can be used to share info with other
+;; clients. There is currently no built-in way to do the same with
+;; clients of other servers. Clients also keep references to their
+;; dialogs and raw messages via `:dialog' and `:stashed-input'.
+;;
+;; The logger stores a unique, human-friendly process name in the
+;; client-process property `:log-id'.
+
+(defun erc-d--start (host service name &rest plist)
+ "Serve canned replies on HOST at SERVICE.
+Return the new server process immediately when `erc-d--in-process' is
+non-nil. Otherwise, serve forever. PLIST becomes the plist of the
+server process and is used to initialize the plists of connection
+processes. NAME is used for the process and the buffer."
+ (let* ((buf (get-buffer-create (concat "*" name "*")))
+ (proc (make-network-process :server t
+ :buffer buf
+ :noquery t
+ :filter #'erc-d--filter
+ :log #'erc-d--log-process-event
+ :sentinel #'erc-d--process-sentinel
+ :name name
+ :family (if host 'ipv4 'local)
+ :coding 'binary
+ :service (or service t)
+ :host host
+ :plist plist)))
+ (process-put proc :server proc)
+ ;; We don't have a minor mode, so use an arbitrary variable to mark
+ ;; buffers owned by us instead
+ (with-current-buffer buf (setq erc-d-u--process-buffer t))
+ (erc-d--m proc "Starting network process: %S %S"
+ proc (erc-d-u--format-bind-address proc))
+ (if erc-d--in-process
+ proc
+ (while (process-live-p proc)
+ (accept-process-output nil 0.01)))))
+
+(defun erc-d--wrap-func-val (dialog exchange key func)
+ "Return a form invoking FUNC when evaluated.
+Arrange for FUNC to be called with the args it expects based on
+the description in `erc-d--render-entries'."
+ (let (args)
+ ;; Ignore &rest or &optional
+ (pcase-let ((`(,n . ,_) (func-arity func)))
+ (pcase n
+ (0)
+ (1 (push (apply-partially #'erc-d-exchange-multi dialog exchange key)
+ args))
+ (2 (push exchange args)
+ (push (apply-partially #'erc-d-exchange-multi dialog exchange key)
+ args))
+ (_ (error "Incompatible function: %s" func))))
+ (lambda () (apply func args))))
+
+(defun erc-d-exchange-reload (dialog exchange)
+ "Rebuild all bindings for EXCHANGE from those in DIALOG."
+ (cl-loop for (key . val) in (erc-d-dialog-vars dialog)
+ unless (keywordp key)
+ do (push (erc-d-u--massage-rx-args key val)
+ (erc-d-exchange-rx-bindings exchange))
+ when (functionp val) do
+ (setq val (erc-d--wrap-func-val dialog exchange key val))
+ do (push (cons key val) (erc-d-exchange-bindings exchange))))
+
+(defun erc-d-exchange-rebind (dialog exchange key val &optional export)
+ "Modify a binding between renders.
+
+Bind symbol KEY to VAL, replacing whatever existed before, which may
+have been a function. A third, optional argument, if present and
+non-nil, results in the DIALOG's bindings for all EXCHANGEs adopting
+this binding. VAL can either be a function of the type described in
+`erc-d--render-entries' or any value acceptable as an argument to the
+function `concat'.
+
+DIALOG and EXCHANGE are the current `erc-d-dialog' and `erc-d-exchange'
+objects for the request context."
+ (when export
+ (setf (alist-get key (erc-d-dialog-vars dialog)) val))
+ (if (functionp val)
+ (setf (alist-get key (erc-d-exchange-bindings exchange))
+ (erc-d--wrap-func-val dialog exchange key val))
+ (setf (alist-get key (erc-d-exchange-rx-bindings exchange)) (list val)
+ (alist-get key (erc-d-exchange-bindings exchange)) val))
+ val)
+
+(defun erc-d-exchange-match (exchange match-number &optional tag)
+ "Return match portion of current or previous request.
+MATCH-NUMBER is the match group number. TAG, if provided, means the
+exchange tag (name) from some previously matched request."
+ (if tag
+ (pcase-let* ((dialog (erc-d-exchange-dialog exchange))
+ (`(,m-d . ,req) (plist-get (erc-d-dialog-history dialog)
+ tag)))
+ (set-match-data m-d)
+ (match-string match-number req))
+ (match-string match-number (erc-d-exchange-request exchange))))
+
+(defun erc-d-exchange-multi (dialog exchange key cmd &rest args)
+ "Call CMD with ARGS.
+This is a utility passed as the first argument to all template
+functions. DIALOG and EXCHANGE are pre-applied. A few pseudo
+commands, like `:request', are provided for convenience so that
+the caller's definition doesn't have to include this file. The
+rest are access and mutation utilities, such as `:set', which
+assigns KEY a new value, `:get-binding', which looks up KEY in
+`erc-d-exchange-bindings', and `:get-var', which looks up KEY in
+`erc-d-dialog-vars'."
+ (pcase cmd
+ (:set (apply #'erc-d-exchange-rebind dialog exchange key args))
+ (:reload (apply #'erc-d-exchange-reload dialog exchange args))
+ (:rebind (apply #'erc-d-exchange-rebind dialog exchange args))
+ (:match (apply #'erc-d-exchange-match exchange args))
+ (:request (erc-d-exchange-request exchange))
+ (:match-data (erc-d-exchange-match-data exchange))
+ (:dialog-name (erc-d-dialog-name dialog))
+ (:get-binding (cdr (assq (car args) (erc-d-exchange-bindings exchange))))
+ (:get-var (alist-get (car args) (erc-d-dialog-vars dialog)))))
+
+(defun erc-d--render-incoming-entry (exchange spec)
+ (let ((rx--local-definitions (rx--extend-local-defs
+ (erc-d-exchange-rx-bindings exchange))))
+ (rx-to-string `(: bos ,@(erc-d-spec-entry spec)) 'no-group)))
+
+(defun erc-d--render-outgoing-entry (exchange entry)
+ (let (out this)
+ (while (setq this (pop entry))
+ (set-match-data (erc-d-exchange-match-data exchange))
+ (unless (stringp this)
+ (cl-assert (symbolp this))
+ (setq this (or (alist-get this (erc-d-exchange-bindings exchange))
+ (symbol-value this)))
+ ;; Allow reference to overlong var name unbecoming of a template
+ (when this
+ (when (symbolp this) (setq this (symbol-value this)))
+ (when (functionp this) (setq this (save-match-data (funcall this))))
+ (unless (stringp this) (error "Unexpected token %S" this))))
+ (push this out))
+ (apply #'concat (nreverse out))))
+
+(defun erc-d--render-entries (exchange &optional yield-result)
+ "Act as an iterator producing rendered strings from EXCHANGE hunks.
+When an entry's CAR is an arbitrary symbol, yield that back first, and
+consider the entry an \"incoming\" entry. Then, regardless of the
+entry's type (incoming or outgoing), yield back the next element, which
+should be a number representing either a timeout (incoming) or a
+delay (outgoing). After that, yield a rendered template (outgoing) or a
+regular expression (incoming); both should be treated as immutable.
+
+When evaluating a template, bind the keys in the alist stored in the
+dialog's `vars' field to its values, but skip any self-quoters, like
+:foo. When an entry is incoming, replace occurrences of a key with its
+value, which can be any valid `rx' form (see Info node `(elisp)
+Extending Rx'). Do the same when an entry is outgoing, but expect a
+value's form to be (anything that evaluates to) something acceptable by
+`concat' or, alternatively, a function that returns a string or nil.
+
+Repeat the last two steps for the remaining entries, all of which are
+assumed to be outgoing. That is, continue yielding a timeout/delay and
+a rendered string for each entry, and yield nil when exhausted.
+
+Once again, for an incoming entry, the yielded string is a regexp to be
+matched against the raw request. For outgoing, it's the final response,
+ready to be sent out (after adding the appropriate line ending).
+
+To help with testing, bindings are not automatically created from
+DIALOG's \"vars\" alist when this function is invoked. But this can be
+forced by sending a non-nil YIELD-RESULT into the generator on the
+second \"next\" invocation of a given iteration. This clobbers any
+temporary bindings that don't exist in the DIALOG's `vars' alist, such
+as those added via `erc-d-exchange-rebind' (unless \"exported\").
+
+As noted earlier, template symbols can be bound to functions. When
+called during rendering, the match data from the current (matched)
+request is accessible by calling the function `match-data'.
+
+A function may ask for up to two required args, which are provided as
+needed. When applicable, the first required arg is a `funcall'-able
+helper that accepts various keyword-based commands, like :rebind, and a
+variable number of args. See `erc-d-exchange-multi' for details. When
+specified, the second required arg is the current `erc-d-exchange'
+object, which has among its members its owning `erc-d-dialog' object.
+This should suffice as a safety valve for any corner-case needs.
+Non-required args are ignored."
+ (let ((spec (erc-d-exchange-spec exchange))
+ (dialog (erc-d-exchange-dialog exchange))
+ (entries (erc-d-exchange-hunk exchange)))
+ (unless (erc-d-spec-entry spec)
+ (setf (erc-d-spec-entry spec) (erc-d-u--read-exchange entries)))
+ (catch 'yield
+ (while (erc-d-spec-entry spec)
+ (pcase (erc-d-spec-state spec)
+ (0 (cl-incf (erc-d-spec-state spec))
+ (throw 'yield (setf (erc-d-spec-head spec)
+ (pop (erc-d-spec-entry spec)))))
+ (1 (cl-incf (erc-d-spec-state spec))
+ (when yield-result
+ (erc-d-exchange-reload dialog exchange))
+ (unless (numberp (erc-d-spec-head spec))
+ (setf (erc-d-exchange-inspec exchange) (erc-d-spec-entry spec))
+ (throw 'yield
+ (prog1 (pop (erc-d-spec-entry spec))
+ (setf (erc-d-spec-entry spec)
+ (erc-d--render-incoming-entry exchange spec))))))
+ (2 (setf (erc-d-spec-state spec) 0)
+ (throw 'yield
+ (let ((entry (erc-d-spec-entry spec)))
+ (setf (erc-d-spec-entry spec) nil)
+ (if (stringp entry)
+ entry
+ (erc-d--render-outgoing-entry exchange entry))))))))))
+
+(defun erc-d--iter (exchange)
+ (apply-partially #'erc-d--render-entries exchange))
+
+(defun erc-d-on-match (dialog exchange)
+ "Handle matched exchange request.
+Allow the first handler in `erc-d-match-handlers' whose key matches TAG
+to manipulate replies before they're sent to the DIALOG peer."
+ (when-let* ((tag (erc-d-exchange-tag exchange))
+ (handler (plist-get (erc-d-dialog-match-handlers dialog) tag)))
+ (let ((md (erc-d-exchange-match-data exchange)))
+ (set-match-data md)
+ (funcall handler dialog exchange))))
+
+(defun erc-d--send-outgoing (dialog exchange)
+ "Send outgoing lines for EXCHANGE to DIALOG peer.
+Assume the next spec is outgoing. If its delay value is zero, render
+the template and send the resulting message straight away. Do the same
+when DELAY is negative, only arrange for its message to be sent (abs
+DELAY) seconds later, and then keep on processing. If DELAY is
+positive, pause processing and yield DELAY."
+ (let ((specs (erc-d--iter exchange))
+ (process (erc-d-dialog-process dialog))
+ (deferred (erc-d-exchange-deferred exchange))
+ delay)
+ ;; Could stash/pass thunk instead to ensure specs can't be mutated
+ ;; between calls (by temporarily replacing dialog member with a fugazi)
+ (when deferred
+ (erc-d--send process (funcall specs))
+ (setf deferred nil (erc-d-exchange-deferred exchange) deferred))
+ (while (and (not deferred) (setq delay (funcall specs)))
+ (cond ((zerop delay) (erc-d--send process (funcall specs)))
+ ((< delay 0) (push (run-at-time (- delay) nil #'erc-d--send
+ process (funcall specs))
+ (erc-d-dialog-timers dialog)))
+ ((setf deferred t (erc-d-exchange-deferred exchange) deferred))))
+ delay))
+
+(defun erc-d--add-dialog-linger (dialog exchange)
+ "Add finalizer for EXCHANGE in DIALOG."
+ (erc-d--m (erc-d-dialog-process dialog)
+ "Lingering for %.2f seconds" (erc-d-exchange-timeout exchange))
+ (let ((start (current-time)))
+ (setf (erc-d-dialog-finalizer dialog)
+ (lambda (&rest _)
+ (erc-d--m (erc-d-dialog-process dialog)
+ "Lingered for %.2f seconds"
+ (float-time (time-subtract (current-time) start)))
+ (erc-d--teardown-this-dialog-at-least dialog)))))
+
+(defun erc-d--add-dialog-drop (dialog exchange)
+ "Add finalizer for EXCHANGE in DIALOG."
+ (erc-d--m (erc-d-dialog-process dialog)
+ "Dropping in %.2f seconds" (erc-d-exchange-timeout exchange))
+ (setf (erc-d-dialog-finalizer dialog)
+ (lambda (&rest _)
+ (erc-d--m (erc-d-dialog-process dialog)
+ "Dropping %S" (erc-d-dialog-name dialog))
+ (erc-d--finalize-dialog dialog))))
+
+(defun erc-d--create-exchange (dialog hunk)
+ "Initialize next exchange HUNK for DIALOG."
+ (let* ((spec (make-erc-d-spec))
+ (exchange (make-erc-d-exchange :dialog dialog :hunk hunk :spec spec))
+ (specs (erc-d--iter exchange)))
+ (setf (erc-d-exchange-tag exchange) (funcall specs)
+ (erc-d-exchange-timeout exchange) (funcall specs t)
+ (erc-d-exchange-pattern exchange) (funcall specs))
+ (cond ((erc-d--linger-p exchange)
+ (erc-d--add-dialog-linger dialog exchange))
+ ((erc-d--drop-p exchange)
+ (erc-d--add-dialog-drop dialog exchange)))
+ (setf (erc-d-exchange-timer exchange)
+ (run-at-time (erc-d-exchange-timeout exchange)
+ nil #'erc-d--expire dialog exchange))
+ exchange))
+
+(defun erc-d--command-consider-prep-fail (dialog line exes)
+ (list 'error "Match failed: %S %S" line
+ (list :exes (mapcar #'erc-d-exchange-pattern
+ (ring-elements exes))
+ :dialog (erc-d-dialog-name dialog))))
+
+(defun erc-d--command-consider-prep-success (dialog line exes matched)
+ (setf (erc-d-exchange-request matched) line
+ (erc-d-exchange-match-data matched) (match-data)
+ ;; Also add current to match history, indexed by exchange tag
+ (plist-get (erc-d-dialog-history dialog)
+ (erc-d-exchange-tag matched))
+ (cons (match-data) line)) ; do we need to make a copy of this?
+ (cancel-timer (erc-d-exchange-timer matched))
+ (ring-remove exes (ring-member exes matched)))
+
+(cl-defun erc-d--command-consider (dialog)
+ "Maybe return next matched exchange for DIALOG.
+Upon encountering a mismatch, return an error of the form (ERROR-SYMBOL
+DATA). But when only fuzzies remain in the exchange pool, return nil."
+ (let* ((parsed (erc-d-dialog-message dialog))
+ (line (erc-d-i-message.unparsed parsed))
+ (exes (erc-d-dialog-exchanges dialog))
+ ;;
+ matched)
+ (let ((elts (ring-elements exes)))
+ (while (and (setq matched (pop elts))
+ (not (string-match (erc-d-exchange-pattern matched) line)))
+ (if (and (not elts) (erc-d--fuzzy-p matched))
+ ;; Nothing to do, so advance
+ (cl-return-from erc-d--command-consider nil)
+ (cl-assert (or (not elts) (erc-d--fuzzy-p matched))))))
+ (if matched
+ (erc-d--command-consider-prep-success dialog line exes matched)
+ (erc-d--command-consider-prep-fail dialog line exes))))
+
+(defun erc-d--active-ex-p (ring)
+ "Return non-nil when RING has a non-fuzzy exchange.
+That is, return nil when RING is empty or when it only has exchanges
+with leading-tilde tags."
+ (let ((i 0)
+ (len (ring-length ring))
+ ex found)
+ (while (and (not found) (< i len))
+ (unless (erc-d--fuzzy-p (setq ex (ring-ref ring i)))
+ (setq found ex))
+ (cl-incf i))
+ found))
+
+(defun erc-d--finalize-done (dialog)
+ ;; Linger logic for individual dialogs is handled elsewhere
+ (if-let ((finalizer (erc-d-dialog-finalizer dialog)))
+ (funcall finalizer dialog)
+ (let ((d (process-get (erc-d-dialog-process dialog) :dialog-linger-secs)))
+ (push (run-at-time d nil #'erc-d--teardown)
+ (erc-d-dialog-timers dialog)))))
+
+(defun erc-d--advance-or-die (dialog)
+ "Govern the lifetime of DIALOG.
+Replenish exchanges from reader and insert them into the pool of
+expected matches, as produced. Return a symbol indicating session
+status: deferring, matching, depleted, or done."
+ (let ((exes (erc-d-dialog-exchanges dialog))
+ hunk)
+ (cond ((erc-d--active-ex-p exes) 'deferring)
+ ((setq hunk (erc-d-u--read-dialog (erc-d-dialog-hunks dialog)))
+ (let ((exchange (erc-d--create-exchange dialog hunk)))
+ (if (erc-d--fuzzy-p exchange)
+ (ring-insert exes exchange)
+ (ring-insert-at-beginning exes exchange)))
+ 'matching)
+ ((not (ring-empty-p exes)) 'depleted)
+ (t 'done))))
+
+(defun erc-d--command-meter-replies (dialog exchange &optional cmd)
+ "Ignore requests until all replies have been sent.
+Do this for some previously matched EXCHANGE in DIALOG based on CMD, a
+symbol. As a side effect, maybe schedule the resumption of the main
+loop after some delay."
+ (let (delay)
+ (if (or (not cmd) (eq 'resume cmd))
+ (when (setq delay (erc-d--send-outgoing dialog exchange))
+ (push (run-at-time delay nil #'erc-d--command-handle-all
+ dialog 'resume)
+ (erc-d-dialog-timers dialog))
+ (erc-d-dialog-state dialog))
+ (setf (erc-d-dialog-state dialog) 'sending))))
+
+(defun erc-d--die-unexpected (dialog)
+ (erc-d--teardown 'error "Received unexpected input: %S"
+ (erc-d-i-message.unparsed (erc-d-dialog-message dialog))))
+
+(defun erc-d--command-refresh (dialog matched)
+ (let ((state (erc-d--advance-or-die dialog)))
+ (when (eq state 'done)
+ (erc-d--finalize-done dialog))
+ (unless matched
+ (when (eq state 'depleted)
+ (erc-d--die-unexpected dialog))
+ (cl-assert (memq state '(matching depleted)) t))
+ (setf (erc-d-dialog-state dialog) state)))
+
+(defun erc-d--command-handle-all (dialog cmd)
+ "Create handler to act as control agent and process DIALOG requests.
+Have it ingest internal control commands (lowercase symbols) and yield
+back others indicating the lifecycle stage of the current dialog."
+ (let ((matched (erc-d-dialog-matched dialog)))
+ (cond
+ (matched
+ (or (erc-d--command-meter-replies dialog matched cmd)
+ (setf (erc-d-dialog-matched dialog) nil)
+ (erc-d--command-refresh dialog t)))
+ ((pcase cmd ; FIXME remove command facility or make extensible
+ ('resume nil)
+ ('eof (erc-d--m (erc-d-dialog-process dialog) "Received an EOF") nil)))
+ (t ; matching
+ (setq matched nil)
+ (catch 'yield
+ (while (not matched)
+ (when (ring-empty-p (erc-d-dialog-exchanges dialog))
+ (erc-d--die-unexpected dialog))
+ (when (setq matched (erc-d--command-consider dialog))
+ (if (eq (car-safe matched) 'error)
+ (apply #'erc-d--teardown matched)
+ (erc-d-on-match dialog matched)
+ (setf (erc-d-dialog-matched dialog) matched)
+ (if-let ((s (erc-d--command-meter-replies dialog matched nil)))
+ (throw 'yield s)
+ (setf (erc-d-dialog-matched dialog) nil))))
+ (erc-d--command-refresh dialog matched)))))))
+
+;;;; Handlers for IRC commands
+
+(cl-defgeneric erc-d-command (dialog cmd)
+ "Handle new CMD from client for DIALOG.
+By default, defer to this dialog's `erc-d--command-handle-all' instance,
+which is stored in its `handler' field.")
+
+(cl-defmethod erc-d-command ((dialog erc-d-dialog) cmd)
+ (when (eq 'sending (erc-d--command-handle-all dialog cmd))
+ (ring-insert-at-beginning (erc-d-dialog-queue dialog)
+ (erc-d-dialog-message dialog))))
+
+;; A similar PONG handler would be useless because we know when to
+;; expect them
+
+(cl-defmethod erc-d-command ((dialog erc-d-dialog) (_cmd (eql PING))
+ &context (erc-d-auto-pong (eql t)))
+ "Respond to PING request from DIALOG peer when ERC-D-AUTO-PONG is t."
+ (let* ((parsed (erc-d-dialog-message dialog))
+ (process (erc-d-dialog-process dialog))
+ (nonce (car (erc-d-i-message.command-args parsed)))
+ (fqdn (erc-d-dialog-server-fqdn dialog)))
+ (erc-d--send process (format ":%s PONG %s :%s" fqdn fqdn nonce))))
+
+
+;;;; Entry points
+
+(defun erc-d-run (host service &optional server-name &rest dialogs)
+ "Start serving DIALOGS on HOST at SERVICE.
+Pass HOST and SERVICE directly to `make-network-process'. When present,
+use string SERVER-NAME for the server-process name as well as that of
+its buffer (w. surrounding asterisks). When absent, do the same with
+`erc-d-server-name'. When running \"in process,\" return the server
+process, otherwise sleep for the duration of the server process.
+
+A dialog must be a symbol matching the base name of a dialog file in
+`erc-d-u-canned-dialog-dir'.
+
+The variable `erc-d-tmpl-vars' determines the common members of the
+`erc-d--render-entries' ENTRIES param. Variables `erc-d-server-fqdn'
+and `erc-d-linger-secs' determine the `erc-d-dialog' items
+`:server-fqdn' and `:linger-secs' for all client processes.
+
+The variable `erc-d-tmpl-vars' can be used to initialize the
+process's `erc-d-dialog' vars item."
+ (when (and server-name (symbolp server-name))
+ (push server-name dialogs)
+ (setq server-name nil))
+ (let (loaded)
+ (dolist (dialog (nreverse dialogs))
+ (let ((reader (erc-d-u--canned-load-dialog dialog)))
+ (when erc-d--slow-mo
+ (setq reader (erc-d-u--rewrite-for-slow-mo erc-d--slow-mo reader)))
+ (push (cons (erc-d-u--normalize-canned-name dialog) reader) loaded)))
+ (setq dialogs loaded))
+ (erc-d--start host service (or server-name erc-d-server-name)
+ :dialog-dialogs dialogs
+ :dialog-vars erc-d-tmpl-vars
+ :dialog-linger-secs erc-d-linger-secs
+ :dialog-server-fqdn erc-d-server-fqdn
+ :dialog-match-handlers (erc-d-u--unkeyword
+ erc-d-match-handlers)))
+
+(defun erc-d-serve ()
+ "Start serving canned dialogs from the command line.
+Although not autoloaded, this function is meant to be summoned via the
+Emacs -f flag while starting a batch session. It prints incoming and
+outgoing messages to standard out.
+
+The main options are --host HOST and --port PORT, which default to
+localhost and auto, respectively. The args are the dialogs to run.
+Unlike with `erc-d-run', dialogs here *must* be files, meaning Lisp-Data
+files adhering to the required format. (These consist of \"specs\"
+detailing timing and template info; see commentary for specifics.)
+
+An optional --add-time N option can also be passed to hike up timeouts
+by some number of seconds N. For example, you might run:
+
+ $ emacs -Q -batch -L . \\
+ > -l erc-d.el \\
+ > -f erc-d-serve \\
+ > --host 192.168.124.1 \\
+ > --port 16667 \\
+ > --add-time 10 \\
+ > ./my-dialog.eld
+
+from a Makefile or manually with \\<global-map>\\[compile]. And then in
+another terminal, do:
+
+ $ nc -C 192.168.124.1 16667 ; or telnet if your nc doesn't have -C
+ > PASS changeme
+ ...
+
+Use `erc-d-run' instead to start the server from within Emacs."
+ (unless noninteractive
+ (error "Command-line func erc-d-serve not run in -batch session"))
+ (setq erc-d--in-process nil)
+ (let (port host dialogs erc-d--slow-mo)
+ (while command-line-args-left
+ (pcase (pop command-line-args-left)
+ ("--add-time" (setq erc-d--slow-mo
+ (string-to-number (pop command-line-args-left))))
+ ("--linger" (setq erc-d-linger-secs
+ (string-to-number (pop command-line-args-left))))
+ ("--host" (setq host (pop command-line-args-left)))
+ ("--port" (setq port (string-to-number (pop command-line-args-left))))
+ (dialog (push dialog dialogs))))
+ (setq dialogs (mapcar #'erc-d-u--massage-canned-name dialogs))
+ (when erc-d--slow-mo
+ (message "Slow mo is ON"))
+ (apply #'erc-d-run (or host "localhost") port nil (nreverse dialogs))))
+
+(provide 'erc-d)
+
+;;; erc-d.el ends here
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :tester")
+ (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0 ":irc.example.org 002 tester :Your host is irc.example.org")
+ (0 ":irc.example.org 003 tester :This server was created just now")
+ (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ ;; Just to mix thing's up (force handler to schedule timer)
+ (0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0 ":irc.example.org 254 tester 1 :channels formed")
+ (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
+ (0.1 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 5 "MODE tester +i")
+ (0 ":irc.example.org 221 tester +Zi")
+ (0 ":irc.example.org 306 tester :You have been marked as being away")
+ (0 ":tester!~tester@localhost JOIN #chan")
+ (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 366 alice #chan :End of NAMES list"))
+
+;; Some comment (to prevent regression)
+((mode-chan 1.2 "MODE #chan")
+ (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS :changeme"))
+
+((~fake 3.2 "FAKE ")
+ (0.1 ":irc.example.org FAKE irc.example.com :ok"))
+
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :tester")
+ (0 ":irc.example.org 001 tester :Welcome to the Internet tester")
+ (0 ":irc.example.org 422 tester :MOTD File is missing"))
--- /dev/null
+;; -*- mode: lisp-data; -*-
+((pass 1 "PASS " (? ?:) "a")
+ (0 "hi"))
+((drop 0.01 DROP))
--- /dev/null
+;; -*- mode: lisp-data; -*-
+((pass 1 "PASS " (? ?:) "b")
+ (0 "hi"))
+((linger 1 LINGER))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+((fake 0 "FAKE noop"))
+
+((nick 1.2 "NICK tester"))
+
+((user 2.2 "USER user 0 * :tester")
+ (0. ":irc.barnet.org 001 tester :Welcome to the BAR Network tester")
+ (0. ":irc.barnet.org 002 tester :Your host is irc.barnet.org")
+ (0. ":irc.barnet.org 003 tester :This server was created just now")
+ (0. ":irc.barnet.org 004 tester irc.barnet.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0. ":irc.barnet.org 005 tester MODES NETWORK=BarNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
+ (0. ":irc.barnet.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0. ":irc.barnet.org 252 tester 0 :IRC Operators online")
+ (0. ":irc.barnet.org 253 tester 0 :unregistered connections")
+ (0. ":irc.barnet.org 254 tester 1 :channels formed")
+ (0. ":irc.barnet.org 255 tester :I have 3 clients and 0 servers")
+ (0. ":irc.barnet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0. ":irc.barnet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0. ":irc.barnet.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0. ":irc.barnet.org 221 tester +Zi")
+ (0. ":irc.barnet.org 306 tester :You have been marked as being away")
+ (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
+ (0 ":irc.barnet.org 353 joe = #chan :+joe!~joe@example.com @%+mike!~mike@example.org")
+ (0 ":irc.barnet.org 366 joe #chan :End of NAMES list"))
+
+((mode 1 "MODE #chan")
+ (0 ":irc.barnet.org 324 tester #chan +nt")
+ (0 ":irc.barnet.org 329 tester #chan 1620805269")
+ (0.1 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: Yes, a dozen; and as many to the vantage, as would store the world they played for.")
+ (0.05 ":mike!~u@awyxgybtkx7uq.irc PRIVMSG #chan :joe: As he regards his aged father's life.")
+ (0.05 ":joe!~u@awyxgybtkx7uq.irc PRIVMSG #chan :mike: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonour in doing it."))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((nick 1.2 "NICK tester"))
+
+((user 2.2 "USER user 0 * :tester")
+ (0. ":irc.foonet.org 001 tester :Welcome to the FOO Network tester")
+ (0. ":irc.foonet.org 002 tester :Your host is irc.foonet.org")
+ (0. ":irc.foonet.org 003 tester :This server was created just now")
+ (0. ":irc.foonet.org 004 tester irc.foonet.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0. ":irc.foonet.org 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
+ (0. ":irc.foonet.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0. ":irc.foonet.org 252 tester 0 :IRC Operators online")
+ (0. ":irc.foonet.org 253 tester 0 :unregistered connections")
+ (0. ":irc.foonet.org 254 tester 1 :channels formed")
+ (0. ":irc.foonet.org 255 tester :I have 3 clients and 0 servers")
+ (0. ":irc.foonet.org 265 tester 3 3 :Current local users 3, max 3")
+ (0. ":irc.foonet.org 266 tester 3 3 :Current global users 3, max 3")
+ (0. ":irc.foonet.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0. ":irc.foonet.org 221 tester +Zi")
+ (0. ":irc.foonet.org 306 tester :You have been marked as being away")
+ (0 ":tester!~u@awyxgybtkx7uq.irc JOIN #chan")
+ (0 ":irc.foonet.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.foonet.org 366 alice #chan :End of NAMES list"))
+
+((mode 2 "MODE #chan")
+ (0 ":irc.foonet.org 324 tester #chan +nt")
+ (0 ":irc.foonet.org 329 tester #chan 1620805269")
+ (0.1 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: Yes, a dozen; and as many to the vantage, as would store the world they played for.")
+ (0.05 ":bob!~u@awyxgybtkx7uq.irc PRIVMSG #chan :alice: As he regards his aged father's life.")
+ (0.05 ":alice!~u@awyxgybtkx7uq.irc PRIVMSG #chan :bob: It is a rupture that you may easily heal; and the cure of it not only saves your brother, but keeps you from dishonour in doing it."))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+((pass 10.0 "PASS " (? ?:) token ":changeme"))
+
+((fake 0 "FAKE"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 2.2 "NICK tester"))
+
+((user 2.2 "USER " user " " (ignored digit "*") " :" realname)
+ (0.0 ":" dom " 001 " nick " :Welcome to the Internet Relay Network tester")
+ (0.0 ":" dom " 002 " nick " :Your host is " dom)
+ (0.0 ":" dom " 003 " nick " :This server was created just now")
+ (0.0 ":" dom " 004 " nick " " dom " BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0.0 ":" dom " 005 " nick " MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0.0 ":" dom " 251 " nick " :There are 3 users and 0 invisible on 1 server(s)")
+ (0.0 ":" dom " 252 " nick " 0 :IRC Operators online")
+ (0.0 ":" dom " 253 " nick " 0 :unregistered connections")
+ (0.0 ":" dom " 254 " nick " 1 :channels formed")
+ (0.0 ":" dom " 255 " nick " :I have 3 clients and 0 servers")
+ (0.0 ":" dom " 265 " nick " 3 3 :Current local users 3, max 3")
+ (0.0 ":" dom " 266 " nick " 3 3 :Current global users 3, max 3")
+ (0.0 ":" dom " 422 " nick " :MOTD File is missing"))
+
+((mode-user 2.2 "MODE tester +i")
+ (0.0 ":" dom " 221 " nick " +Zi")
+
+ (0.0 ":" dom " 306 " nick " :You have been marked as being away")
+ (0.0 ":" nick "!~" nick "@localhost JOIN #chan")
+ (0.0 ":" dom " 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0.0 ":" dom " 366 alice #chan :End of NAMES list"))
+
+((mode 2.2 "MODE #chan")
+ (0.1 ":bob!~bob@example.org PRIVMSG #chan :" nick ": hey"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :tester")
+ (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0 ":irc.example.org 002 tester :Your host is irc.example.org")
+ (0 ":irc.example.org 003 tester :This server was created just now")
+ (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ ;; Just to mix thing's up (force handler to schedule timer)
+ (0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0 ":irc.example.org 254 tester 1 :channels formed")
+ (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0 ":irc.example.org 221 tester +Zi")
+ (0 ":irc.example.org 306 tester :You have been marked as being away")
+ (0 ":tester!~tester@localhost JOIN #chan")
+ (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 366 alice #chan :End of NAMES list"))
+
+((mode-chan 1.2 "MODE #chan")
+ (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
+
+((eof 1.0 EOF))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.5 "USER user 0 * :tester")
+ (0.0 "@time=" now " :irc.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0.0 "@time=" now " :irc.org 002 tester :Your host is irc.org")
+ (0.0 "@time=" now " :irc.org 003 tester :This server was created just now")
+ (0.0 "@time=" now " :irc.org 004 tester irc.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0.0 "@time=" now " :irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+ :are supported by this server")
+ (0.0 "@time=" now " :irc.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0.0 "@time=" now " :irc.org 252 tester 0 :IRC Operators online")
+ (0.0 "@time=" now " :irc.org 253 tester 0 :unregistered connections")
+ (0.0 "@time=" now " :irc.org 254 tester 1 :channels formed")
+ (0.0 "@time=" now " :irc.org 255 tester :I have 3 clients and 0 servers")
+ (0.0 "@time=" now " :irc.org 265 tester 3 3 :Current local users 3, max 3")
+ (0.0 "@time=" now " :irc.org 266 tester 3 3 :Current global users 3, max 3")
+ (0.0 "@time=" now " :irc.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0.0 "@time=" now " :irc.org 221 tester +Zi")
+ (0.0 "@time=" now " :irc.org 306 tester :You have been marked as being away"))
+
+((~join-foo 3.2 "JOIN #foo")
+ (0 "@time=" now " :tester!~tester@localhost JOIN #foo")
+ (0 "@time=" now " :irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 "@time=" now " :irc.example.org 366 alice #foo :End of NAMES list"))
+
+((~join-bar 1.2 "JOIN #bar")
+ (0 "@time=" now " :tester!~tester@localhost JOIN #bar")
+ (0 "@time=" now " :irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 "@time=" now " :irc.example.org 366 alice #bar :End of NAMES list"))
+
+((~mode-foo 3.2 "MODE #foo")
+ (0.0 "@time=" now " :irc.example.org 324 tester #foo +Cint")
+ (0.0 "@time=" now " :irc.example.org 329 tester #foo 1519850102")
+ (0.1 "@time=" now " :bob!~bob@example.org PRIVMSG #foo :hey"))
+
+((mode-bar 10.2 "MODE #bar")
+ (0.0 "@time=" now " :irc.example.org 324 tester #bar +HMfnrt 50:5h :10:5")
+ (0.0 "@time=" now " :irc.example.org 329 tester #bar :1602642829")
+ (0.1 "@time=" now " :alice!~alice@example.com PRIVMSG #bar :hi"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :tester")
+ (0.0 ":irc.foo.net 001 tester :Welcome to the Internet Relay Network tester")
+ (0.0 ":irc.foo.net 002 tester :Your host is irc.foo.net")
+ (0.0 ":irc.foo.net 003 tester :This server was created just now")
+ (0.0 ":irc.foo.net 004 tester irc.foo.net BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0.0 ":irc.foo.net 005 tester MODES NETWORK=FooNet NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0.0 ":irc.foo.net 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0.0 ":irc.foo.net 252 tester 0 :IRC Operators online")
+ (0.0 ":irc.foo.net 253 tester 0 :unregistered connections")
+ (0.0 ":irc.foo.net 254 tester 1 :channels formed")
+ (0.0 ":irc.foo.net 255 tester :I have 3 clients and 0 servers")
+ (0.0 ":irc.foo.net 265 tester 3 3 :Current local users 3, max 3")
+ (0.0 ":irc.foo.net 266 tester 3 3 :Current global users 3, max 3")
+ (0.0 ":irc.foo.net 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0.0 ":irc.foo.net 221 tester +Zi")
+ (0.0 ":irc.foo.net 306 tester :You have been marked as being away"))
+
+((join 3 "JOIN #foo")
+ (0 ":tester!~tester@localhost JOIN #foo")
+ (0 ":irc.foo.net 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.foo.net 366 alice #foo :End of NAMES list"))
+
+((mode 3 "MODE #foo")
+ (0.0 ":irc.foo.net 324 tester #foo +Cint")
+ (0.0 ":irc.foo.net 329 tester #foo 1519850102")
+ (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: But, in defence, by mercy, 'tis most just.")
+ (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: Grows, lives, and dies, in single blessedness.")
+ (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :Look for me.")
+ (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.")
+ (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: That I must love a loathed enemy.")
+ (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: As't please your lordship: I'll leave you.")
+ (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: Then there is no true lover in the forest; else sighing every minute and groaning every hour would detect the lazy foot of Time as well as a clock.")
+ (0.1 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: His discretion, I am sure, cannot carry his valour, for the goose carries not the fox. It is well: leave it to his discretion, and let us listen to the moon.")
+ (0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :Done"))
+
+((hi 10 "PRIVMSG #foo :Hi"))
--- /dev/null
+;;; -*- mode: lisp-data; -*-
+
+;; https://github.com/DanielOaks/irc-parser-tests
+((mask-match
+ (tests
+ ((mask . "*@127.0.0.1")
+ (matches "coolguy!ab@127.0.0.1" "cooldud3!~bc@127.0.0.1")
+ (fails "coolguy!ab@127.0.0.5" "cooldud3!~d@124.0.0.1"))
+ ((mask . "cool*@*")
+ (matches "coolguy!ab@127.0.0.1" "cooldud3!~bc@127.0.0.1" "cool132!ab@example.com")
+ (fails "koolguy!ab@127.0.0.5" "cooodud3!~d@124.0.0.1"))
+ ((mask . "cool!*@*")
+ (matches "cool!guyab@127.0.0.1" "cool!~dudebc@127.0.0.1" "cool!312ab@example.com")
+ (fails "coolguy!ab@127.0.0.1" "cooldud3!~bc@127.0.0.1" "koolguy!ab@127.0.0.5" "cooodud3!~d@124.0.0.1"))
+ ((mask . "cool!?username@*")
+ (matches "cool!ausername@127.0.0.1" "cool!~username@127.0.0.1")
+ (fails "cool!username@127.0.0.1"))
+ ((mask . "cool!a?*@*")
+ (matches "cool!ab@127.0.0.1" "cool!abc@127.0.0.1")
+ (fails "cool!a@127.0.0.1"))
+ ((mask . "cool[guy]!*@*")
+ (matches "cool[guy]!guy@127.0.0.1" "cool[guy]!a@example.com")
+ (fails "coolg!ab@127.0.0.1" "cool[!ac@127.0.1.1"))))
+ (msg-join
+ (tests
+ ((desc . "Simple test with verb and params.")
+ (atoms
+ (verb . "foo")
+ (params "bar" "baz" "asdf"))
+ (matches "foo bar baz asdf" "foo bar baz :asdf"))
+ ((desc . "Simple test with source and no params.")
+ (atoms
+ (source . "src")
+ (verb . "AWAY"))
+ (matches ":src AWAY"))
+ ((desc . "Simple test with source and empty trailing param.")
+ (atoms
+ (source . "src")
+ (verb . "AWAY")
+ (params ""))
+ (matches ":src AWAY :"))
+ ((desc . "Simple test with source.")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" "asdf"))
+ (matches ":coolguy foo bar baz asdf" ":coolguy foo bar baz :asdf"))
+ ((desc . "Simple test with trailing param.")
+ (atoms
+ (verb . "foo")
+ (params "bar" "baz" "asdf quux"))
+ (matches "foo bar baz :asdf quux"))
+ ((desc . "Simple test with empty trailing param.")
+ (atoms
+ (verb . "foo")
+ (params "bar" "baz" ""))
+ (matches "foo bar baz :"))
+ ((desc . "Simple test with trailing param containing colon.")
+ (atoms
+ (verb . "foo")
+ (params "bar" "baz" ":asdf"))
+ (matches "foo bar baz ::asdf"))
+ ((desc . "Test with source and trailing param.")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" "asdf quux"))
+ (matches ":coolguy foo bar baz :asdf quux"))
+ ((desc . "Test with trailing containing beginning+end whitespace.")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" " asdf quux "))
+ (matches ":coolguy foo bar baz : asdf quux "))
+ ((desc . "Test with trailing containing what looks like another trailing param.")
+ (atoms
+ (source . "coolguy")
+ (verb . "PRIVMSG")
+ (params "bar" "lol :) "))
+ (matches ":coolguy PRIVMSG bar :lol :) "))
+ ((desc . "Simple test with source and empty trailing.")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" ""))
+ (matches ":coolguy foo bar baz :"))
+ ((desc . "Trailing contains only spaces.")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" " "))
+ (matches ":coolguy foo bar baz : "))
+ ((desc . "Param containing tab (tab is not considered SPACE for message splitting).")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "b ar" "baz"))
+ (matches ":coolguy foo b ar baz" ":coolguy foo b ar :baz"))
+ ((desc . "Tag with no value and space-filled trailing.")
+ (atoms
+ (tags
+ (asd . ""))
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" " "))
+ (matches "@asd :coolguy foo bar baz : "))
+ ((desc . "Tags with escaped values.")
+ (atoms
+ (verb . "foo")
+ (tags
+ (a . "b\\and\nk")
+ (d . "gh;764")))
+ (matches "@a=b\\\\and\\nk;d=gh\\:764 foo" "@d=gh\\:764;a=b\\\\and\\nk foo"))
+ ((desc . "Tags with escaped values and params.")
+ (atoms
+ (verb . "foo")
+ (tags
+ (a . "b\\and\nk")
+ (d . "gh;764"))
+ (params "par1" "par2"))
+ (matches "@a=b\\\\and\\nk;d=gh\\:764 foo par1 par2" "@a=b\\\\and\\nk;d=gh\\:764 foo par1 :par2" "@d=gh\\:764;a=b\\\\and\\nk foo par1 par2" "@d=gh\\:764;a=b\\\\and\\nk foo par1 :par2"))
+ ((desc . "Tag with long, strange values (including LF and newline).")
+ (atoms
+ (tags
+ (foo . "\\\\;\\s \r\n"))
+ (verb . "COMMAND"))
+ (matches "@foo=\\\\\\\\\\:\\\\s\\s\\r\\n COMMAND"))))
+ (msg-split
+ (tests
+ ((input . "foo bar baz asdf")
+ (atoms
+ (verb . "foo")
+ (params "bar" "baz" "asdf")))
+ ((input . ":coolguy foo bar baz asdf")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" "asdf")))
+ ((input . "foo bar baz :asdf quux")
+ (atoms
+ (verb . "foo")
+ (params "bar" "baz" "asdf quux")))
+ ((input . "foo bar baz :")
+ (atoms
+ (verb . "foo")
+ (params "bar" "baz" "")))
+ ((input . "foo bar baz ::asdf")
+ (atoms
+ (verb . "foo")
+ (params "bar" "baz" ":asdf")))
+ ((input . ":coolguy foo bar baz :asdf quux")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" "asdf quux")))
+ ((input . ":coolguy foo bar baz : asdf quux ")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" " asdf quux ")))
+ ((input . ":coolguy PRIVMSG bar :lol :) ")
+ (atoms
+ (source . "coolguy")
+ (verb . "PRIVMSG")
+ (params "bar" "lol :) ")))
+ ((input . ":coolguy foo bar baz :")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" "")))
+ ((input . ":coolguy foo bar baz : ")
+ (atoms
+ (source . "coolguy")
+ (verb . "foo")
+ (params "bar" "baz" " ")))
+ ((input . "@a=b;c=32;k;rt=ql7 foo")
+ (atoms
+ (verb . "foo")
+ (tags
+ (a . "b")
+ (c . "32")
+ (k . "")
+ (rt . "ql7"))))
+ ((input . "@a=b\\\\and\\nk;c=72\\s45;d=gh\\:764 foo")
+ (atoms
+ (verb . "foo")
+ (tags
+ (a . "b\\and\nk")
+ (c . "72 45")
+ (d . "gh;764"))))
+ ((input . "@c;h=;a=b :quux ab cd")
+ (atoms
+ (tags
+ (c . "")
+ (h . "")
+ (a . "b"))
+ (source . "quux")
+ (verb . "ab")
+ (params "cd")))
+ ((input . ":src JOIN #chan")
+ (atoms
+ (source . "src")
+ (verb . "JOIN")
+ (params "#chan")))
+ ((input . ":src JOIN :#chan")
+ (atoms
+ (source . "src")
+ (verb . "JOIN")
+ (params "#chan")))
+ ((input . ":src AWAY")
+ (atoms
+ (source . "src")
+ (verb . "AWAY")))
+ ((input . ":src AWAY ")
+ (atoms
+ (source . "src")
+ (verb . "AWAY")))
+ ((input . ":cool guy foo bar baz")
+ (atoms
+ (source . "cool guy")
+ (verb . "foo")
+ (params "bar" "baz")))
+ ((input . ":coolguy!ag@net\ 35w\ 3ork.admin PRIVMSG foo :bar baz")
+ (atoms
+ (source . "coolguy!ag@net\ 35w\ 3ork.admin")
+ (verb . "PRIVMSG")
+ (params "foo" "bar baz")))
+ ((input . ":coolguy!~ag@n\ 2et\ 305w\ fork.admin PRIVMSG foo :bar baz")
+ (atoms
+ (source . "coolguy!~ag@n\ 2et\ 305w\ fork.admin")
+ (verb . "PRIVMSG")
+ (params "foo" "bar baz")))
+ ((input . "@tag1=value1;tag2;vendor1/tag3=value2;vendor2/tag4= :irc.example.com COMMAND param1 param2 :param3 param3")
+ (atoms
+ (tags
+ (tag1 . "value1")
+ (tag2 . "")
+ (vendor1/tag3 . "value2")
+ (vendor2/tag4 . ""))
+ (source . "irc.example.com")
+ (verb . "COMMAND")
+ (params "param1" "param2" "param3 param3")))
+ ((input . ":irc.example.com COMMAND param1 param2 :param3 param3")
+ (atoms
+ (source . "irc.example.com")
+ (verb . "COMMAND")
+ (params "param1" "param2" "param3 param3")))
+ ((input . "@tag1=value1;tag2;vendor1/tag3=value2;vendor2/tag4 COMMAND param1 param2 :param3 param3")
+ (atoms
+ (tags
+ (tag1 . "value1")
+ (tag2 . "")
+ (vendor1/tag3 . "value2")
+ (vendor2/tag4 . ""))
+ (verb . "COMMAND")
+ (params "param1" "param2" "param3 param3")))
+ ((input . "COMMAND")
+ (atoms
+ (verb . "COMMAND")))
+ ((input . "@foo=\\\\\\\\\\:\\\\s\\s\\r\\n COMMAND")
+ (atoms
+ (tags
+ (foo . "\\\\;\\s \r\n"))
+ (verb . "COMMAND")))
+ ((input . ":gravel.mozilla.org 432 #momo :Erroneous Nickname: Illegal characters")
+ (atoms
+ (source . "gravel.mozilla.org")
+ (verb . "432")
+ (params "#momo" "Erroneous Nickname: Illegal characters")))
+ ((input . ":gravel.mozilla.org MODE #tckk +n ")
+ (atoms
+ (source . "gravel.mozilla.org")
+ (verb . "MODE")
+ (params "#tckk" "+n")))
+ ((input . ":services.esper.net MODE #foo-bar +o foobar ")
+ (atoms
+ (source . "services.esper.net")
+ (verb . "MODE")
+ (params "#foo-bar" "+o" "foobar")))
+ ((input . "@tag1=value\\\\ntest COMMAND")
+ (atoms
+ (tags
+ (tag1 . "value\\ntest"))
+ (verb . "COMMAND")))
+ ((input . "@tag1=value\\1 COMMAND")
+ (atoms
+ (tags
+ (tag1 . "value1"))
+ (verb . "COMMAND")))
+ ((input . "@tag1=value1\\ COMMAND")
+ (atoms
+ (tags
+ (tag1 . "value1"))
+ (verb . "COMMAND")))
+ ((input . "@tag1=1;tag2=3;tag3=4;tag1=5 COMMAND")
+ (atoms
+ (tags
+ (tag1 . "5")
+ (tag2 . "3")
+ (tag3 . "4"))
+ (verb . "COMMAND")))
+ ((input . "@tag1=1;tag2=3;tag3=4;tag1=5;vendor/tag2=8 COMMAND")
+ (atoms
+ (tags
+ (tag1 . "5")
+ (tag2 . "3")
+ (tag3 . "4")
+ (vendor/tag2 . "8"))
+ (verb . "COMMAND")))
+ ((input . ":SomeOp MODE #channel :+i")
+ (atoms
+ (source . "SomeOp")
+ (verb . "MODE")
+ (params "#channel" "+i")))
+ ((input . ":SomeOp MODE #channel +oo SomeUser :AnotherUser")
+ (atoms
+ (source . "SomeOp")
+ (verb . "MODE")
+ (params "#channel" "+oo" "SomeUser" "AnotherUser")))))
+ (userhost-split
+ (tests
+ ((source . "coolguy")
+ (atoms
+ (nick . "coolguy")))
+ ((source . "coolguy!ag@127.0.0.1")
+ (atoms
+ (nick . "coolguy")
+ (user . "ag")
+ (host . "127.0.0.1")))
+ ((source . "coolguy!~ag@localhost")
+ (atoms
+ (nick . "coolguy")
+ (user . "~ag")
+ (host . "localhost")))
+ ((source . "coolguy@127.0.0.1")
+ (atoms
+ (nick . "coolguy")
+ (host . "127.0.0.1")))
+ ((source . "coolguy!ag")
+ (atoms
+ (nick . "coolguy")
+ (user . "ag")))
+ ((source . "coolguy!ag@net\ 35w\ 3ork.admin")
+ (atoms
+ (nick . "coolguy")
+ (user . "ag")
+ (host . "net\ 35w\ 3ork.admin")))
+ ((source . "coolguy!~ag@n\ 2et\ 305w\ fork.admin")
+ (atoms
+ (nick . "coolguy")
+ (user . "~ag")
+ (host . "n\ 2et\ 305w\ fork.admin")))))
+ (validate-hostname
+ (tests
+ ((host . "irc.example.com")
+ (valid . t))
+ ((host . "i.coolguy.net")
+ (valid . t))
+ ((host . "irc-srv.net.uk")
+ (valid . t))
+ ((host . "iRC.CooLguY.NeT")
+ (valid . t))
+ ((host . "gsf.ds342.co.uk")
+ (valid . t))
+ ((host . "324.net.uk")
+ (valid . t))
+ ((host . "xn--bcher-kva.ch")
+ (valid . t))
+ ((host . "-lol-.net.uk")
+ (valid . :false))
+ ((host . "-lol.net.uk")
+ (valid . :false))
+ ((host . "_irc._sctp.lol.net.uk")
+ (valid . :false))
+ ((host . "irc")
+ (valid . :false))
+ ((host . "com")
+ (valid . :false))
+ ((host . "")
+ (valid . :false)))))
--- /dev/null
+;; -*- mode: lisp-data; -*-
+((pass 1 "PASS " (? ?:) "a"))
+((linger 100 LINGER))
\ No newline at end of file
--- /dev/null
+;; -*- mode: lisp-data; -*-
+((pass 1 "PASS " (? ?:) "b"))
+((linger 1 LINGER))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :tester")
+ (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0 ":irc.example.org 002 tester :Your host is irc.example.org")
+ (0 ":irc.example.org 003 tester :This server was created just now")
+ (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ ;; Just to mix thing's up (force handler to schedule timer)
+ (0.1 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0 ":irc.example.org 254 tester 1 :channels formed")
+ (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0 ":irc.example.org 221 tester +Zi")
+ (0 ":irc.example.org 306 tester :You have been marked as being away")
+ (0 ":tester!~tester@localhost JOIN #chan")
+ (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 366 alice #chan :End of NAMES list"))
+
+((mode-chan 1.2 "MODE #chan")
+ (0 ":bob!~bob@example.org PRIVMSG #chan :hey"))
+
+((linger 1.0 LINGER))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :tester")
+ (0.0 ":irc.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0.0 ":irc.org 002 tester :Your host is irc.org")
+ (0.0 ":irc.org 003 tester :This server was created just now")
+ (0.0 ":irc.org 004 tester irc.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0.0 ":irc.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0.0 ":irc.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0.0 ":irc.org 252 tester 0 :IRC Operators online")
+ (0.0 ":irc.org 253 tester 0 :unregistered connections")
+ (0.0 ":irc.org 254 tester 1 :channels formed")
+ (0.0 ":irc.org 255 tester :I have 3 clients and 0 servers")
+ (0.0 ":irc.org 265 tester 3 3 :Current local users 3, max 3")
+ (0.0 ":irc.org 266 tester 3 3 :Current global users 3, max 3")
+ (0.0 ":irc.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0.0 ":irc.org 221 tester +Zi")
+ (0.0 ":irc.org 306 tester :You have been marked as being away"))
+
+((join-foo 1.2 "JOIN #foo")
+ (0 ":tester!~tester@localhost JOIN #foo")
+ (0 ":irc.example.org 353 alice = #foo :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 366 alice #foo :End of NAMES list"))
+
+;; This would time out if the mode-foo's outgoing blocked (remove minus signs to see)
+((~join-bar 1.5 "JOIN #bar")
+ (0 ":tester!~tester@localhost JOIN #bar")
+ (0 ":irc.example.org 353 alice = #bar :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 366 alice #bar :End of NAMES list"))
+
+((mode-foo 1.2 "MODE #foo")
+ (0.0 ":irc.example.org 324 tester #foo +Cint")
+ (0.0 ":irc.example.org 329 tester #foo 1519850102")
+ (-0.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: But, in defence, by mercy, 'tis most just.")
+ (-0.2 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: Grows, lives, and dies, in single blessedness.")
+ (-0.3 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: For these two hours, Rosalind, I will leave thee.")
+ (-0.4 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: By this hand, it will not kill a fly. But come, now I will be your Rosalind in a more coming-on disposition; and ask me what you will, I will grant it.")
+ (-0.5 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: That I must love a loathed enemy.")
+ (-0.6 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: As't please your lordship: I'll leave you.")
+ (-0.7 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: Then there is no true lover in the forest; else sighing every minute and groaning every hour would detect the lazy foot of Time as well as a clock.")
+ (-0.8 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: His discretion, I am sure, cannot carry his valour, for the goose carries not the fox. It is well: leave it to his discretion, and let us listen to the moon.")
+ (-0.9 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: As living here and you no use of him.")
+ (-1.0 ":alice!~u@svpn88yjcdj42.irc PRIVMSG #foo :bob: If there be truth in sight, you are my Rosalind.")
+ (-1.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :alice: That is another's lawful promis'd love.")
+ (-1.1 ":bob!~u@svpn88yjcdj42.irc PRIVMSG #foo :I am heard."))
+
+((mode-bar 1.5 "MODE #bar")
+ (0.0 ":irc.example.org 324 tester #bar +HMfnrt 50:5h :10:5")
+ (0.0 ":irc.example.org 329 tester #bar :1602642829")
+ (0.1 ":alice!~alice@example.com PRIVMSG #bar :hi 123"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :tester")
+ (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0 ":irc.example.org 002 tester :Your host is irc.example.org")
+ (0 ":irc.example.org 003 tester :This server was created just now")
+ (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0 ":irc.example.org 254 tester 1 :channels formed")
+ (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0 ":irc.example.org 221 tester +Zi")
+ (0 ":irc.example.org 306 tester :You have been marked as being away"))
+
+((join 1.2 "JOIN #chan")
+ (0 ":tester!~tester@localhost JOIN #chan")
+ (0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0 ":irc.example.org 366 alice #chan :End of NAMES list"))
+
+((mode-chan 0.2 "MODE #chan")
+ (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((~ping 1.2 "PING " nonce)
+ (0.1 ":irc.example.org PONG irc.example.com " echo))
+
+((user 0.2 "USER user 0 * :tester")
+ (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0 ":irc.example.org 002 tester :Your host is irc.example.org")
+ (0 ":irc.example.org 003 tester :This server was created just now")
+ (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0 ":irc.example.org 254 tester 1 :channels formed")
+ (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0 ":irc.example.org 221 tester +Zi")
+ (0 ":irc.example.org 306 tester :You have been marked as being away"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+((one 1 "ONE one"))
+((two 1 "TWO two"))
+((blank 1 ""))
+((one-space 1 " "))
+((two-spaces 1 " "))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) network ":changeme"))
+((nick 1.2 "NICK tester"))
+
+((user 1.2 "USER user 0 * :tester")
+ (0.001 ":" fqdn " 001 tester :Welcome to the BAR Network tester")
+ (0.002 ":" fqdn " 002 tester :Your host is " fqdn)
+ (0.003 ":" fqdn " 003 tester :This server was created just now")
+ (0.004 ":" fqdn " 004 tester " fqdn " BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0.005 ":" fqdn " 005 tester MODES NETWORK=" net " NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0.006 ":" fqdn " 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0.007 ":" fqdn " 252 tester 0 :IRC Operators online")
+ (0.008 ":" fqdn " 253 tester 0 :unregistered connections")
+ (0.009 ":" fqdn " 254 tester 1 :channels formed")
+ (0.010 ":" fqdn " 255 tester :I have 3 clients and 0 servers")
+ (0.011 ":" fqdn " 265 tester 3 3 :Current local users 3, max 3")
+ (0.012 ":" fqdn " 266 tester 3 3 :Current global users 3, max 3")
+ (0.013 ":" fqdn " 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0.014 ":" fqdn " 221 tester +Zi")
+ (0.015 ":" fqdn " 306 tester :You have been marked as being away"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) network ":changeme"))
+((nick 1.2 "NICK tester"))
+
+((user 2.2 "USER user 0 * :tester")
+ (0.015 ":" fqdn " 001 tester :Welcome to the FOO Network tester")
+ (0.014 ":" fqdn " 002 tester :Your host is " fqdn)
+ (0.013 ":" fqdn " 003 tester :This server was created just now")
+ (0.012 ":" fqdn " 004 tester " fqdn " BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0.011 ":" fqdn " 005 tester MODES NETWORK=" net " NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0.010 ":" fqdn " 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0.009 ":" fqdn " 252 tester 0 :IRC Operators online")
+ (0.008 ":" fqdn " 253 tester 0 :unregistered connections")
+ (0.007 ":" fqdn " 254 tester 1 :channels formed")
+ (0.006 ":" fqdn " 255 tester :I have 3 clients and 0 servers")
+ (0.005 ":" fqdn " 265 tester 3 3 :Current local users 3, max 3")
+ (0.004 ":" fqdn " 266 tester 3 3 :Current global users 3, max 3")
+ (0.003 ":" fqdn " 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0.002 ":" fqdn " 221 tester +Zi")
+ (0.001 ":" fqdn " 306 tester :You have been marked as being away"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :" (group (+ alpha)) eos)
+ (0 ":*status!znc@znc.in NOTICE " nick " :You have no networks configured."
+ " Use /znc AddNetwork <network> to add one.")
+ (0 ":irc.znc.in 001 " nick " :Welcome " nick "!"))
--- /dev/null
+;;; proxy-subprocess.el --- Example setup file for erc-d -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
+;;
+;; This file is part of GNU Emacs.
+;;
+;; This program 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.
+;;
+;; This program 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 this program. If not, see
+;; <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;; Code:
+
+(defvar erc-d-tmpl-vars)
+
+(setq erc-d-tmpl-vars
+
+ (list
+ (cons 'fqdn (lambda (helper)
+ (let ((name (funcall helper :dialog-name)))
+ (funcall helper :set
+ (if (eq name 'proxy-foonet)
+ "irc.foo.net"
+ "irc.bar.net")))))
+
+ (cons 'net (lambda (helper)
+ (let ((name (funcall helper :dialog-name)))
+ (funcall helper :set
+ (if (eq name 'proxy-foonet)
+ "FooNet"
+ "BarNet")))))
+
+ (cons 'network '(group (+ alpha)))))
+
+;;; proxy-subprocess.el ends here
--- /dev/null
+;;; -*- mode: lisp-data -*-
+
+((pass 10.0 "PASS " (? ?:) "changeme"))
+((nick 0.2 "NICK tester"))
+
+((user 0.2 "USER user 0 * :tester")
+ (0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0 ":irc.example.org 002 tester :Your host is irc.example.org")
+ (0 ":irc.example.org 003 tester :This server was created just now")
+ (0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0 ":irc.example.org 254 tester 1 :channels formed")
+ (0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
+ (0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
+ (0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
+ (0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0 ":irc.example.org 221 tester +Zi")
+ (0 ":irc.example.org 306 tester :You have been marked as being away"))
+
+((mode 0.2 "MODE #chan")
+ (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
--- /dev/null
+;;; -*- mode: lisp-data -*-
+((t 10.0 "PASS " (? ?:) "changeme"))
+((t 0.2 "NICK tester"))
+
+((t 0.2 "USER user 0 * :tester")
+ (0.0 ":irc.example.org 001 tester :Welcome to the Internet Relay Network tester")
+ (0.0 ":irc.example.org 002 tester :Your host is irc.example.org")
+ (0.0 ":irc.example.org 003 tester :This server was created just now")
+ (0.0 ":irc.example.org 004 tester irc.example.org BERios CEIRabehiklmnoqstv Iabehkloqv")
+ (0.0 ":irc.example.org 005 tester MODES NETWORK=ExampleOrg NICKLEN=32 PREFIX=(qaohv)~&@%+"
+ " :are supported by this server")
+ (0.0 ":irc.example.org 251 tester :There are 3 users and 0 invisible on 1 server(s)")
+ (0.0 ":irc.example.org 252 tester 0 :IRC Operators online")
+ (0.0 ":irc.example.org 253 tester 0 :unregistered connections")
+ (0.0 ":irc.example.org 254 tester 1 :channels formed")
+ (0.0 ":irc.example.org 255 tester :I have 3 clients and 0 servers")
+ (0.0 ":irc.example.org 265 tester 3 3 :Current local users 3, max 3")
+ (0.0 ":irc.example.org 266 tester 3 3 :Current global users 3, max 3")
+ (0.0 ":irc.example.org 422 tester :MOTD File is missing"))
+
+((mode-user 1.2 "MODE tester +i")
+ (0.0 ":irc.example.org 221 tester +Zi")
+
+ (0.0 ":irc.example.org 306 tester :You have been marked as being away")
+ (0.0 ":tester!~tester@localhost JOIN #chan")
+ (0.0 ":irc.example.org 353 alice = #chan :+alice!~alice@example.com @%+bob!~bob@example.org")
+ (0.0 ":irc.example.org 366 alice #chan :End of NAMES list")
+ (0.1 ":bob!~bob@example.org PRIVMSG #chan :hey"))
projects / emacs.git / commitdiff