base: run-jobs: Ensure that the child process always terminates.

* src/mcron/base.scm (run-jobs): Use 'dynamic-wind' instead of 'begin'.
This commit is contained in:
Ludovic Courtès 2016-05-07 16:33:01 +02:00 committed by Mathieu Lirzin
commit 45b062490a

View file

@ -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)