From 45b062490a9924bcc6d582d10061244ced73f3f8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 7 May 2016 16:33:01 +0200 Subject: base: run-jobs: Ensure that the child process always terminates. * src/mcron/base.scm (run-jobs): Use 'dynamic-wind' instead of 'begin'. --- src/mcron/base.scm | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/mcron/base.scm b/src/mcron/base.scm index 7094dbc..aae5fe5 100644 --- a/src/mcron/base.scm +++ b/src/mcron/base.scm @@ -1,3 +1,4 @@ +;; Copyright (C) 2016 Ludovic Courtès ;; Copyright (C) 2015, 2016 Mathieu Lirzin ;; Copyright (C) 2003 Dale Mellor ;; @@ -198,13 +199,16 @@ (for-each (lambda (job) (if (eqv? (primitive-fork) 0) - (begin - (setgid (passwd:gid (job:user job))) - (setuid (passwd:uid (job:user job))) - (chdir (passwd:dir (job:user job))) - (modify-environment (job:environment job) (job:user job)) - ((job:action job)) - (primitive-exit 0)) + (dynamic-wind + (const #t) + (lambda () + (setgid (passwd:gid (job:user job))) + (setuid (passwd:uid (job:user job))) + (chdir (passwd:dir (job:user job))) + (modify-environment (job:environment job) (job:user job)) + ((job:action job))) + (lambda () + (primitive-exit 0))) (begin (set! number-children (+ number-children 1)) (job:next-time-set! job ((job:next-time-function job) -- cgit v1.2.3