>From 2cb78c4a95801e8f7d804aac9f79d9ab8a9f4141 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 24 May 2021 05:48:29 -0700 Subject: [PATCH] Add test case for reconnecting with erc-tls * test/lisp/erc/erc-resources/client-cert.pem: Add fake TLS client certificate good till 2030. * test/lisp/erc/erc-tests.el: Add ERT test against ERC for reconnecting to an existing TLS connection. Also add some helpers and a baseline test that's only triggered manually. --- test/lisp/erc/erc-resources/client-cert.pem | 28 ++++ test/lisp/erc/erc-tests.el | 161 +++++++++++++++++++- 2 files changed, 188 insertions(+), 1 deletion(-) create mode 100644 test/lisp/erc/erc-resources/client-cert.pem diff --git a/test/lisp/erc/erc-resources/client-cert.pem b/test/lisp/erc/erc-resources/client-cert.pem new file mode 100644 index 00000000000..9e6f756d95a --- /dev/null +++ b/test/lisp/erc/erc-resources/client-cert.pem @@ -0,0 +1,28 @@ +-----BEGIN PRIVATE KEY----- +MIICdQIBADANBgkqhkiG9w0BAQEFAASCAl8wggJbAgEAAoGBAMcw/WGIo0nKU/mi +/SvXC39bxv1Yt4RzBXwoqH1tVUfAoeWFK3xQcUk4hXD9xjCw3XBF9n2/C5bZpavA +LEFzPCCgvjhnaT7jGd16xVhRCW9AVTLWjBnsVg4CFwLQmjOBD5xvdjSEO/qAYl8n +nCEkbQ2Kbk8ntEsZFE+a7mx/OTc1AgMBAAECgYA2ZtfdCn9mSN8UgAJbNdlLCFrZ +mKBOiUeHOGeEEhdHiIHu+Kb+xc2a7NftGzJE3Bkub705bLMSmRDZTpwHqBxUZWtM +/FHLHWVb7BhGyoVhAHPiZ+XENtE7uPvARORmXvXVpbUGxNP1Q8cml1eNBZU32J4p +upRRLDupn7CoeeOLxQJBAO5TFG2lWJGJ5Un7cAA/rwJuXctUHkejkHxZEj6Q7h1r +mNOcAxHYI+BQEyjbXPuKRe5qyhgNU3rYNc28xjeyfSMCQQDV9umvJwJ2kgZFo4zE +sWLoAK3FuHI7KsuGaEr7Q6Zl03YFVnXmi1cqV4P7dh3OQw7POxR2IPiN4AYEI9hj +L9vHAkBl1hJQl+q0pdvYNRyyvoOl4ksp6xPVQMsol1b4bS2SXLu9EFkvctBBtXW6 +a6HbykX/jpo0lN0rDOBQvW1lt1tJAkBKeEfZWIB4+FYKguQJyZudGC9jM9E+WqS/ +wSjnzyHpKvJW5ULf3PuXlyIusWuqUJik8/EpNEyORLyTUE6OJygdAkBi+jAGzwPk +u+R28ChDiEAEyAFMKgVQRP2/2DKnec7q1auiJ4y+i7n2+bCGB/jLujcvtDxk5IOp +3YTp3AGnauAr +-----END PRIVATE KEY----- +-----BEGIN CERTIFICATE----- +MIIBwDCCASkCFCnn3LdHhlRGSRuSUSeAAjYK+i4vMA0GCSqGSIb3DQEBCwUAMB8x +CzAJBgNVBAYTAlVTMRAwDgYDVQQKDAdFeGFtcGxlMB4XDTIwMTAxMjA3MTg0OFoX +DTMwMTAxMDA3MTg0OFowHzELMAkGA1UEBhMCVVMxEDAOBgNVBAoMB0V4YW1wbGUw +gZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJAoGBAMcw/WGIo0nKU/mi/SvXC39bxv1Y +t4RzBXwoqH1tVUfAoeWFK3xQcUk4hXD9xjCw3XBF9n2/C5bZpavALEFzPCCgvjhn +aT7jGd16xVhRCW9AVTLWjBnsVg4CFwLQmjOBD5xvdjSEO/qAYl8nnCEkbQ2Kbk8n +tEsZFE+a7mx/OTc1AgMBAAEwDQYJKoZIhvcNAQELBQADgYEAHiUe2AaTLtaqhzmX +9De0A+j8eufe/cp+1ZibWouNzVUFYte7usiimjBiNBagOpTt5wlfVJ6RZyRR6Agn +Uz7mCLw9BlVe51GTeiRIibpmgD7AjgLaatTBSkqtZ+L9gYMHVg1DQgZxbBvfAsh4 +gTRGyHykisjxKqOqcURUE/Wz5kw= +-----END CERTIFICATE----- diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index d13397274aa..76808b8d414 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -21,9 +21,10 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'erc) (require 'erc-ring) +(require 'network-stream) (ert-deftest erc--read-time-period () (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) @@ -109,3 +110,161 @@ erc-ring-previous-command (should (looking-at "abc"))))) (when noninteractive (kill-buffer "*#fake*"))) + +;; All this stuff is from test/lisp/net/network-stream-tests.el +(defun erc-tests-make-tls-echo (port) + (let* ((ert-resource-directory-format "%s/../lisp/net/network-stream-resources") + (ert-resource-directory-trim-right-regexp "erc/erc-tests\\.el") + (proc (start-process "gnutls" (generate-new-buffer "*tls*") + "gnutls-serv" + "--echo" "--crlf" "--require-client-cert" + "--x509keyfile" (ert-resource-file "key.pem") + "--x509certfile" (ert-resource-file "cert.pem") + "--port" (format "%s" port)))) + (set-process-query-on-exit-flag proc nil) + proc)) + +(defun erc-tests-create-tls-client () + (let ((cert (ert-resource-file "client-cert.pem")) + buf proc) + (with-timeout (1 (error "Client failed to connect")) + (while + (when (ignore-errors + (setq buf (generate-new-buffer "*erc-tls-client*") + proc (open-network-stream + "erc-tls-client" buf "localhost" 16697 + :type 'tls + :client-certificate (list cert cert)))) + (while (eq (process-status proc) 'connect) + (sit-for 0.1))) + (sit-for 0.1) + (kill-buffer buf))) + (should proc))) + +(defun erc-tests--open-tls-stream (&rest r) + (let (proc) + (with-timeout (1 (error "Client failed to connect")) + (while (when (ignore-errors (setq proc (apply #'erc-open-tls-stream r))) + (while (eq (process-status proc) 'connect) (sit-for 0.1))) + (sit-for 0.1))) + (should proc))) + +(defvar erc-tests-client-cert-fp + "sha256:16665405702cc1a8084e67878189aa82e794c3b366433ed0e51beae7b0cfbc3c") + +(defun erc-tests-find-client-cert (echo-server-buffer &optional point) + (with-current-buffer echo-server-buffer + (save-excursion + (with-timeout (1 (error "Failed to find client fp")) + (while (not + (progn + (goto-char (or point (point-min))) + (search-forward erc-tests-client-cert-fp nil t)))) + (sit-for 0.1))))) + +;; TODO add one that intentionally fails (missing cert), both baseline +;; and with ERC. Also, slip unless manually triggered. +(ert-deftest erc-tests-client-cert-baseline () + (skip-unless t) + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (let* ((server (erc-tests-make-tls-echo 16697)) + (sbuf (process-buffer server)) + (network-security-level 'low) + cbuf proc) + (unwind-protect + (progn + (sleep-for 1) + (with-current-buffer sbuf + (message "gnutls-serv: %s" (buffer-string))) + (setq proc (erc-tests-create-tls-client) + cbuf (process-buffer proc)) + (process-send-string proc "hello\r\n")) + (sit-for 1)) + (ert-info ("Server sees client cert") + (erc-tests-find-client-cert sbuf)) + (with-current-buffer cbuf + (goto-char (point-min)) + (should (search-forward "hello" nil t))) + (when noninteractive + (delete-process proc) + (kill-buffer cbuf) + (kill-buffer sbuf)))) + +(defun erc-tests-make-erc-tls-process (port) + (let ((cert (ert-resource-file "client-cert.pem"))) + (with-current-buffer + (erc-tls :server "localhost" + :password "tester" + :nick "tester" + :full-name "tester" + :port port + :client-certificate (list cert cert)) + erc-server-process))) + +(defun erc-tests-perform-erc-tls (connect-function port) + (let* ((echo-server (erc-tests-make-tls-echo port)) + (echo-buffer (process-buffer echo-server)) + (network-security-level 'low) + call-hist erc-server-buf erc-proc) + + (cl-letf (((symbol-function 'erc-server-send) + (lambda (s &rest _) + (push s call-hist) + (when (setq s (cond + ((string-match-p "\\`PASS" s) nil) + ((string-match-p "\\`NICK" s) nil) + ((string-match-p "\\`USER" s) "PING :1") + (t s))) + (process-send-string erc-server-process + (concat s "\r\n")))))) + + (ert-info ("Connect") + (setq erc-proc (funcall connect-function port) + erc-server-buf (process-buffer erc-proc))) + + (with-timeout (5 (error "Opening failed")) + (while (not (string= "PONG :1" (car call-hist))) + (sit-for 0.1))) + + (ert-info ("TLS echo server sees client cert") + (erc-tests-find-client-cert echo-buffer)) + + (with-current-buffer erc-server-buf + (erc-cmd-QUIT "") + (with-timeout (5 (error "Failed to disconnect")) + (while (not (progn (goto-char (point-min)) + (search-forward "ERC finished" nil t))) + (sit-for 0.1))))) + + (delete-process echo-server) + (kill-buffer echo-buffer) + erc-server-buf)) + +(ert-deftest erc-tls-reconnect () + (skip-unless noninteractive) + (skip-unless (executable-find "gnutls-serv")) + (skip-unless (gnutls-available-p)) + (skip-unless (eq system-type 'gnu/linux)) + (let (erc-server-buf) + (unwind-protect + (progn + (setq erc-server-buf (erc-tests-perform-erc-tls + #'erc-tests-make-erc-tls-process 16698)) + (erc-tests-perform-erc-tls + (lambda (_) + (with-current-buffer erc-server-buf + ;; HACK this is a bit messy (see network-stream-tests) + (setq erc-session-connector #'erc-tests--open-tls-stream) + (erc-cmd-RECONNECT) + erc-server-process)) + 16698) + (delete-process erc-server-buf) + (kill-buffer erc-server-buf)) + (when-let ((proc (get-buffer-process (get-buffer "*tls*")))) + (delete-process proc)) + (ignore-error (delete-process erc-server-buf)) + (kill-buffer erc-server-buf) + (when-let ((buf (get-buffer "*trace-output*"))) + (message "trace-output:\n%s" (with-current-buffer buf (buffer-string))) + (kill-buffer buf))))) -- 2.31.1