bug#29773: urandom-seed-service should run earlier in the boot process

[ludo@gnu.org (Ludovic Courtès)]

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

Hello,

Leo Famulari <leo@famulari.name> skribis:

> In some cases, the applications require some random data before any
> services are started, during activation. For example, our OpenSSH
> service generates its host keys during activation. And even if it
> generated host keys during the start of the OpenSSH service, that
> service does not depend on urandom-seed-service. [0]
>
> In systemd, there is an abstract sysinit "target" that basically serves
> as a checkpoint. All the lower-level system initialization is required
> before the sysinit.target is met, and the rest of the services depend on
> sysinit. The random seeding is part of sysinit. I've reproduced a graph
> of this in [1].

There’s a ‘user-processes’ service that serves a similar purpose.

With the attached patches ‘urandom-seed’ becomes a dependency of
‘user-processes’, meaning that daemons & co. start after
‘urandom-seed’.

WDYT?

> In practice, I'm not sure if it matters. I'd appreciate if GuixSD users
> could check /var/log/messages for warnings like this one and report
> them:
>
> random: application: uninitialized urandom read (16 bytes read) 

I don’t have any of these.  I guess this is most likely to happen when
running ‘ssh-keygen’ on startup, which isn’t the case on my machine.

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0002-services-urandom-seed-Become-a-dependency-of-user-pr.patch --]
[-- Type: text/x-patch, Size: 2179 bytes --]

From 5895acdbc345572434d9efae5cf5cdd11e4c1a07 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 20 Dec 2017 11:09:03 +0100
Subject: [PATCH 2/3] services: urandom-seed: Become a dependency of
 'user-processes'.

This ensures that 'urandom-seed' is started before programs that rely on
sources of randomness.

Fixes <https://bugs.gnu.org/29773>.
Reported by Leo Famulari <leo@famulari.name>.

