diff options
author | Mathieu Lirzin <mthl@gnu.org> | 2017-01-15 22:48:02 +0100 |
---|---|---|
committer | Mathieu Lirzin <mthl@gnu.org> | 2017-09-28 13:18:29 +0200 |
commit | ec5ece53d6fe13fee7a673a05256458331132350 (patch) | |
tree | 7566ffe46ac49bc889945e4b5ffd8bf3609bc2cc | |
parent | 10df45c659b742732bf71dc9cbee5a8286567e5d (diff) | |
download | mcron-ec5ece53d6fe13fee7a673a05256458331132350.tar.gz mcron-ec5ece53d6fe13fee7a673a05256458331132350.tar.bz2 mcron-ec5ece53d6fe13fee7a673a05256458331132350.zip |
base: Add 'run-job' procedure.
* src/mcron/base.scm (run-jobs): Delete.
(run-job): New procedure.
(run-job-loop): Use it.
-rw-r--r-- | src/mcron/base.scm | 51 |
1 files changed, 20 insertions, 31 deletions
diff --git a/src/mcron/base.scm b/src/mcron/base.scm index c100b4f..942ebf2 100644 --- a/src/mcron/base.scm +++ b/src/mcron/base.scm @@ -171,36 +171,25 @@ recurse the list." (define number-children 0) - - -;; For every job on the list, fork a process to run it (noting the fact by -;; increasing the number-children counter), and in the new process set up the -;; run-time environment exactly as it should be before running the job proper. -;; -;; In the parent, update the job entry by computing the next time the job needs -;; to run. - -(define (run-jobs jobs-list) - (for-each - (lambda (job) - (if (eqv? (primitive-fork) 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) - (current-time)))))) - jobs-list)) - - +(define (run-job job) + "Run JOB in a separate process. The process is run as JOB user with the +environment properly set. Update the NEXT-TIME field of JOB by computing its +next value." + (if (= (primitive-fork) 0) + (dynamic-wind ;child + (const #t) + (λ () + (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))) + (begin ;parent + (set! number-children (+ number-children 1)) + (job:next-time-set! job ((job:next-time-function job) + (current-time)))))) ;; Give any zombie children a chance to die, and decrease the number known to ;; exist. @@ -242,6 +231,6 @@ recurse the list." (else (apply throw key args))))))))) (break)) - (run-jobs next-jobs-lst) + (for-each run-job next-jobs-lst) (child-cleanup) (loop)))))))) |