324cef61d5
Efinger is a client for the Finger protocol (RFC 1288) with an Elfeed-inspired reader. Configure a list of accounts once and browse their .plan files from a two-pane interface: an account list on one side and the fingered content on the other. Move with n/p to preview each account, RET to read one in full, l to go back to the list and q to close both panes. M-x efinger-finger fingers a single account on demand. Connections are asynchronous (:nowait) with a configurable timeout, so Emacs never freezes when a host resolves but never answers on port 79. The finger core is forked from GNU Emacs' net-utils.el (by Peter Breton) and rewritten around an asynchronous connection.
221 lines
8.9 KiB
EmacsLisp
221 lines
8.9 KiB
EmacsLisp
;;; efinger-test.el --- Tests for efinger -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2026 Andros Fenollosa
|
|
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; ERT test suite for efinger.el.
|
|
;;
|
|
;; The integration tests spin up an ephemeral finger server *inside*
|
|
;; Emacs (via `make-network-process' with :server t) so no external
|
|
;; program or network access is required. The sample .plan payload is
|
|
;; John Carmack's real DOOM source-release announcement, quoted in
|
|
;; <https://andros.dev/blog/79c99190/>.
|
|
;;
|
|
;; Run with:
|
|
;; emacs --batch -L . -l test/efinger-test.el -f ert-run-tests-batch-and-exit
|
|
;;
|
|
;; The blackhole timeout test needs outbound routing and is skipped
|
|
;; unless EFINGER_NETWORK_TESTS is set in the environment.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'efinger)
|
|
|
|
(defconst efinger-test-plan
|
|
(concat "-----------------------------------------\r\n"
|
|
"John Carmack's .plan for Aug 18, 1997\r\n"
|
|
"-----------------------------------------\r\n"
|
|
"\r\n"
|
|
"I get asked about the DOOM source code every once in a while,\r\n"
|
|
"so here is a full status update.\r\n")
|
|
"Sample .plan reply, in raw CRLF form, used by the integration tests.")
|
|
|
|
;;;; Helpers
|
|
|
|
(defun efinger-test--pump (seconds predicate)
|
|
"Run the event loop up to SECONDS until PREDICATE returns non-nil."
|
|
(let ((deadline (+ (float-time) seconds)))
|
|
(while (and (< (float-time) deadline)
|
|
(not (funcall predicate)))
|
|
(accept-process-output nil 0.05)
|
|
(sit-for 0.01))
|
|
(funcall predicate)))
|
|
|
|
(defun efinger-test--make-server (payload received)
|
|
"Start a one-shot finger server that replies with PAYLOAD.
|
|
RECEIVED is a one-element vector; the query line the client sends
|
|
is stored in its slot 0. Return the server process."
|
|
(make-network-process
|
|
:name "efinger-test-server"
|
|
:server t
|
|
:host 'local
|
|
:service t
|
|
:family 'ipv4
|
|
:coding 'utf-8
|
|
:filter (lambda (connection string)
|
|
(aset received 0 string)
|
|
(process-send-string connection payload)
|
|
(delete-process connection))))
|
|
|
|
(defun efinger-test--closed-port ()
|
|
"Return a loopback port number with nothing listening on it."
|
|
(let* ((server (make-network-process
|
|
:name "efinger-test-probe" :server t
|
|
:host 'local :service t :family 'ipv4))
|
|
(port (process-contact server :service)))
|
|
(delete-process server)
|
|
port))
|
|
|
|
;;;; Account parsing
|
|
|
|
(ert-deftest efinger-test-parse-user-host ()
|
|
(let ((account (efinger--parse-account "johnc@idsoftware.com")))
|
|
(should (equal (plist-get account :user) "johnc"))
|
|
(should (equal (plist-get account :host) "idsoftware.com"))
|
|
(should (eql (plist-get account :port) 79))
|
|
(should (equal (plist-get account :label) "johnc@idsoftware.com"))))
|
|
|
|
(ert-deftest efinger-test-parse-labelled-with-port ()
|
|
(let ((account (efinger--parse-account
|
|
'("Carmack" "johnc@example.com:1079"))))
|
|
(should (equal (plist-get account :label) "Carmack"))
|
|
(should (equal (plist-get account :user) "johnc"))
|
|
(should (equal (plist-get account :host) "example.com"))
|
|
(should (eql (plist-get account :port) 1079))))
|
|
|
|
(ert-deftest efinger-test-parse-host-only ()
|
|
(let ((account (efinger--parse-account "happynetbox.com")))
|
|
(should (equal (plist-get account :user) ""))
|
|
(should (equal (plist-get account :host) "happynetbox.com"))))
|
|
|
|
(ert-deftest efinger-test-parse-invalid ()
|
|
(should-error (efinger--parse-account 42)))
|
|
|
|
(ert-deftest efinger-test-account-title ()
|
|
(should (equal (efinger--account-title
|
|
(efinger--parse-account "johnc@idsoftware.com"))
|
|
"johnc@idsoftware.com"))
|
|
(should (equal (efinger--account-title
|
|
(efinger--parse-account "johnc@example.com:1079"))
|
|
"johnc@example.com:1079"))
|
|
(should (equal (efinger--account-title
|
|
(efinger--parse-account "happynetbox.com"))
|
|
"happynetbox.com")))
|
|
|
|
(ert-deftest efinger-test-finger-query ()
|
|
(let ((account (efinger--parse-account "johnc@idsoftware.com")))
|
|
(let ((efinger-forward-host nil))
|
|
(should (equal (efinger--finger-query account) "johnc")))
|
|
(let ((efinger-forward-host t))
|
|
(should (equal (efinger--finger-query account)
|
|
"johnc@idsoftware.com"))))
|
|
;; Host-only listing sends an empty query regardless of forwarding.
|
|
(let ((account (efinger--parse-account "happynetbox.com"))
|
|
(efinger-forward-host t))
|
|
(should (equal (efinger--finger-query account) ""))))
|
|
|
|
(ert-deftest efinger-test-strip-cr ()
|
|
(should (equal (efinger--strip-cr "a\r\nb\r\n") "a\nb\n")))
|
|
|
|
;;;; Integration: async fetch
|
|
|
|
(ert-deftest efinger-test-fetch-serves-plan ()
|
|
"A responding server delivers its .plan into the buffer, CRs stripped."
|
|
(let* ((received (make-vector 1 nil))
|
|
(server (efinger-test--make-server efinger-test-plan received))
|
|
(port (process-contact server :service))
|
|
(buffer (generate-new-buffer " *efinger-test-plan*")))
|
|
(unwind-protect
|
|
(progn
|
|
(with-current-buffer buffer (efinger-plan-mode))
|
|
(efinger--start
|
|
buffer (list :label "test" :user "johnc"
|
|
:host "127.0.0.1" :port port))
|
|
(should (efinger-test--pump
|
|
5 (lambda ()
|
|
(with-current-buffer buffer
|
|
(string-match-p "status update" (buffer-string))))))
|
|
;; The bare username reached the server.
|
|
(should (equal (string-trim (aref received 0)) "johnc"))
|
|
(with-current-buffer buffer
|
|
(should (string-match-p "John Carmack's .plan" (buffer-string)))
|
|
;; Header title is present and CRs are gone.
|
|
(should (string-prefix-p "johnc@127.0.0.1" (buffer-string)))
|
|
(should-not (string-match-p "\r" (buffer-string)))
|
|
;; The transient status placeholder was replaced.
|
|
(should-not (string-match-p "Fingering" (buffer-string)))))
|
|
(when (process-live-p server) (delete-process server))
|
|
(kill-buffer buffer))))
|
|
|
|
(ert-deftest efinger-test-fetch-connection-refused ()
|
|
"A refused connection is reported gracefully, without a backtrace."
|
|
(let ((buffer (generate-new-buffer " *efinger-test-refused*"))
|
|
(port (efinger-test--closed-port))
|
|
(efinger-connection-timeout 3))
|
|
(unwind-protect
|
|
(progn
|
|
(with-current-buffer buffer (efinger-plan-mode))
|
|
(efinger--start
|
|
buffer (list :label "x" :user "x" :host "127.0.0.1" :port port))
|
|
(should (efinger-test--pump
|
|
5 (lambda ()
|
|
(with-current-buffer buffer
|
|
(string-match-p "Could not connect\\|timed out"
|
|
(buffer-string))))))
|
|
(with-current-buffer buffer
|
|
(should (string-match-p "Could not connect" (buffer-string)))))
|
|
(kill-buffer buffer))))
|
|
|
|
(ert-deftest efinger-test-fetch-returns-immediately ()
|
|
"The async fetch returns control at once, whatever the host does."
|
|
(let ((buffer (generate-new-buffer " *efinger-test-immediate*"))
|
|
(port (efinger-test--closed-port))
|
|
(efinger-connection-timeout 10))
|
|
(unwind-protect
|
|
(let* ((start (float-time))
|
|
(_ (with-current-buffer buffer (efinger-plan-mode)))
|
|
(proc (efinger--start
|
|
buffer
|
|
(list :label "x" :user "x" :host "127.0.0.1" :port port)))
|
|
(elapsed (- (float-time) start)))
|
|
(should (< elapsed 1.0))
|
|
(should (eq (process-status proc) 'connect)))
|
|
(kill-buffer buffer))))
|
|
|
|
(ert-deftest efinger-test-timeout ()
|
|
"A silent host is abandoned after `efinger-connection-timeout' seconds."
|
|
(skip-unless (getenv "EFINGER_NETWORK_TESTS"))
|
|
(let ((buffer (generate-new-buffer " *efinger-test-timeout*"))
|
|
(efinger-connection-timeout 2))
|
|
(unwind-protect
|
|
(progn
|
|
(with-current-buffer buffer (efinger-plan-mode))
|
|
(efinger--start
|
|
buffer (list :label "bh" :user "x" :host "10.255.255.1" :port 79))
|
|
(should (efinger-test--pump
|
|
6 (lambda ()
|
|
(with-current-buffer buffer
|
|
(string-match-p "timed out" (buffer-string)))))))
|
|
(kill-buffer buffer))))
|
|
|
|
(ert-deftest efinger-test-live-happynetbox ()
|
|
"Optional live check against a real public finger server."
|
|
(skip-unless (getenv "EFINGER_NETWORK_TESTS"))
|
|
(let ((buffer (generate-new-buffer " *efinger-test-live*")))
|
|
(unwind-protect
|
|
(progn
|
|
(with-current-buffer buffer (efinger-plan-mode))
|
|
(efinger--start
|
|
buffer (efinger--parse-account "random@happynetbox.com"))
|
|
(should (efinger-test--pump
|
|
15 (lambda ()
|
|
(with-current-buffer buffer
|
|
(> (- (point-max) (point-min)) 60))))))
|
|
(kill-buffer buffer))))
|
|
|
|
(provide 'efinger-test)
|
|
;;; efinger-test.el ends here
|