* gnu/services/base.scm (urandom-seed-shepherd-service): Change
'requirement' to (file-systems).
(urandom-seed-service-type): Extend USER-PROCESSES-SERVICE-TYPE.
---
 gnu/services/base.scm | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 481439d4f..cc59ec573 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -529,7 +529,7 @@ in KNOWN-MOUNT-POINTS when it is stopped."
   (list (shepherd-service
          (documentation "Preserve entropy across reboots for /dev/urandom.")
          (provision '(urandom-seed))
-         (requirement '(user-processes))
+         (requirement '(file-systems))
          (start #~(lambda _
                     ;; On boot, write random seed into /dev/urandom.
                     (when (file-exists? #$%random-seed-file)
@@ -590,7 +590,13 @@ in KNOWN-MOUNT-POINTS when it is stopped."
   (service-type (name 'urandom-seed)
                 (extensions
                  (list (service-extension shepherd-root-service-type
-                                          urandom-seed-shepherd-service)))
+                                          urandom-seed-shepherd-service)
+
+                       ;; Have 'user-processes' depend on 'urandom-seed'.
+                       ;; This ensures that user processes and daemons don't
+                       ;; start until we have seeded the PRNG.
+                       (service-extension user-processes-service-type
+                                          (const '(urandom-seed)))))
                 (description
                  "Seed the @file{/dev/urandom} pseudo-random number
 generator (RNG) with the value recorded when the system was last shut
-- 
2.15.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0001-services-user-processes-service-type-can-now-be-exte.patch --]
[-- Type: text/x-patch, Size: 12608 bytes --]

From 8d0714bdb038e525880aed9de29e78af8c021efb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 20 Dec 2017 11:05:11 +0100
Subject: [PATCH 1/3] services: 'user-processes-service-type' can now be
 extended.

* gnu/services/base.scm (user-processes-shepherd-service): New
procedure, taken from former 'user-processes-service-type'.  Add
REQUIREMENTS argument; remove GRACE-DELAY argument.
(user-processes-service-type): Redefine in terms of 'service-type'.
(user-processes-service): Remove.
(file-system-service-type): Extend USER-PROCESSES-SERVICE-TYPE.
* gnu/system.scm (essential-services): Use USER-PROCESSES-SERVICE-TYPE
directly.
---
 gnu/services/base.scm | 236 +++++++++++++++++++++++++++-----------------------
 gnu/system.scm        |   2 +-
 2 files changed, 130 insertions(+), 108 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index a3654fd4d..481439d4f 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -57,7 +57,7 @@
             file-system-service-type
             user-unmount-service
             swap-service
-            user-processes-service
+            user-processes-service-type
             host-name-service
             console-keymap-service
             %default-console-font
@@ -162,6 +162,129 @@
 ;;;
 ;;; Code:
 
+
+\f
+;;;
+;;; User processes.
+;;;
+
+(define %do-not-kill-file
+  ;; Name of the file listing PIDs of processes that must survive when halting
+  ;; the system.  Typical example is user-space file systems.
+  "/etc/shepherd/do-not-kill")
+
+(define (user-processes-shepherd-service requirements)
+  "Return the 'user-processes' Shepherd service with dependencies on
+REQUIREMENTS (a list of service names).
+
+This is a synchronization point used to make sure user processes and daemons
+get started only after crucial initial services have been started---file
+system mounts, etc.  This is similar to 'target' in systemd."
+  (define grace-delay
+    ;; Delay after sending SIGTERM and before sending SIGKILL.
+    4)
+
+  (list (shepherd-service
+         (documentation "When stopped, terminate all user processes.")
+         (provision '(user-processes))
+         (requirement requirements)
+         (start #~(const #t))
+         (stop #~(lambda _
+                   (define (kill-except omit signal)
+                     ;; Kill all the processes with SIGNAL except those listed
+                     ;; in OMIT and the current process.
+                     (let ((omit (cons (getpid) omit)))
+                       (for-each (lambda (pid)
+                                   (unless (memv pid omit)
+                                     (false-if-exception
+                                      (kill pid signal))))
+                                 (processes))))
+
+                   (define omitted-pids
+                     ;; List of PIDs that must not be killed.
+                     (if (file-exists? #$%do-not-kill-file)
+                         (map string->number
+                              (call-with-input-file #$%do-not-kill-file
+                                (compose string-tokenize
+                                         (@ (ice-9 rdelim) read-string))))
+                         '()))
+
+                   (define (now)
+                     (car (gettimeofday)))
+
+                   (define (sleep* n)
+                     ;; Really sleep N seconds.
+                     ;; Work around <http://bugs.gnu.org/19581>.
+                     (define start (now))
+                     (let loop ((elapsed 0))
+                       (when (> n elapsed)
+                         (sleep (- n elapsed))
+                         (loop (- (now) start)))))
+
+                   (define lset= (@ (srfi srfi-1) lset=))
+
+                   (display "sending all processes the TERM signal\n")
+
+                   (if (null? omitted-pids)
+                       (begin
+                         ;; Easy: terminate all of them.
+                         (kill -1 SIGTERM)
+                         (sleep* #$grace-delay)
+                         (kill -1 SIGKILL))
+                       (begin
+                         ;; Kill them all except OMITTED-PIDS.  XXX: We would
+                         ;; like to (kill -1 SIGSTOP) to get a fixed list of
+                         ;; processes, like 'killall5' does, but that seems
+                         ;; unreliable.
+                         (kill-except omitted-pids SIGTERM)
+                         (sleep* #$grace-delay)
+                         (kill-except omitted-pids SIGKILL)
+                         (delete-file #$%do-not-kill-file)))
+
+                   (let wait ()
+                     ;; Reap children, if any, so that we don't end up with
+                     ;; zombies and enter an infinite loop.
+                     (let reap-children ()
+                       (define result
+                         (false-if-exception
+                          (waitpid WAIT_ANY (if (null? omitted-pids)
+                                                0
+                                                WNOHANG))))
+
+                       (when (and (pair? result)
+                                  (not (zero? (car result))))
+                         (reap-children)))
+
+                     (let ((pids (processes)))
+                       (unless (lset= = pids (cons 1 omitted-pids))
+                         (format #t "waiting for process termination\
+ (processes left: ~s)~%"
+                                 pids)
+                         (sleep* 2)
+                         (wait))))
+
+                   (display "all processes have been terminated\n")
+                   #f))
+         (respawn? #f))))
+
+(define user-processes-service-type
+  (service-type
+   (name 'user-processes)
+   (extensions (list (service-extension shepherd-root-service-type
+                                        user-processes-shepherd-service)))
+   (compose concatenate)
+   (extend append)
+
+   ;; The value is the list of Shepherd services 'user-processes' depends on.
+   ;; Extensions can add new services to this list.
+   (default-value '())
+
+   (description "The @code{user-processes} service is responsible for
+terminating all the processes so that the root file system can be re-mounted
+read-only, just before rebooting/halting.  Processes still running after a few
+seconds after @code{SIGTERM} has been sent are terminated with
+@code{SIGKILL}.")))
+
 \f
 ;;;
 ;;; File systems.
@@ -349,7 +472,11 @@ FILE-SYSTEM."
                  (list (service-extension shepherd-root-service-type
                                           file-system-shepherd-services)
                        (service-extension fstab-service-type
-                                          identity)))
+                                          identity)
+
+                       ;; Have 'user-processes' depend on 'file-systems'.
+                       (service-extension user-processes-service-type
+                                          (const '(file-systems)))))
                 (compose concatenate)
                 (extend append)
                 (description
@@ -389,111 +516,6 @@ file systems, as well as corresponding @file{/etc/fstab} entries.")))
 in KNOWN-MOUNT-POINTS when it is stopped."
   (service user-unmount-service-type known-mount-points))
 
-(define %do-not-kill-file
-  ;; Name of the file listing PIDs of processes that must survive when halting
-  ;; the system.  Typical example is user-space file systems.
-  "/etc/shepherd/do-not-kill")
-
-(define user-processes-service-type
-  (shepherd-service-type
-   'user-processes
-   (lambda (grace-delay)
-     (shepherd-service
-      (documentation "When stopped, terminate all user processes.")
-      (provision '(user-processes))
-      (requirement '(file-systems))
-      (start #~(const #t))
-      (stop #~(lambda _
-                (define (kill-except omit signal)
-                  ;; Kill all the processes with SIGNAL except those listed
-                  ;; in OMIT and the current process.
-                  (let ((omit (cons (getpid) omit)))
-                    (for-each (lambda (pid)
-                                (unless (memv pid omit)
-                                  (false-if-exception
-                                   (kill pid signal))))
-                              (processes))))
-
-                (define omitted-pids
-                  ;; List of PIDs that must not be killed.
-                  (if (file-exists? #$%do-not-kill-file)
-                      (map string->number
-                           (call-with-input-file #$%do-not-kill-file
-                             (compose string-tokenize
-                                      (@ (ice-9 rdelim) read-string))))
-                      '()))
-
-                (define (now)
-                  (car (gettimeofday)))
-
-                (define (sleep* n)
-                  ;; Really sleep N seconds.
-                  ;; Work around <http://bugs.gnu.org/19581>.
-                  (define start (now))
-                  (let loop ((elapsed 0))
-                    (when (> n elapsed)
-                      (sleep (- n elapsed))
-                      (loop (- (now) start)))))
-
-                (define lset= (@ (srfi srfi-1) lset=))
-
-                (display "sending all processes the TERM signal\n")
-
-                (if (null? omitted-pids)
-                    (begin
-                      ;; Easy: terminate all of them.
-                      (kill -1 SIGTERM)
-                      (sleep* #$grace-delay)
-                      (kill -1 SIGKILL))
-                    (begin
-                      ;; Kill them all except OMITTED-PIDS.  XXX: We would
-                      ;; like to (kill -1 SIGSTOP) to get a fixed list of
-                      ;; processes, like 'killall5' does, but that seems
-                      ;; unreliable.
-                      (kill-except omitted-pids SIGTERM)
-                      (sleep* #$grace-delay)
-                      (kill-except omitted-pids SIGKILL)
-                      (delete-file #$%do-not-kill-file)))
-
-                (let wait ()
-                  ;; Reap children, if any, so that we don't end up with
-                  ;; zombies and enter an infinite loop.
-                  (let reap-children ()
-                    (define result
-                      (false-if-exception
-                       (waitpid WAIT_ANY (if (null? omitted-pids)
-                                             0
-                                             WNOHANG))))
-
-                    (when (and (pair? result)
-                               (not (zero? (car result))))
-                      (reap-children)))
-
-                  (let ((pids (processes)))
-                    (unless (lset= = pids (cons 1 omitted-pids))
-                      (format #t "waiting for process termination\
- (processes left: ~s)~%"
-                              pids)
-                      (sleep* 2)
-                      (wait))))
-
-                (display "all processes have been terminated\n")
-                #f))
-      (respawn? #f)))))
-
-(define* (user-processes-service #:key (grace-delay 4))
-  "Return the service that is responsible for terminating all the processes so
-that the root file system can be re-mounted read-only, just before
-rebooting/halting.  Processes still running GRACE-DELAY seconds after SIGTERM
-has been sent are terminated with SIGKILL.
-
-The returned service will depend on 'file-systems', meaning that it is
-considered started after all the auto-mount file systems have been mounted.
-
-All the services that spawn processes must depend on this one so that they are
-stopped before 'kill' is called."
-  (service user-processes-service-type grace-delay))
-
 \f
 ;;;
 ;;; Preserve entropy to seed /dev/urandom on boot.
diff --git a/gnu/system.scm b/gnu/system.scm
index 7466ed780..df89ca06d 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -449,7 +449,7 @@ a container or that of a \"bare metal\" system."
          (other-fs  (non-boot-file-system-service os))
          (unmount   (user-unmount-service known-fs))
          (swaps     (swap-services os))
-         (procs     (user-processes-service))
+         (procs     (service user-processes-service-type))
          (host-name (host-name-service (operating-system-host-name os)))
          (entries   (operating-system-directory-base-entries
                      os #:container? container?)))
-- 
2.15.1