diff options
Diffstat (limited to 'scm/mcron/mcron-core.scm')
| -rw-r--r-- | scm/mcron/mcron-core.scm | 96 |
1 files changed, 49 insertions, 47 deletions
diff --git a/scm/mcron/mcron-core.scm b/scm/mcron/mcron-core.scm index 9b83faf..518bcac 100644 --- a/scm/mcron/mcron-core.scm +++ b/scm/mcron/mcron-core.scm @@ -1,4 +1,4 @@ -;; Copyright (C) 2003, 2015 Dale Mellor +;; Copyright (C) 2003 Dale Mellor ;; ;; This file is part of GNU mcron. ;; @@ -17,9 +17,8 @@ -(define-module (mcron mcron-core) +(define-module (mcron core) #:use-module (mcron environment) - #:use-module (srfi srfi-9) #:export (add-job remove-user-jobs get-schedule @@ -39,7 +38,7 @@ ;; The list of all jobs known to the system. Each element of the list is ;; -;; (make-job user next-time-function action environment displayable next-time) +;; (vector user next-time-function action environment displayable next-time) ;; ;; where action must be a procedure, and the environment is an alist of ;; modifications that need making to the UNIX environment before the action is @@ -61,17 +60,18 @@ (define (use-system-job-list) (set! configuration-source 'system)) (define (use-user-job-list) (set! configuration-source 'user)) -;; A cron job. -(define-record-type <job> - (make-job user time-proc action environment displayable next-time) - job? - (user job:user) ;string : user passwd entry - (time-proc job:next-time-function) ;proc : with one 'time' parameter - (action job:action) ;thunk : user's code - (environment job:environment) ;alist : environment variables - (displayable job:displayable) ;string : visible in schedule - (next-time job:next-time ;number : time in UNIX format - job:next-time-set!)) + + +;; Convenience functions for getting and setting the elements of a job object. + +(define (job:user job) (vector-ref job 0)) +(define (job:next-time-function job) (vector-ref job 1)) +(define (job:action job) (vector-ref job 2)) +(define (job:environment job) (vector-ref job 3)) +(define (job:displayable job) (vector-ref job 4)) +(define (job:next-time job) (vector-ref job 5)) + + ;; Remove jobs from the user-job-list belonging to this user. @@ -97,12 +97,12 @@ (define (add-job time-proc action displayable configuration-time configuration-user) - (let ((entry (make-job configuration-user - time-proc - action - (get-current-environment-mods-copy) - displayable - (time-proc configuration-time)))) + (let ((entry (vector configuration-user + time-proc + action + (get-current-environment-mods-copy) + displayable + (time-proc configuration-time)))) (if (eq? configuration-source 'user) (set! user-job-list (cons entry user-job-list)) (set! system-job-list (cons entry system-job-list))))) @@ -165,17 +165,18 @@ (lambda () (do ((count count (- count 1))) ((eqv? count 0)) - (and-let* - ((next-jobs (find-next-jobs)) - (time (car next-jobs)) - (date-string (strftime "%c %z\n" (localtime time)))) - (for-each (lambda (job) - (display date-string) - (display (job:displayable job)) - (newline)(newline) - (job:next-time-set! job ((job:next-time-function job) - (job:next-time job)))) - (cdr next-jobs))))))) + (and-let* ((next-jobs (find-next-jobs)) + (time (car next-jobs)) + (date-string (strftime "%c %z\n" (localtime time)))) + (for-each (lambda (job) + (display date-string) + (display (job:displayable job)) + (newline)(newline) + (vector-set! job + 5 + ((job:next-time-function job) + (job:next-time job)))) + (cdr next-jobs))))))) @@ -194,21 +195,22 @@ ;; to run. (define (run-jobs jobs-list) - (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)) - (begin - (set! number-children (+ number-children 1)) - (job:next-time-set! job ((job:next-time-function job) - (current-time)))))) - jobs-list)) + (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)) + (begin + (set! number-children (+ number-children 1)) + (vector-set! job + 5 + ((job:next-time-function job) + (current-time)))))) + jobs-list)) |