From ec5ece53d6fe13fee7a673a05256458331132350 Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <mthl@gnu.org>
Date: Sun, 15 Jan 2017 22:48:02 +0100
Subject: base: Add 'run-job' procedure.

* src/mcron/base.scm (run-jobs): Delete.
(run-job): New procedure.
(run-job-loop): Use it.
---
 src/mcron/base.scm | 51 ++++++++++++++++++++-------------------------------
 1 file changed, 20 insertions(+), 31 deletions(-)

(limited to 'src')

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))))))))
-- 
cgit v1.2.3