Manually limit file descriptors that we select on to FD_SETSIZE.

This works even if another thread or process resets the resource limit
for open file descriptors, e.g., using 'prlimit' on GNU/Linux.

* src/process.c (create_process, create_pty, Fmake_pipe_process)
(Fmake_serial_process, connect_network_socket)
(server_accept_connection): Limit file descriptors to FD_SETSIZE.
* test/src/process-tests.el (process-tests--with-raised-rlimit): New
helper macro.
(process-tests--fd-setsize-test): Rename from
'process-tests--with-many-pipes'.  Increase resource limit during test
if possible.
(process-tests/fd-setsize-no-crash/make-process)
(process-tests/fd-setsize-no-crash/make-pipe-process)
(process-tests/fd-setsize-no-crash/make-network-process)
(process-tests--new-pty): Rename callers.

2 files changed, 96 insertions, 29 deletions

diff --git a/src/process.c b/src/process.c
index 7c56366d8e1..ba2bb3c9e46 100644
--- a/src/process.c
+++ b/src/process.c
@@ -2114,6 +2114,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
         }
     }
 
+  if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
+    report_file_errno ("Creating pipe", Qnil, EMFILE);
+
 #ifndef WINDOWSNT
   if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
     report_file_error ("Creating pipe", Qnil);
@@ -2210,6 +2213,8 @@ create_pty (Lisp_Object process)
   if (pty_fd >= 0)
     {
       p->open_fd[SUBPROCESS_STDIN] = pty_fd;
+      if (FD_SETSIZE <= pty_fd)
+        report_file_errno ("Opening pty", Qnil, EMFILE);
 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
       /* On most USG systems it does not work to open the pty's tty here,
          then close it and reopen it in the child.  */
@@ -2317,6 +2322,9 @@ usage:  (make-pipe-process &rest ARGS)  */)
   outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
   inchannel = p->open_fd[READ_FROM_SUBPROCESS];
 
+  if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
+    report_file_errno ("Creating pipe", Qnil, EMFILE);
+
   fcntl (inchannel, F_SETFL, O_NONBLOCK);
   fcntl (outchannel, F_SETFL, O_NONBLOCK);
 
@@ -3059,6 +3067,8 @@ usage:  (make-serial-process &rest ARGS)  */)
 
   fd = serial_open (port);
   p->open_fd[SUBPROCESS_STDIN] = fd;
+  if (FD_SETSIZE <= fd)
+    report_file_errno ("Opening serial port", Qnil, EMFILE);
   p->infd = fd;
   p->outfd = fd;
   if (fd > max_desc)
@@ -3280,6 +3290,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
   if (!NILP (use_external_socket_p))
     {
       socket_to_use = external_sock_fd;
+      eassert (socket_to_use < FD_SETSIZE);
 
       /* Ensure we don't consume the external socket twice.  */
       external_sock_fd = -1;
@@ -3321,6 +3332,13 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
               xerrno = errno;
               continue;
             }
+          if (FD_SETSIZE <= s)
+            {
+              emacs_close (s);
+              s = -1;
+              xerrno = EMFILE;
+              continue;
+            }
         }
 
       if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
@@ -4782,6 +4800,13 @@ server_accept_connection (Lisp_Object server, int channel)
 
   s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
 
+  if (FD_SETSIZE <= s)
+    {
+      emacs_close (s);
+      s = -1;
+      errno = EMFILE;
+    }
+
   if (s < 0)
     {
       int code = errno;
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 590f72f9b03..eee8636067c 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -426,11 +426,52 @@ add some process objects to VAR."
          ,(macroexp-progn body)
        (mapc #'delete-process ,var))))
 
-(defmacro process-tests--with-many-pipes (&rest body)
-  "Generate lots of pipe processes.
+(defmacro process-tests--with-raised-rlimit (&rest body)
+  "Evaluate BODY using a higher limit for the number of open files.
+Attempt to set the resource limit for the number of open files
+temporarily to the highest possible value."
+  (declare (indent 0) (debug t))
+  (let ((prlimit (make-symbol "prlimit"))
+        (soft (make-symbol "soft"))
+        (hard (make-symbol "hard"))
+        (pid-arg (make-symbol "pid-arg")))
+    `(let ((,prlimit (executable-find "prlimit"))
+           (,pid-arg (format "--pid=%d" (emacs-pid)))
+           (,soft nil) (,hard nil))
+       (cl-flet ((set-limit
+                  (value)
+                  (cl-check-type value natnum)
+                  (when ,prlimit
+                    (call-process ,prlimit nil nil nil
+                                  ,pid-arg
+                                  (format "--nofile=%d:" value)))))
+         (when ,prlimit
+           (with-temp-buffer
+             (when (eql (call-process ,prlimit nil t nil
+                                      ,pid-arg "--nofile"
+                                      "--raw" "--noheadings"
+                                      "--output=SOFT,HARD")
+                        0)
+               (goto-char (point-min))
+               (when (looking-at (rx (group (+ digit)) (+ blank)
+                                     (group (+ digit)) ?\n))
+                 (setq ,soft (string-to-number
+                              (match-string-no-properties 1))
+                       ,hard (string-to-number
+                              (match-string-no-properties 2))))))
+           (and ,soft ,hard (< ,soft ,hard)
+                (set-limit ,hard)))
+         (unwind-protect
+             ,(macroexp-progn body)
+           (when ,soft (set-limit ,soft)))))))
+
+(defmacro process-tests--fd-setsize-test (&rest body)
+  "Run BODY as a test for FD_SETSIZE overflow.
 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."
+descriptors should still be available.  Furthermore, raise the
+maximum number of open files in the Emacs process above
+FD_SETSIZE."
   (declare (indent 0) (debug t))
   (let ((process (make-symbol "process"))
         (processes (make-symbol "processes"))
@@ -440,28 +481,29 @@ descriptors should still be available."
         ;; 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))))
+    `(process-tests--with-raised-rlimit
+       (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.
@@ -502,7 +544,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
       (skip-unless sleep)
       (dolist (conn-type '(pipe pty))
         (ert-info ((format "Connection type `%s'" conn-type))
-          (process-tests--with-many-pipes
+          (process-tests--fd-setsize-test
             (process-tests--with-processes processes
               ;; Start processes until we exhaust the file descriptor
               ;; set size.  We assume that each process requires at
@@ -538,7 +580,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
   "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--fd-setsize-test
       (process-tests--with-buffers buffers
         (process-tests--with-processes processes
           ;; Start processes until we exhaust the file descriptor set
@@ -580,7 +622,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
                                              :coding 'no-conversion
                                              :noquery t)))
           (push server processes)
-          (process-tests--with-many-pipes
+          (process-tests--fd-setsize-test
             ;; Start processes until we exhaust the file descriptor
             ;; set size.  We assume that each process requires at
             ;; least one file descriptor.
@@ -627,7 +669,7 @@ FD_SETSIZE file descriptors (Bug#24325)."
             (should tty-name)
             (should (file-exists-p tty-name))
             (push tty-name tty-names)))
-        (process-tests--with-many-pipes
+        (process-tests--fd-setsize-test
           (process-tests--with-processes processes
             (process-tests--with-buffers buffers
               (dolist (tty-name tty-names)