[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
06/06: services: user-processes: Reap child processes.
From: |
Ludovic Courtès |
Subject: |
06/06: services: user-processes: Reap child processes. |
Date: |
Mon, 28 Aug 2017 04:19:07 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 7f090203d5fb033eb1b64778b03afad5bb35f5f2
Author: Ludovic Courtès <address@hidden>
Date: Mon Aug 28 09:54:03 2017 +0200
services: user-processes: Reap child processes.
Fixes <http://bugs.gnu.org/26931>.
Reported by Leo Famulari <address@hidden>.
* gnu/services/base.scm (user-processes-service-type)[stop]: Add
'reap-children' loop.
* gnu/tests/base.scm (run-halt-test): New procedure.
(%test-halt): New variable.
---
gnu/services/base.scm | 13 ++++++++
gnu/tests/base.scm | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 96 insertions(+)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 54bd9ca..5001298 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -456,6 +456,19 @@ in KNOWN-MOUNT-POINTS when it is stopped."
(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\
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 6132aa9..5b40d45 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -32,12 +32,15 @@
#:use-module (gnu packages imagemagick)
#:use-module (gnu packages ocr)
#:use-module (gnu packages package-management)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu packages tmux)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:export (run-basic-test
%test-basic-os
+ %test-halt
%test-mcron
%test-nss-mdns))
@@ -405,6 +408,86 @@ functionality tests.")
;;;
+;;; Halt.
+;;;
+
+(define (run-halt-test vm)
+ ;; As reported in <http://bugs.gnu.org/26931>, running tmux would previously
+ ;; lead the 'stop' method of 'user-processes' to an infinite loop, with the
+ ;; tmux server process as a zombie that remains in the list of processes.
+ ;; This test reproduces this scenario.
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (gnu build marionette))
+
+ (define marionette
+ (make-marionette '(#$vm)))
+
+ (define ocrad
+ #$(file-append ocrad "/bin/ocrad"))
+
+ ;; Wait for tty1 and log in.
+ (marionette-eval '(begin
+ (use-modules (gnu services herd))
+ (start-service 'term-tty1))
+ marionette)
+ (marionette-type "root\n" marionette)
+ (wait-for-screen-text marionette
+ (lambda (text)
+ (string-contains text "address@hidden"))
+ #:ocrad ocrad)
+
+ ;; Start tmux and wait for it to be ready.
+ (marionette-type "tmux new-session 'echo 1 > /ready; bash'\n"
+ marionette)
+ (wait-for-file "/ready" marionette)
+
+ ;; Make sure to stop the test after a while.
+ (sigaction SIGALRM (lambda _
+ (format (current-error-port)
+ "FAIL: Time is up, but VM still
running.\n")
+ (primitive-exit 1)))
+ (alarm 10)
+
+ ;; Get debugging info.
+ (marionette-eval '(current-output-port
+ (open-file "/dev/console" "w0"))
+ marionette)
+ (marionette-eval '(system* #$(file-append procps "/bin/ps")
+ "-eo" "pid,ppid,stat,comm")
+ marionette)
+
+ ;; See if 'halt' actually works.
+ (marionette-eval '(system* "/run/current-system/profile/sbin/halt")
+ marionette)
+
+ ;; If we reach this line, that means the VM was properly stopped in
+ ;; a timely fashion.
+ (alarm 0)
+ (call-with-output-file #$output
+ (lambda (port)
+ (display "success!" port))))))
+
+ (gexp->derivation "halt" test))
+
+(define %test-halt
+ (system-test
+ (name "halt")
+ (description
+ "Use the 'halt' command and make sure it succeeds and does not get stuck
+in a loop. See <http://bugs.gnu.org/26931>.")
+ (value
+ (let ((os (marionette-operating-system
+ (operating-system
+ (inherit %simple-os)
+ (packages (cons tmux %base-packages)))
+ #:imported-modules '((gnu services herd)
+ (guix combinators)))))
+ (run-halt-test (virtual-machine os))))))
+
+
+;;;
;;; Mcron.
;;;
- branch master updated (15d6148 -> 7f09020), Ludovic Courtès, 2017/08/28
- 01/06: bootloader: Emit warnings with 'warning'., Ludovic Courtès, 2017/08/28
- 03/06: marionette: 'wait-for-file' really raises an error when a file is missing., Ludovic Courtès, 2017/08/28
- 05/06: marionette: Augment the set of keystrokes., Ludovic Courtès, 2017/08/28
- 02/06: gnu: emacs-nix-mode: Move to package-management.scm., Ludovic Courtès, 2017/08/28
- 06/06: services: user-processes: Reap child processes.,
Ludovic Courtès <=
- 04/06: marionette: Fix typing of capital letters., Ludovic Courtès, 2017/08/28