From: Philipp Stephani Date: Wed, 30 Dec 2020 21:28:06 +0000 (+0100) Subject: Extend and overhaul FD_SETSIZE overflow tests. X-Git-Tag: emacs-28.0.90~4474 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3a6137a498fe065cadbbf9a1f0575623155a9e55;p=emacs.git Extend and overhaul FD_SETSIZE overflow tests. Instead of trying to generate the right number of processes, pre-create lots of unused pipe processes until creation fails. Extend the tests to the 'pty' connection type and other kinds of process objects. * test/src/process-tests.el (process-tests--ignore-EMFILE) (process-tests--with-buffers, process-tests--with-processes) (process-tests--with-many-pipes, process-tests--with-temp-file) (process-tests--with-temp-directory): New helper macros. (process-tests/fd-setsize-no-crash/make-process): Renamed from 'process-tests/fd-setsize-no-crash'. Fail on timeout. Also test the 'pty' connection type. Pre-create lots of pipe processes so we reach the FD_SETSIZE limit faster. Ignore EMFILE more precisely, if possible. (process-tests/fd-setsize-no-crash/make-pipe-process) (process-tests/fd-setsize-no-crash/make-network-process) (process-tests/fd-setsize-no-crash/make-serial-process): New tests that test FD_SETSIZE limits for other kinds of processes. (process-tests--EMFILE-message): New helper function and cache variable. (process-tests--new-pty): New helper function. --- diff --git a/test/src/process-tests.el b/test/src/process-tests.el index 21a9a964be5..7d8679e9e1c 100644 --- a/test/src/process-tests.el +++ b/test/src/process-tests.el @@ -23,8 +23,11 @@ ;;; Code: +(require 'cl-lib) (require 'ert) (require 'puny) +(require 'rx) +(require 'subr-x) ;; Timeout in seconds; the test fails if the timeout is reached. (defvar process-test-sentinel-wait-timeout 2.0) @@ -386,43 +389,312 @@ See Bug#30460." "Check that looking up non-existent domain returns nil" (should (eq nil (network-lookup-address-info "emacs.invalid"))))) -(ert-deftest process-tests/fd-setsize-no-crash () +(defmacro process-tests--ignore-EMFILE (&rest body) + "Evaluate BODY, ignoring EMFILE errors." + (declare (indent 0) (debug t)) + (let ((err (make-symbol "err")) + (message (make-symbol "message"))) + `(let ((,message (process-tests--EMFILE-message))) + (condition-case ,err + ,(macroexp-progn body) + (file-error + ;; If we couldn't determine the EMFILE message, just ignore + ;; all `file-error' signals. + (and ,message + (not (string-equal (caddr ,err) ,message)) + (signal (car ,err) (cdr ,err)))))))) + +(defmacro process-tests--with-buffers (var &rest body) + "Bind VAR to nil and evaluate BODY. +Afterwards, kill all buffers in the list VAR. BODY should add +some buffer objects to VAR." + (declare (indent 1) (debug (symbolp body))) + (cl-check-type var symbol) + `(let ((,var nil)) + (unwind-protect + ,(macroexp-progn body) + (mapc #'kill-buffer ,var)))) + +(defmacro process-tests--with-processes (var &rest body) + "Bind VAR to nil and evaluate BODY. +Afterwards, delete all processes in the list VAR. BODY should +add some process objects to VAR." + (declare (indent 1) (debug (symbolp body))) + (cl-check-type var symbol) + `(let ((,var nil)) + (unwind-protect + ,(macroexp-progn body) + (mapc #'delete-process ,var)))) + +(defmacro process-tests--with-many-pipes (&rest body) + "Generate lots of pipe processes. +Try to generate pipe processes until we are close to the +FD_SETSIZE limit. Within BODY, only a small number of file +descriptors should still be available." + (declare (indent 0) (debug (symbolp symbolp body))) + (let ((process (make-symbol "process")) + (processes (make-symbol "processes")) + (buffer (make-symbol "buffer")) + (buffers (make-symbol "buffers")) + ;; FD_SETSIZE is typically 1024 on Unix-like systems. On + ;; MS-Windows we artificially limit FD_SETSIZE to 64, see the + ;; commentary in w32proc.c. + (fd-setsize (if (eq system-type 'windows-nt) 64 1024))) + `(process-tests--with-buffers ,buffers + (process-tests--with-processes ,processes + ;; First, allocate enough pipes to definitely exceed the + ;; FD_SETSIZE limit. + (cl-loop for i from 1 to ,(1+ fd-setsize) + for ,buffer = (generate-new-buffer + (format " *pipe %d*" i)) + do (push ,buffer ,buffers) + for ,process = (process-tests--ignore-EMFILE + (make-pipe-process + :name (format "pipe %d" i) + :buffer ,buffer + :coding 'no-conversion + :noquery t)) + while ,process + do (push ,process ,processes)) + (unless (cddr ,processes) + (ert-fail "Couldn't allocate enough pipes")) + ;; Delete two pipes to test more edge cases. + (delete-process (pop ,processes)) + (delete-process (pop ,processes)) + ,@body)))) + +(defmacro process-tests--with-temp-file (var &rest body) + "Bind VAR to the name of a new regular file and evaluate BODY. +Afterwards, delete the file." + (declare (indent 1) (debug (symbolp body))) + (cl-check-type var symbol) + (let ((file (make-symbol "file"))) + `(let ((,file (make-temp-file "emacs-test-"))) + (unwind-protect + (let ((,var ,file)) + ,@body) + (delete-file ,file))))) + +(defmacro process-tests--with-temp-directory (var &rest body) + "Bind VAR to the name of a new directory and evaluate BODY. +Afterwards, delete the directory." + (declare (indent 1) (debug (symbolp body))) + (cl-check-type var symbol) + (let ((dir (make-symbol "dir"))) + `(let ((,dir (make-temp-file "emacs-test-" :dir))) + (unwind-protect + (let ((,var ,dir)) + ,@body) + (delete-directory ,dir :recursive))))) + +;; Tests for FD_SETSIZE overflow (Bug#24325). The following tests +;; generate lots of process objects of the various kinds. Running the +;; tests with assertions enabled should not result in any crashes due +;; to file descriptor set overflow. These tests first generate lots +;; of unused pipe processes to fill up the file descriptor space. +;; Then, they create a few instances of the process type under test. + +(ert-deftest process-tests/fd-setsize-no-crash/make-process () "Check that Emacs doesn't crash when trying to use more than FD_SETSIZE file descriptors (Bug#24325)." - (with-timeout (60) - (let ((sleep (executable-find "sleep")) - ;; FD_SETSIZE is typically 1024 on Unix-like systems. - ;; On MS-Windows we artificially limit FD_SETSIZE to 64, - ;; see the commentary in w32proc.c. - (fd-setsize (if (eq system-type 'windows-nt) 64 1024)) - ;; `make-process' allocates at least four file descriptors per process - ;; when using the pipe communication method. However, it closes two of - ;; them in the parent process, so we end up with only two new - ;; descriptors per process. - (fds-per-process 2) - (processes ())) - (skip-unless sleep) - ;; Start processes until we exhaust the file descriptor set size. - (dotimes (i (1+ (/ fd-setsize fds-per-process))) - (let ((process - ;; Failure to allocate more file descriptors should signal - ;; `file-error', but not crash. Since we don't know the exact - ;; limit, we ignore `file-error'. - (ignore-error 'file-error - (make-process :name (format "test %d" i) - :buffer nil - :command (list sleep "5") - :coding 'no-conversion - :noquery t - :connection-type 'pipe)))) - (when process (push process processes)))) - ;; We should have managed to start at least one process. - (should processes) - (dolist (process processes) - (while (accept-process-output process)) - (should (eq (process-status process) 'exit)) - (should (eql (process-exit-status process) 0)) - (delete-process process))))) + (with-timeout (60 (ert-fail "Test timed out")) + (let ((sleep (executable-find "sleep"))) + (skip-unless sleep) + (dolist (conn-type '(pipe pty)) + (ert-info ((format "Connection type `%s'" conn-type)) + (process-tests--with-many-pipes + (process-tests--with-processes processes + ;; Start processes until we exhaust the file descriptor + ;; set size. We assume that each process requires at + ;; least one file descriptor. + (dotimes (i 10) + (let ((process + ;; Failure to allocate more file descriptors + ;; should signal `file-error', but not crash. + ;; Since we don't know the exact limit, we + ;; ignore `file-error'. + (process-tests--ignore-EMFILE + (make-process :name (format "test %d" i) + :command (list sleep "5") + :connection-type conn-type + :coding 'no-conversion + :noquery t)))) + (when process (push process processes)))) + ;; We should have managed to start at least one process. + (should processes) + (dolist (process processes) + (while (accept-process-output process)) + (should (eq (process-status process) 'exit)) + (should (eql (process-exit-status process) 0)))))))))) + +(ert-deftest process-tests/fd-setsize-no-crash/make-pipe-process () + "Check that Emacs doesn't crash when trying to use more than +FD_SETSIZE file descriptors (Bug#24325)." + (with-timeout (60 (ert-fail "Test timed out")) + (process-tests--with-many-pipes + (process-tests--with-buffers buffers + (process-tests--with-processes processes + ;; Start processes until we exhaust the file descriptor set + ;; size. We assume that each process requires at least one + ;; file descriptor. + (dotimes (i 10) + (let ((buffer (generate-new-buffer (format " *%d*" i)))) + (push buffer buffers) + (let ((process + ;; Failure to allocate more file descriptors + ;; should signal `file-error', but not crash. + ;; Since we don't know the exact limit, we ignore + ;; `file-error'. + (process-tests--ignore-EMFILE + (make-pipe-process :name (format "test %d" i) + :buffer buffer + :coding 'no-conversion + :noquery t)))) + (when process (push process processes))))) + ;; We should have managed to start at least one process. + (should processes)))))) + +(ert-deftest process-tests/fd-setsize-no-crash/make-network-process () + "Check that Emacs doesn't crash when trying to use more than +FD_SETSIZE file descriptors (Bug#24325)." + (skip-unless (featurep 'make-network-process '(:server t))) + (skip-unless (featurep 'make-network-process '(:family local))) + (with-timeout (60 (ert-fail "Test timed out")) + (process-tests--with-temp-directory directory + (process-tests--with-processes processes + (let* ((num-clients 10) + (socket-name (expand-file-name "socket" directory)) + ;; Run a UNIX server to connect to. + (server (make-network-process :name "server" + :server num-clients + :buffer nil + :service socket-name + :family 'local + :coding 'no-conversion + :noquery t))) + (push server processes) + (process-tests--with-many-pipes + ;; Start processes until we exhaust the file descriptor + ;; set size. We assume that each process requires at + ;; least one file descriptor. + (dotimes (i num-clients) + (let ((client + ;; Failure to allocate more file descriptors + ;; should signal `file-error', but not crash. + ;; Since we don't know the exact limit, we ignore + ;; `file-error'. + (process-tests--ignore-EMFILE + (make-network-process + :name (format "client %d" i) + :service socket-name + :family 'local + :coding 'no-conversion + :noquery t)))) + (when client (push client processes)))) + ;; We should have managed to start at least one process. + (should processes))))))) + +(ert-deftest process-tests/fd-setsize-no-crash/make-serial-process () + "Check that Emacs doesn't crash when trying to use more than +FD_SETSIZE file descriptors (Bug#24325)." + (with-timeout (60 (ert-fail "Test timed out")) + (skip-unless (file-executable-p shell-file-name)) + (skip-unless (executable-find "tty")) + (skip-unless (executable-find "sleep")) + ;; `process-tests--new-pty' probably only works with GNU Bash. + (skip-unless (string-equal + (file-name-nondirectory shell-file-name) "bash")) + (process-tests--with-processes processes + ;; In order to use `make-serial-process', we need to create some + ;; pseudoterminals. The easiest way to do that is to start a + ;; normal process using the `pty' connection type. We need to + ;; ensure that the terminal stays around while we connect to it. + ;; Create the host processes before the dummy pipes so we have a + ;; high chance of succeeding here. + (let ((tty-names ())) + (dotimes (_ 10) + (cl-destructuring-bind + (host tty-name) (process-tests--new-pty) + (should (processp host)) + (push host processes) + (should tty-name) + (should (file-exists-p tty-name)) + (push tty-name tty-names))) + (process-tests--with-many-pipes + (process-tests--with-processes processes + (process-tests--with-buffers buffers + (dolist (tty-name tty-names) + (let ((buffer (generate-new-buffer + (format " *%s*" tty-name)))) + (push buffer buffers) + ;; Failure to allocate more file descriptors should + ;; signal `file-error', but not crash. Since we + ;; don't know the exact limit, we ignore + ;; `file-error'. + (let ((process (process-tests--ignore-EMFILE + (make-serial-process + :name (format "test %s" tty-name) + :port tty-name + :speed 9600 + :buffer buffer + :coding 'no-conversion + :noquery t)))) + (when process (push process processes)))))) + ;; We should have managed to start at least one process. + (should processes))))))) + +(defvar process-tests--EMFILE-message :unknown + "Cached result of the function `process-tests--EMFILE-message'.") + +(defun process-tests--EMFILE-message () + "Return the error message for the EMFILE POSIX error. +Return nil if that can't be determined." + (when (eq process-tests--EMFILE-message :unknown) + (setq process-tests--EMFILE-message + (with-temp-buffer + (when (eql (call-process "errno" nil t nil "EMFILE") 0) + (goto-char (point-min)) + (when (looking-at (rx "EMFILE" (+ blank) (+ digit) + (+ blank) (group (+ nonl)))) + (match-string-no-properties 1)))))) + process-tests--EMFILE-message) + +(defun process-tests--new-pty () + "Allocate a new pseudoterminal. +Return a list (PROCESS TTY-NAME)." + ;; The command below will typically only work with GNU Bash. + (should (string-equal (file-name-nondirectory shell-file-name) + "bash")) + (process-tests--with-temp-file temp-file + (should-not (file-remote-p temp-file)) + (let* ((command (list shell-file-name shell-command-switch + (format "tty > %s && sleep 60" + (shell-quote-argument + (file-name-unquote temp-file))))) + (process (make-process :name "tty host" + :command command + :buffer nil + :coding 'utf-8-unix + :connection-type 'pty + :noquery t)) + (tty-name nil) + (coding-system-for-read 'utf-8-unix) + (coding-system-for-write 'utf-8-unix)) + ;; Wait until TTY name has arrived. + (with-timeout (2 (message "Timed out waiting for TTY name")) + (while (and (process-live-p process) (not tty-name)) + (sleep-for 0.1) + (when-let ((attributes (file-attributes temp-file))) + (when (cl-plusp (file-attribute-size attributes)) + (with-temp-buffer + (insert-file-contents temp-file) + (goto-char (point-max)) + ;; `tty' has printed a trailing newline. + (skip-chars-backward "\n") + (unless (bobp) + (setq tty-name (buffer-substring-no-properties + (point-min) (point))))))))) + (list process tty-name)))) (provide 'process-tests) ;;; process-tests.el ends here