[bug#65221] [PATCH 0/2] Fix EXTRA-PORTS edge cases

[bug#65221] [PATCH 0/2] Fix EXTRA-PORTS edge cases

[ulfvonbelow]

The #:extra-ports argument to exec-command and its users behaves quite
strangely in certain circumstances, for example when multiple ports are
supplied, and they are supplied in an order other than by ascending file
descriptor number.  This can cause file descriptors to be clobbered.

ulfvonbelow (2):
  service: make EXTRA-PORTS work as advertised.
  service: use PRESERVE-PORTS for redirecting FDs 0-2.

 modules/shepherd/service.scm | 119 ++++++++++++++++++++++-------------
 1 file changed, 76 insertions(+), 43 deletions(-)

-- 
2.40.1

[bug#65221] [PATCH 1/2] service: make EXTRA-PORTS work as advertised.

[ulfvonbelow]

EXEC-COMMAND (and, by extension, FORK+EXEC-COMMAND) has several issues:
1. Despite it being documented that "all other file descriptors are closed
   prior to yielding control to COMMAND", this is not currently the case -
   only other file descriptors that are already marked as FD_CLOEXEC are
   closed.  For example, if user code happens to have a file descriptor open,
   for example with call-with-input-file, while EXEC-COMMAND is run, the new
   process image will inherit that file descriptor.  This may cause some
   resource waste, but more importantly may cause security issues in certain
   situations.
2. EXTRA-PORTS is only honored when either LOG-PORT or LOG-FILE is passed.  I
   have no idea why this is the case, it isn't documented anywhere, and it
   isn't intuitive.
3. Even when LOG-PORT or LOG-FILE is passed, EXTRA-PORTS may not work as
   described, because it copies file descriptor contents in an arbitrary
   order.  For example, suppose that (map fileno EXTRA-PORTS) is (7 6 5 4 3).
   If the underlying file originally stored in fd N is represented by F(N), it
   will assign
   3 <-- F(7)
   4 <-- F(6)
   5 <-- F(5)
   6 <-- F(6)
   7 <-- F(7)

   In other words, the copying of earlier FDs in EXTRA-PORTS may overwrite
   later FDs in EXTRA-PORTS.

Because the process of properly and safely copying those FDs involves many
steps, we've split it, along with marking all file descriptors not being
preserved as FD_CLOEXEC, into a separate procedure named PRESERVE-PORTS.

* modules/shepherd/service.scm (preserve-ports): new procedure.
  (exec-command): use it.
---
 modules/shepherd/service.scm | 119 +++++++++++++++++++++++------------
 1 file changed, 78 insertions(+), 41 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 68553d4..ffbd03c 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1434,6 +1434,52 @@ FILE."
   (list->vector (map (lambda (group) (group:gid (getgr group)))
                      supplementary-groups)))
 
+(define (preserve-ports extra-ports)
+  "Duplicate the FDs (fd1 fd2 ... fdN) corresponding to the N ports in
+EXTRA-PORTS into the FD range (3 4 ... 3+N).  This will work regardless of the
+numeric values of fd1 ... fdN.  Any open file descriptors not in EXTRA-PORTS
+and numbered 3 or higher WILL be closed or marked FD_CLOEXEC."
+  ;; We employ the following strategy: copy FDs as high as possible, in
+  ;; descending order of FD, so as to avoid clobbering, then copy the high FDs
+  ;; to low FDs, in the order specified in EXTRA-PORTS.  If more than half of
+  ;; the FD range is included in EXTRA-PORTS, this still won't work, and we
+  ;; may reach a point where copying low will require us to copy the
+  ;; still-uncopied FDs high again.  This should be sufficiently rare as to
+  ;; not be a concern.
+  (let* ((max-fds-count (max-file-descriptors))
+         (highest-fd (- max-fds-count 1))
+         (extra-fds-count (length extra-ports))
+         (preserved-fds-count (+ 3 extra-fds-count))
+         (extra-fds (map fileno extra-ports))
+         (index+fd (map cons
+                        (iota extra-fds-count)
+                        extra-fds))
+         (index+fd-by-fileno (sort index+fd
+                                   (lambda (pair1 pair2)
+                                     (> (cdr pair1)
+                                        (cdr pair2)))))
+         (index2+fd-by-fileno (map cons
+                                   (iota extra-fds-count)
+                                   index+fd-by-fileno))
+         (index2+fd (sort index2+fd-by-fileno
+                          (lambda (spec1 spec2)
+                            (< (second spec1) (second spec2))))))
+    (for-each dup2
+              (map cdr index+fd-by-fileno)
+              (iota extra-fds-count highest-fd -1))
+    (for-each (match-lambda
+                ((by-fileno-index original-index . original-fd)
+                 (dup2 (- highest-fd by-fileno-index)
+                       (+ 3 original-index))))
+              index2+fd)
+    (for-each (lambda (fd)
+                (catch-system-error
+                 (let ((flags (fcntl fd F_GETFD)))
+                   (when (zero? (logand flags FD_CLOEXEC))
+                     (fcntl fd F_SETFD (logior FD_CLOEXEC flags))))))
+              (iota (- max-fds-count preserved-fds-count)
+                    preserved-fds-count))))
+
 (define* (exec-command command
                        #:key
                        (user #f)
@@ -1479,48 +1525,39 @@ false."
      (chdir directory)
      (environ environment-variables)
 
-     ;; Close all the file descriptors except stdout and stderr.
-     (let ((max-fd (max-file-descriptors)))
+     ;; Redirect stdin.
+     (catch-system-error (close-fdes 0))
+     ;; Make sure file descriptor zero is used, so we don't end up reusing
+     ;; it for something unrelated, which can confuse some packages.
+     (dup2 (if input-port
+               (fileno input-port)
+               (open-fdes "/dev/null" O_RDONLY))
+           0)
 
-       ;; Redirect stdin.
-       (catch-system-error (close-fdes 0))
-       ;; Make sure file descriptor zero is used, so we don't end up reusing
-       ;; it for something unrelated, which can confuse some packages.
-       (dup2 (if input-port
-                 (fileno input-port)
-                 (open-fdes "/dev/null" O_RDONLY))
-             0)
+     (when (or log-port log-file)
+       (catch #t
+         (lambda ()
+           ;; Redirect stdout and stderr to use LOG-FILE.
+           (catch-system-error (close-fdes 1))
+           (catch-system-error (close-fdes 2))
+           (dup2 (if log-file
+                     (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)
+                                #o640)
+                     (fileno log-port))
+                 1)
+           (dup2 1 2))
 
-       (when (or log-port log-file)
-         (catch #t
-           (lambda ()
-             ;; Redirect stout and stderr to use LOG-FILE.
-             (catch-system-error (close-fdes 1))
-             (catch-system-error (close-fdes 2))
-             (dup2 (if log-file
-                       (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)
-                                  #o640)
-                       (fileno log-port))
-                   1)
-             (dup2 1 2)
-
-             ;; Make EXTRA-PORTS available starting from file descriptor 3.
-             ;; This clears their FD_CLOEXEC flag.
-             (let loop ((fd    3)
-                        (ports extra-ports))
-               (match ports
-                 (() #t)
-                 ((port rest ...)
-                  (catch-system-error (close-fdes fd))
-                  (dup2 (fileno port) fd)
-                  (loop (+ 1 fd) rest)))))
-
-           (lambda (key . args)
-             (when log-file
-               (format (current-error-port)
-                       "failed to open log-file ~s:~%" log-file))
-             (print-exception (current-error-port) #f key args)
-             (primitive-exit 1))))
+         (lambda (key . args)
+           (when log-file
+             (format (current-error-port)
+                     "failed to open log-file ~s:~%" log-file))
+           (print-exception (current-error-port) #f key args)
+           (primitive-exit 1))))
+
+     ;; Close all the file descriptors except stdout, stderr, and EXTRA-PORTS.
+     ;; Make EXTRA-PORTS available starting from file descriptor 3.
+     ;; This clears their FD_CLOEXEC flag.
+     (preserve-ports extra-ports)
 
      ;; setgid must be done *before* setuid, otherwise the user will
      ;; likely no longer have permissions to setgid.
@@ -1558,7 +1595,7 @@ false."
          (format (current-error-port)
                  "exec of ~s failed: ~a~%"
                  program (strerror (system-error-errno args)))
-         (primitive-exit 1)))))))
+         (primitive-exit 1))))))
 
 (define %precious-signals
   ;; Signals that the shepherd process handles.
-- 
2.40.1

[bug#65221] [PATCH 2/2] service: use PRESERVE-PORTS for redirecting FDs 0-2.

[ulfvonbelow]

There are currently some corner cases in how EXTRA-PORTS works due to it not
managing FDs 0, 1, and 2.  Specifically, if one were to include a port in
EXTRA-PORTS with FD 0, 1, or 2, it would *not* be preserved, and would instead
represent the file that EXEC-COMMAND assigned to that file descriptor.  To
avoid this, it's necessary to call PRESERVE-PORTS *before* redirecting the
input, but this could clobber LOG-PORT or INPUT-PORT, so it would become
necessary to include LOG-PORT and INPUT-PORT in the call to PRESERVE-PORTS,
then do the redirection using the new FD assignment, then close them.  This
complication can be avoided if we simply let PRESERVE-PORTS itself do the
redirection.  This also solves other edge cases, like if LOG-PORT has fileno 0
or 1 (previously passing a LOG-PORT of (current-output-port) would cause an
error, as the underlying file descriptor would be closed before dup2 was
called to copy it), or if INPUT-PORT has fileno 0.

To solve this, we modify PRESERVE-PORTS to allow both file descriptors and
ports, and to start the range it copies into at 0 instead of 3.  We then
modify EXEC-COMMAND to explicitly pass the desired standard I/O FDs / ports at
the front of the list it passes to PRESERVE-PORTS.

* modules/shepherd/service.scm (preserve-ports): Allow elements of EXTRA-PORTS
  to be either ports or file descriptors.  Start the range of FDs being
  duplicated into at 0 instead of 3.
  (exec-command): use PRESERVE-PORTS for redirecting FDs 0, 1, and 2.
---
 modules/shepherd/service.scm | 74 +++++++++++++++++-------------------
 1 file changed, 35 insertions(+), 39 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index ffbd03c..5f735fe 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1435,10 +1435,10 @@ FILE."
                      supplementary-groups)))
 
 (define (preserve-ports extra-ports)
-  "Duplicate the FDs (fd1 fd2 ... fdN) corresponding to the N ports in
-EXTRA-PORTS into the FD range (3 4 ... 3+N).  This will work regardless of the
+  "Duplicate the FDs (fd0 fd1 ... fdN) corresponding to the N+1 ports or FDs in
+EXTRA-PORTS into the FD range (0 1 ... N).  This will work regardless of the
 numeric values of fd1 ... fdN.  Any open file descriptors not in EXTRA-PORTS
-and numbered 3 or higher WILL be closed or marked FD_CLOEXEC."
+WILL be closed or marked FD_CLOEXEC."
   ;; We employ the following strategy: copy FDs as high as possible, in
   ;; descending order of FD, so as to avoid clobbering, then copy the high FDs
   ;; to low FDs, in the order specified in EXTRA-PORTS.  If more than half of
@@ -1449,8 +1449,9 @@ and numbered 3 or higher WILL be closed or marked FD_CLOEXEC."
   (let* ((max-fds-count (max-file-descriptors))
          (highest-fd (- max-fds-count 1))
          (extra-fds-count (length extra-ports))
-         (preserved-fds-count (+ 3 extra-fds-count))
-         (extra-fds (map fileno extra-ports))
+         (extra-fds (map (lambda (x)
+                           (if (port? x) (fileno x) x))
+                         extra-ports))
          (index+fd (map cons
                         (iota extra-fds-count)
                         extra-fds))
@@ -1470,15 +1471,15 @@ and numbered 3 or higher WILL be closed or marked FD_CLOEXEC."
     (for-each (match-lambda
                 ((by-fileno-index original-index . original-fd)
                  (dup2 (- highest-fd by-fileno-index)
-                       (+ 3 original-index))))
+                       original-index)))
               index2+fd)
     (for-each (lambda (fd)
                 (catch-system-error
                  (let ((flags (fcntl fd F_GETFD)))
                    (when (zero? (logand flags FD_CLOEXEC))
                      (fcntl fd F_SETFD (logior FD_CLOEXEC flags))))))
-              (iota (- max-fds-count preserved-fds-count)
-                    preserved-fds-count))))
+              (iota (- max-fds-count extra-fds-count)
+                    extra-fds-count))))
 
 (define* (exec-command command
                        #:key
@@ -1525,39 +1526,34 @@ false."
      (chdir directory)
      (environ environment-variables)
 
-     ;; Redirect stdin.
-     (catch-system-error (close-fdes 0))
-     ;; Make sure file descriptor zero is used, so we don't end up reusing
-     ;; it for something unrelated, which can confuse some packages.
-     (dup2 (if input-port
-               (fileno input-port)
-               (open-fdes "/dev/null" O_RDONLY))
-           0)
-
-     (when (or log-port log-file)
-       (catch #t
-         (lambda ()
-           ;; Redirect stdout and stderr to use LOG-FILE.
-           (catch-system-error (close-fdes 1))
-           (catch-system-error (close-fdes 2))
-           (dup2 (if log-file
-                     (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)
-                                #o640)
-                     (fileno log-port))
-                 1)
-           (dup2 1 2))
-
-         (lambda (key . args)
-           (when log-file
-             (format (current-error-port)
-                     "failed to open log-file ~s:~%" log-file))
-           (print-exception (current-error-port) #f key args)
-           (primitive-exit 1))))
-
-     ;; Close all the file descriptors except stdout, stderr, and EXTRA-PORTS.
+     ;; Close all the file descriptors except stdin, stdout, stderr, and
+     ;; EXTRA-PORTS.
      ;; Make EXTRA-PORTS available starting from file descriptor 3.
      ;; This clears their FD_CLOEXEC flag.
-     (preserve-ports extra-ports)
+     (let* ( ;; Make sure file descriptor zero is used, so we don't end up reusing
+            ;; it for something unrelated, which can confuse some packages.
+            (stdin (or input-port (open-fdes "/dev/null" O_RDONLY)))
+            (stdout (catch #t
+                      (lambda ()
+                        (or log-port
+                            (and log-file
+                                 (open-fdes log-file
+                                            (logior O_CREAT O_WRONLY O_APPEND)
+                                            #o640))
+                            1))
+                      (lambda (key . args)
+                        (when log-file
+                          (format (current-error-port)
+                                  "failed to open log-file ~s:~%" log-file))
+                        (print-exception (current-error-port) #f key args)
+                        (primitive-exit 1))))
+            (stderr (if (or log-port log-file)
+                        stdout
+                        2)))
+       (preserve-ports (cons* stdin
+                              stdout
+                              stderr
+                              extra-ports)))
 
      ;; setgid must be done *before* setuid, otherwise the user will
      ;; likely no longer have permissions to setgid.
-- 
2.40.1

[bug#65221] [PATCH 0/2] Fix EXTRA-PORTS edge cases

[Ludovic Courtès]

Hi,

ulfvonbelow <striness@tilde.club> skribis:

> EXEC-COMMAND (and, by extension, FORK+EXEC-COMMAND) has several issues:
> 1. Despite it being documented that "all other file descriptors are closed
>    prior to yielding control to COMMAND", this is not currently the case -
>    only other file descriptors that are already marked as FD_CLOEXEC are
>    closed.  For example, if user code happens to have a file descriptor open,
>    for example with call-with-input-file, while EXEC-COMMAND is run, the new
>    process image will inherit that file descriptor.  This may cause some
>    resource waste, but more importantly may cause security issues in certain
>    situations.

Yes.  This has been the case since 0.9.2, as noted in ‘NEWS’:

  Previously, services started indirectly with ‘exec-command’ (which is usually
  the case) would not inherit any file descriptor from shepherd because
  ‘exec-command’ would explicitly close all of them.  However, services started
  with ‘make-system-constructor’ and processes created by some other means, such
  as calling ‘system*’, would inherit some of those descriptors, giving them
  more authority than intended.

  The change here consists in marking all internally-used file descriptors as
  “close-on-exec” (O_CLOEXEC), a feature that’s been available on GNU/Linux and
  GNU/Hurd for years but that so far wasn’t used consistently in shepherd.  This
  is now fixed.  As a side-effect, the file-descriptor-closing loop in
  ‘exec-command’ is now gone.

The FD-closing loop was removed on purpose, in
2c0354258047133db8b885bcc11afdf0def5d885.

Now, as you write, it means that service writers must be careful now and
not leave any non-CLOEXEC file descriptor behind them.

At the time I audited Guix System to check that this was a reasonable
thing to expect and that we could indeed ensure no file descriptors were
leaked.  There’s also ‘tests/close-on-exec.sh’.

If you found cases where it would be necessary, what we could do is have
‘shepherd’ replace ‘call-with-input-file’ & co. with a variant that
opens files as O_CLOEXEC by default.  WDYT?

> 2. EXTRA-PORTS is only honored when either LOG-PORT or LOG-FILE is passed.  I
>    have no idea why this is the case, it isn't documented anywhere, and it
>    isn't intuitive.

#:extra-ports wasn’t really made to be exposed I guess; it was added for
use by systemd-style services in 965f6b61a473ee57a1fc6ec3ea1ad6e35d596031.

> 3. Even when LOG-PORT or LOG-FILE is passed, EXTRA-PORTS may not work as
>    described, because it copies file descriptor contents in an arbitrary
>    order.  For example, suppose that (map fileno EXTRA-PORTS) is (7 6 5 4 3).
>    If the underlying file originally stored in fd N is represented by F(N), it
>    will assign
>    3 <-- F(7)
>    4 <-- F(6)
>    5 <-- F(5)
>    6 <-- F(6)
>    7 <-- F(7)
>
>    In other words, the copying of earlier FDs in EXTRA-PORTS may overwrite
>    later FDs in EXTRA-PORTS.

Good catch!

Could you make a more minimal patch fixing this specific issue, also
adding a test reproducing the problem being fixed?

Thanks for your work!

Ludo’.

[bug#65221] [PATCH 0/2] Fix EXTRA-PORTS edge cases

[Ulf Herrman]

[-- Attachment #1: Type: text/plain, Size: 4948 bytes --]

Ludovic Courtès <ludo@gnu.org> writes:

>  Previously, services started indirectly with ‘exec-command’ (which is usually
>  the case) would not inherit any file descriptor from shepherd because
>  ‘exec-command’ would explicitly close all of them.  However, services started
>  with ‘make-system-constructor’ and processes created by some other means, such
>  as calling ‘system*’, would inherit some of those descriptors, giving them
>  more authority than intended.

Interestingly enough, guile's system* closes all file descriptors aside
from the first 3, and we now provide a replacement for system* that uses
fork+exec-command and therefore does not.

> The FD-closing loop was removed on purpose, in
> 2c0354258047133db8b885bcc11afdf0def5d885.
>
> Now, as you write, it means that service writers must be careful now and
> not leave any non-CLOEXEC file descriptor behind them.
>
> At the time I audited Guix System to check that this was a reasonable
> thing to expect and that we could indeed ensure no file descriptors were
> leaked.  There’s also ‘tests/close-on-exec.sh’.
>
> If you found cases where it would be necessary, what we could do is have
> ‘shepherd’ replace ‘call-with-input-file’ & co. with a variant that
> opens files as O_CLOEXEC by default.  WDYT?
The problem is that there isn't a way for the user to replicate the old
behavior of default-non-inheriting short of wrapping the desired command
with another file-descriptor-closing program, by which point the user
and group may already have been changed.

O_CLOEXEC is good, but to use it to prevent leaks to any particular
program is a matter of global correctness, while closing everything not
explicitly allowed for a program is a matter of local correctness.  For
example, if I have a program whose quality (and, to some extent,
trustworthiness) I am wary of, I would really prefer to be certain that
it doesn't get any file descriptors it shouldn't.  The only way to be
certain of this currently is to examine the entire shepherd process -
including all services - to be sure there aren't any leaks.

Replacing 'call-with-input-file' and such - as I now see is done in
guix's shepherd config file - would probably be a good idea (I see we
use call-with-input-file in primitive-load* and read-pid-file, for
example), but it's still no guarantee.

For example, I didn't even know SOCK_CLOEXEC was a thing, and so didn't
use it in one of my services that calls socketpair.  I did use fcntl
afterward, but the time between those two introduces all kinds of
questions, like "have you called system, system*, spawn-command, sleep,
done any I/O, or had the misfortune to receive a SIGCHLD on a system
without signalfd support".

And if I hadn't happened to have looked at the source of exec-command, I
wouldn't have even tried fcntl, because the manual entry for
fork+exec-command and exec-command still clearly states:

  File descriptors 1 and 2 are kept as is or redirected to either
  LOG-PORT or LOG-FILE if it’s true, whereas file descriptor 0 (standard
  input) points to INPUT-PORT or ‘/dev/null’; all other file descriptors
  are closed prior to yielding control to COMMAND.

Whatever course of action is taken, it is imperative that the
documentation and code be aligned on this matter.  Personally I'm
inclined to bring the code in line with the documentation.

>>    In other words, the copying of earlier FDs in EXTRA-PORTS may overwrite
>>    later FDs in EXTRA-PORTS.
>
> Good catch!
>
> Could you make a more minimal patch fixing this specific issue, also
> adding a test reproducing the problem being fixed?

I'm sending a more granular v2 series that adds the requested test,
fixes the clobbering, makes extra-ports be honored regardless of the
values of log-port and log-file, fixes edge cases around file
descriptors 0-2, and finally adds support for closing all other file
descriptors to exec-command.  That last one also makes closing all other
file descriptors the default, mostly because it makes the most sense for
the default value of extra-ports, and otherwise I'd have to update the
manual.  It does include the option of #:extra-ports #t, though, in
which case no fds are closed.

One alternative would be to have the close-all-others behavior
controlled by an independent argument; that way the file descriptor
rearranging functionality can be independent of whether other file
descriptors are closed.

Speaking of file descriptor rearranging functionality, the v2 replaces
'preserve-ports' with 'reconfigure-fds', which uses a different,
graph-based approach to avoiding clobbering while using fewer system
calls.  It's also more robust, and will function as long as there is
even a single unused file descriptor, and won't touch any open file
descriptors other than those in the target range.

- ulfvonbelow

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 686 bytes --]

[bug#65221] [PATCH 1/6] tests: add extra-ports.sh test.

[ulfvonbelow]

* tests/extra-ports.sh: new test.
---
 tests/extra-ports.sh | 76 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 76 insertions(+)
 create mode 100644 tests/extra-ports.sh

diff --git a/tests/extra-ports.sh b/tests/extra-ports.sh
new file mode 100644
index 0000000..51b91b7
--- /dev/null
+++ b/tests/extra-ports.sh
@@ -0,0 +1,76 @@
+socket="t-socket-$$"
+conf="t-conf-$$"
+log="t-log-$$"
+pid="t-pid-$$"
+testfile1="t-testfile1-$$"
+testfile2="t-testfile2-$$"
+resultfile="t-resultfile-$$"
+
+herd="herd -s $socket"
+
+trap "cat $log || true;
+      rm -f $socket $conf $log $testfile1 $testfile2 $resultfile;
+      test -f $pid && kill \`cat $pid\` || true; rm -f $pid" EXIT
+
+printf "test1" > "$testfile1"
+printf "test2" > "$testfile2"
+
+cat > "$conf"<<EOF
+(register-services
+ (list (service
+        '(test-extra-ports)
+        #:requirement '()
+        #:start (lambda _
+                  (call-with-input-file "$testfile1"
+                    (lambda (test1)
+                      (call-with-input-file "$testfile2"
+                        (lambda (test2)
+                          ;; test1 and test2 should hopefully have adjacent fds
+                          (define ports
+                            (append
+                             ;; Fill up the fd range so that the source and
+                             ;; destination ranges overlap
+                             (map (const test1)
+                                  (iota (- (min (fileno test1)
+                                                (fileno test2))
+                                           3)))
+                             (sort (list test1 test2)
+                                   (lambda (a b)
+                                     (> (fileno a)
+                                        (fileno b))))))
+
+                          (define command
+                            (list
+                             "sh"
+                             "-c"
+                             (string-append
+                              "set -x;"
+                              " cat >> ${resultfile}.tmp <&" (number->string
+                                                              (fileno test1))
+                              "; cat >> ${resultfile}.tmp <&" (number->string
+                                                               (fileno test2))
+                              "; mv ${resultfile}.tmp ${resultfile}")))
+
+                          (fork+exec-command command
+                                             #:extra-ports
+                                             ports
+                                             #:directory
+                                             "$(pwd)"))))))
+        #:stop (const #f)
+        #:respawn? #f)))
+EOF
+
+rm -f "$pid"
+shepherd -I -s "$socket" -c "$conf" -l "$log" --pid="$pid" &
+
+while ! test -f "$pid" ; do sleep 0.3 ; done
+
+shepherd_pid="`cat $pid`"
+kill -0 $shepherd_pid
+
+$herd start test-extra-ports
+
+while ! test -f "$resultfile" ; do sleep 0.3 ; done
+
+result="$(cat $resultfile)"
+test "$result" = "test1test2" -o "$result" = "test2test1"
-- 
2.40.1

[bug#65221] [PATCH 2/6] service: don't let earlier ports clobber later ones in EXTRA-PORTS.

[ulfvonbelow]

In some situations, EXTRA-PORTS may not work as described, because it copies
file descriptor contents in an arbitrary order.  For example, suppose
that (map fileno EXTRA-PORTS) is (7 6 5 4 3).  If the underlying file
originally stored in fd N is represented by F(N), it will assign

3 <-- F(7)
4 <-- F(6)
5 <-- F(5)
6 <-- F(6)
7 <-- F(7)

In other words, the copying of earlier FDs in EXTRA-PORTS may overwrite later
FDs in EXTRA-PORTS.

Because the process of properly and safely copying those FDs involves some
complexity, we've split it into a separate procedure named PRESERVE-PORTS.

* modules/shepherd/service.scm (reconfigure-ports): new procedure.
  (exec-command): use it.
---
 modules/shepherd/service.scm | 154 +++++++++++++++++++++++++----------
 1 file changed, 113 insertions(+), 41 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 68553d4..68993ac 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1434,6 +1434,88 @@ FILE."
   (list->vector (map (lambda (group) (group:gid (getgr group)))
                      supplementary-groups)))
 
+(define* (reconfigure-fds ports-or-fds #:optional (base 0))
+  "Duplicate the FDs (fd0 fd1 ... fdN) corresponding to the N ports or FDs in
+EXTRA-PORTS into the FD range (0 1 ... N), clearing their FD_CLOEXEC flag at
+the same time.  This will work regardless of the numeric values of fd1
+... fdN.  File descriptors outside of the range 0..N will not be affected.
+This may fail if there are zero unused file descriptors."
+  ;; If we view each FD as a node, and fd n at index k of FDS as an edge from
+  ;; fd n to fd k, then we have a rather special type of graph.  Because of
+  ;; how the edges must be specified, it has the property that no node can
+  ;; have more than one parent, like a tree, but unlike a tree it is possible
+  ;; to have cycles (combined with the prior restriction, this means a given
+  ;; node can be part of at most one cycle).  I don't know of a good name for
+  ;; that kind of graph - maybe "rootless tree"?  Anyway, our approach is to,
+  ;; for each unique FD in FDS, do a traversal that both finds the cyclic
+  ;; path, if it exists, and sets every FD that isn't part of the cycle, then
+  ;; finally resolve the cycle using a temporary fd.
+
+  (define fds (map (lambda (x)
+                     (if (port? x) (fileno x) x))
+                   ports-or-fds))
+  (define max-fd (apply max 0 fds))
+  (define fd->targets
+    (let ((vec (make-vector (+ 1 max-fd) '())))
+      (for-each (lambda (source-fd dest-fd)
+                  (vector-set! vec source-fd
+                               (cons dest-fd
+                                     (vector-ref vec source-fd))))
+                fds
+                (iota (length fds) base))
+      vec))
+  (define visited (make-vector (+ 1 max-fd) #f))
+
+  (define (rotate-fds! fds)
+    ;; (fdval1 fdval2 fdval3) --> (fdval3 fdval1 fdval2)
+    (match (reverse fds)
+      ((fd0)
+       ;; Clear close-on-exec flag as if it were dup2'ed.
+       (fcntl fd0 F_SETFD 0))
+      ((fd0 . (and rest (fd1 . _)))
+       (let ((tmp-fd (dup->fdes fd0)))
+         (let loop ((fds rest)
+                    (prev fd0))
+           (match fds
+             ((fd . rest)
+              (dup2 fd prev)
+              (loop rest fd))
+             (()
+              (dup2 tmp-fd prev)
+              (close-fdes tmp-fd))))))))
+
+  (define (top-visit fd)
+    (let ((cycle (visit fd fd)))
+      (when cycle
+        (rotate-fds! cycle))))
+
+  (define (visit fd cycle-start-fd)
+    (if (vector-ref visited fd)
+        #f
+        (begin
+          (vector-set! visited fd #t)
+          (let loop ((targets (vector-ref fd->targets fd))
+                     (cycle-tail #f))
+            (match targets
+              ((target . rest)
+               (cond
+                ((= target cycle-start-fd)
+                 (loop rest (list fd)))
+                ((> target max-fd) ;; Has no targets, no need to visit.
+                 (dup2 fd target)
+                 (loop rest cycle-tail))
+                (else
+                 (let ((maybe-cycle-tail (visit target cycle-start-fd)))
+                   (if maybe-cycle-tail
+                       (loop rest (cons fd maybe-cycle-tail))
+                       (begin
+                         (dup2 fd target)
+                         (loop rest cycle-tail)))))))
+              (()
+               cycle-tail))))))
+
+  (for-each top-visit fds))
+
 (define* (exec-command command
                        #:key
                        (user #f)
@@ -1479,48 +1561,38 @@ false."
      (chdir directory)
      (environ environment-variables)
 
-     ;; Close all the file descriptors except stdout and stderr.
-     (let ((max-fd (max-file-descriptors)))
+     ;; Redirect stdin.
+     (catch-system-error (close-fdes 0))
+     ;; Make sure file descriptor zero is used, so we don't end up reusing
+     ;; it for something unrelated, which can confuse some packages.
+     (dup2 (if input-port
+               (fileno input-port)
+               (open-fdes "/dev/null" O_RDONLY))
+           0)
 
-       ;; Redirect stdin.
-       (catch-system-error (close-fdes 0))
-       ;; Make sure file descriptor zero is used, so we don't end up reusing
-       ;; it for something unrelated, which can confuse some packages.
-       (dup2 (if input-port
-                 (fileno input-port)
-                 (open-fdes "/dev/null" O_RDONLY))
-             0)
+     (when (or log-port log-file)
+       (catch #t
+         (lambda ()
+           ;; Redirect stdout and stderr to use LOG-FILE.
+           (catch-system-error (close-fdes 1))
+           (catch-system-error (close-fdes 2))
+           (dup2 (if log-file
+                     (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)
+                                #o640)
+                     (fileno log-port))
+                 1)
+           (dup2 1 2)
+
+           ;; Make EXTRA-PORTS available starting from file descriptor 3.
+           ;; This clears their FD_CLOEXEC flag.
+           (reconfigure-fds extra-ports 3))
 
-       (when (or log-port log-file)
-         (catch #t
-           (lambda ()
-             ;; Redirect stout and stderr to use LOG-FILE.
-             (catch-system-error (close-fdes 1))
-             (catch-system-error (close-fdes 2))
-             (dup2 (if log-file
-                       (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)
-                                  #o640)
-                       (fileno log-port))
-                   1)
-             (dup2 1 2)
-
-             ;; Make EXTRA-PORTS available starting from file descriptor 3.
-             ;; This clears their FD_CLOEXEC flag.
-             (let loop ((fd    3)
-                        (ports extra-ports))
-               (match ports
-                 (() #t)
-                 ((port rest ...)
-                  (catch-system-error (close-fdes fd))
-                  (dup2 (fileno port) fd)
-                  (loop (+ 1 fd) rest)))))
-
-           (lambda (key . args)
-             (when log-file
-               (format (current-error-port)
-                       "failed to open log-file ~s:~%" log-file))
-             (print-exception (current-error-port) #f key args)
-             (primitive-exit 1))))
+         (lambda (key . args)
+           (when log-file
+             (format (current-error-port)
+                     "failed to open log-file ~s:~%" log-file))
+           (print-exception (current-error-port) #f key args)
+           (primitive-exit 1))))
 
      ;; setgid must be done *before* setuid, otherwise the user will
      ;; likely no longer have permissions to setgid.
@@ -1558,7 +1630,7 @@ false."
          (format (current-error-port)
                  "exec of ~s failed: ~a~%"
                  program (strerror (system-error-errno args)))
-         (primitive-exit 1)))))))
+         (primitive-exit 1))))))
 
 (define %precious-signals
   ;; Signals that the shepherd process handles.
-- 
2.40.1

[bug#65221] [PATCH 3/6] Makefile.am: enable extra-ports.sh test.

[ulfvonbelow]

* Makefile.am (TESTS): add tests/extra-ports.sh
---
 Makefile.am | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/Makefile.am b/Makefile.am
index fdfcf3d..b2ce46b 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -271,7 +271,8 @@ TESTS =						\
   tests/daemonize.sh				\
   tests/eval-load.sh				\
   tests/services/monitoring.sh			\
-  tests/services/repl.sh
+  tests/services/repl.sh                        \
+  tests/extra-ports.sh
 
 TEST_EXTENSIONS = .sh
 EXTRA_DIST += $(TESTS)
-- 
2.40.1

[bug#65221] [PATCH 4/6] service: honor EXTRA-PORTS regardless of log-port and log-file.

[ulfvonbelow]

EXTRA-PORTS is only honored when either LOG-PORT or LOG-FILE is passed.  I
have no idea why this is the case, it isn't documented anywhere, and it isn't
intuitive.

* modules/shepherd/service.scm (exec-command): Move preserve-ports call
  outside of condition.
---
 modules/shepherd/service.scm | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 68993ac..e816cd1 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1581,11 +1581,7 @@ false."
                                 #o640)
                      (fileno log-port))
                  1)
-           (dup2 1 2)
-
-           ;; Make EXTRA-PORTS available starting from file descriptor 3.
-           ;; This clears their FD_CLOEXEC flag.
-           (reconfigure-fds extra-ports 3))
+           (dup2 1 2))
 
          (lambda (key . args)
            (when log-file
@@ -1594,6 +1590,10 @@ false."
            (print-exception (current-error-port) #f key args)
            (primitive-exit 1))))
 
+     ;; Make EXTRA-PORTS available starting from file descriptor 3.
+     ;; This clears their FD_CLOEXEC flag.
+     (reconfigure-fds extra-ports 3)
+
      ;; setgid must be done *before* setuid, otherwise the user will
      ;; likely no longer have permissions to setgid.
      (when group
-- 
2.40.1

[bug#65221] [PATCH 5/6] service: use RECONFIGURE-FDS for redirecting FDs 0-2.

[ulfvonbelow]

There are currently some corner cases in how EXTRA-PORTS works due to it not
managing FDs 0, 1, and 2.  Specifically, if one were to include a port in
EXTRA-PORTS with FD 0, 1, or 2, it would *not* be preserved, and would instead
represent the file that EXEC-COMMAND assigned to that file descriptor.  To
avoid this, it's necessary to call RECONFIGURE-FDS *before* redirecting the
input, but this could clobber LOG-PORT or INPUT-PORT, so it would become
necessary to include LOG-PORT and INPUT-PORT in the call to RECONFIGURE-FDS,
then do the redirection using the new FD assignment, then close them.  This
complication can be avoided if we simply let RECONFIGURE-FDS itself do the
redirection.  This also solves other edge cases, like if LOG-PORT has fileno 0
or 1 (previously passing a LOG-PORT of (current-output-port) would cause an
error, as the underlying file descriptor would be closed before dup2 was
called to copy it), or if INPUT-PORT has fileno 0.

To solve this, we have RECONFIGURE-FDS start the range it copies into at 0
instead of 3.  We then explicitly pass the desired standard I/O FDs / ports at
the front of the list passed to RECONFIGURE-FDS.

We also use O_CLOEXEC for opening /dev/null and the log file so that the file
descriptors they are originally opened on don't hang around.

* modules/shepherd/service.scm (exec-command): use RECONFIGURE-FDS for
  redirecting FDs 0, 1, and 2.
---
 modules/shepherd/service.scm | 62 +++++++++++++++++-------------------
 1 file changed, 30 insertions(+), 32 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index e816cd1..3008e31 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1561,38 +1561,36 @@ false."
      (chdir directory)
      (environ environment-variables)
 
-     ;; Redirect stdin.
-     (catch-system-error (close-fdes 0))
-     ;; Make sure file descriptor zero is used, so we don't end up reusing
-     ;; it for something unrelated, which can confuse some packages.
-     (dup2 (if input-port
-               (fileno input-port)
-               (open-fdes "/dev/null" O_RDONLY))
-           0)
-
-     (when (or log-port log-file)
-       (catch #t
-         (lambda ()
-           ;; Redirect stdout and stderr to use LOG-FILE.
-           (catch-system-error (close-fdes 1))
-           (catch-system-error (close-fdes 2))
-           (dup2 (if log-file
-                     (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)
-                                #o640)
-                     (fileno log-port))
-                 1)
-           (dup2 1 2))
-
-         (lambda (key . args)
-           (when log-file
-             (format (current-error-port)
-                     "failed to open log-file ~s:~%" log-file))
-           (print-exception (current-error-port) #f key args)
-           (primitive-exit 1))))
-
-     ;; Make EXTRA-PORTS available starting from file descriptor 3.
-     ;; This clears their FD_CLOEXEC flag.
-     (reconfigure-fds extra-ports 3)
+     (let* ( ;; Make sure file descriptor zero is used, so we don't end up reusing
+            ;; it for something unrelated, which can confuse some packages.
+            (stdin (or input-port (open-fdes "/dev/null"
+                                             (logior O_RDONLY
+                                                     O_CLOEXEC))))
+            (stdout (catch #t
+                      (lambda ()
+                        (or log-port
+                            (and log-file
+                                 (open-fdes log-file
+                                            (logior O_CREAT O_WRONLY O_APPEND
+                                                    O_CLOEXEC)
+                                            #o640))
+                            1))
+                      (lambda (key . args)
+                        (when log-file
+                          (format (current-error-port)
+                                  "failed to open log-file ~s:~%" log-file))
+                        (print-exception (current-error-port) #f key args)
+                        (primitive-exit 1))))
+            (stderr (if (or log-port log-file)
+                        stdout
+                        2))
+            (all-fds (+ 3 (length extra-ports))))
+       ;; Make EXTRA-PORTS available starting from file descriptor 3.
+       ;; This clears their FD_CLOEXEC flag.
+       (reconfigure-fds (cons* stdin
+                               stdout
+                               stderr
+                               extra-ports)))
 
      ;; setgid must be done *before* setuid, otherwise the user will
      ;; likely no longer have permissions to setgid.
-- 
2.40.1

[bug#65221] [PATCH 6/6] service: exec-command: close other file descriptors by default.

[ulfvonbelow]

If EXTRA-PORTS is given, no strong guarantee about which, if any, other file
descriptors will remain open can be made anyhow.  Better to err on the side of
caution in that case and close them.

If EXTRA-PORTS isn't given, we can either close all non-standard file
descriptors or none of them.  The former I've decided to represent with the
empty list, and the latter with #t (as in "which extra ports do you want?
... Yes").  We choose '() for the default because

1. It's already the default value.
2. It's hard to imagine a use case that depends on EXTRA-PORTS being
   explicitly given, but additional unspecified file descriptors also being
   available, since that has never worked and in the general case never can,
   short of manually duplicating ports to high file descriptors.
3. It's hard to imagine a use case that depends on EXTRA-PORTS not being given
   and additional unspecified file descriptors also being available, since
   until 0.9.2 this didn't work, and
4. It's the documented behavior, both in EXEC-COMMAND's docstring and in the
   manual.
5. It's how guile's system* behaves, and this makes our transparent
   replacement a closer match.
6. It errs on the side of security.

While *_CLOEXEC is good practice and a quality second layer of defense against
unintentional leaking of file descriptors, it requires all fd-opening to be
done very carefully in a concurrent context.  Understanding everything that
can and can't be a yield point requires a nontrivial understanding of both
shepherd and fibers.  For example, at present, on systems without signalfd
support, *anything* where asyncs can run can be a yield point, due to the fact
that the SIGCHLD handler calls put-message.
---
 modules/shepherd/service.scm | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 3008e31..924cbfe 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -1537,7 +1537,8 @@ either LOG-PORT or LOG-FILE if it's true, whereas file descriptor 0 (standard
 input) points to INPUT-PORT or /dev/null.
 
 EXTRA-PORTS are made available starting from file descriptor 3 onwards; all
-other file descriptors are closed prior to yielding control to COMMAND.  When
+other file descriptors are closed prior to yielding control to COMMAND, unless
+EXTRA-PORTS is #t, in which case no file descriptors are closed.  When
 CREATE-SESSION? is true, call 'setsid' first.
 
 Guile's SETRLIMIT procedure is applied on the entries in RESOURCE-LIMITS.  For
@@ -1590,7 +1591,17 @@ false."
        (reconfigure-fds (cons* stdin
                                stdout
                                stderr
-                               extra-ports)))
+                               (if (list? extra-ports)
+                                   extra-ports
+                                   '())))
+       (unless (eq? extra-ports #t)
+         (let ((max-fds-count (max-file-descriptors)))
+           (let loop ((fd (+ 3 (length extra-ports))))
+             (when (< fd max-fds-count)
+               ;; Use FD_CLOEXEC instead of close-fdes so fd finalizers don't
+               ;; run.
+               (catch-system-error (fcntl fd F_SETFD FD_CLOEXEC))
+               (loop (+ fd 1)))))))
 
      ;; setgid must be done *before* setuid, otherwise the user will
      ;; likely no longer have permissions to setgid.
-- 
2.40.1