dmbcs/mcron
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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
1 changed files with 11 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

10
src/mcron/base.scm
View file

@ -1,3 +1,4 @@
;; Copyright (C) 2016 Ludovic Courtès
;; Copyright (C) 2015, 2016 Mathieu Lirzin ;; Copyright (C) 2015, 2016 Mathieu Lirzin
;; Copyright (C) 2003 Dale Mellor ;; Copyright (C) 2003 Dale Mellor
;; ;;
@ -198,13 +199,16 @@
(for-each (for-each
(lambda (job) (lambda (job)
(if (eqv? (primitive-fork) 0) (if (eqv? (primitive-fork) 0)
(begin (dynamic-wind
(const #t)
(lambda ()
(setgid (passwd:gid (job:user job))) (setgid (passwd:gid (job:user job)))
(setuid (passwd:uid (job:user job))) (setuid (passwd:uid (job:user job)))
(chdir (passwd:dir (job:user job))) (chdir (passwd:dir (job:user job)))
(modify-environment (job:environment job) (job:user job)) (modify-environment (job:environment job) (job:user job))
((job:action job)) ((job:action job)))
(primitive-exit 0)) (lambda ()
(primitive-exit 0)))
(begin (begin
(set! number-children (+ number-children 1)) (set! number-children (+ number-children 1))
(job:next-time-set! job ((job:next-time-function job) (job:next-time-set! job ((job:next-time-function job)