[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Bug-mcron] [PATCH 31/33] main: Add 'proc-in-directory'.
From: |
Mathieu Lirzin |
Subject: |
[Bug-mcron] [PATCH 31/33] main: Add 'proc-in-directory'. |
Date: |
Sun, 27 Sep 2015 23:17:45 +0200 |
* scm/mcron/main.scm (proc-in-directory): New procedure.
(process-files-in-user-directory, process-files-in-system-directory):
Use it.
* .dir-locals.el: Add setting for it.
---
.dir-locals.el | 3 ++-
scm/mcron/main.scm | 59 ++++++++++++++++++++++++++++--------------------------
2 files changed, 33 insertions(+), 29 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index f628caf..75c2edd 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -7,4 +7,5 @@
(scheme-mode
.
((indent-tabs-mode . nil)
- (eval . (put 'mcron-error 'scheme-indent-function 1)))))
+ (eval . (put 'mcron-error 'scheme-indent-function 1))
+ (eval . (put 'proc-in-directory 'scheme-indent-function 1)))))
diff --git a/scm/mcron/main.scm b/scm/mcron/main.scm
index 1ea9b82..ca0d051 100644
--- a/scm/mcron/main.scm
+++ b/scm/mcron/main.scm
@@ -179,6 +179,16 @@ received."
((eof-object? in))
(display in)))))
+(define (proc-in-directory directory proc)
+ "Return a thunk which process each file in DIRECTORY with PROC. DIRECTORY
+must be a directory name. PROC must be a procedure that take one file name
+argument."
+ (lambda ()
+ (let ((dir (opendir directory)))
+ (do ((file-name (readdir dir) (readdir dir)))
+ ((eof-object? file-name) (closedir dir))
+ (proc file-name)))))
+
(define process-user-file
(let ((guile-regexp (make-regexp "\\.gui(le)?$"))
(vixie-regexp (make-regexp "\\.vix(ie)?$")))
@@ -200,21 +210,17 @@ silently ignored."
$XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
(let ((errors 0)
(home-directory (passwd:dir (getpw (getuid)))))
- (map (lambda (config-directory)
- (catch #t
- (lambda ()
- (let ((directory (opendir config-directory)))
- (do ((file-name (readdir directory) (readdir directory)))
- ((eof-object? file-name) (closedir directory))
- (process-user-file (string-append config-directory
- "/"
- file-name)))))
- (lambda (key . args)
- (set! errors (1+ errors)))))
- (list (string-append home-directory "/.cron")
- (string-append (or (getenv "XDG_CONFIG_HOME")
- (string-append home-directory "/.config"))
- "/cron")))
+ (map (lambda (dir)
+ (catch #t
+ (proc-in-directory dir
+ (lambda (file-name)
+ (process-user-file (string-append dir "/" file-name))))
+ (lambda (key . args)
+ (set! errors (1+ errors)))))
+ (list (string-append home-directory "/.cron")
+ (string-append (or (getenv "XDG_CONFIG_HOME")
+ (string-append home-directory "/.config"))
+ "/cron")))
(when (eq? 2 errors)
(mcron-error 13
"Cannot read files in your ~/.config/cron (or ~/.cron) directory."))))
@@ -236,19 +242,16 @@ run on behalf of the configuration files, the jobs are
registered on the
system with the appropriate user. Only root should be able to perform this
operation. The permissions on the /var/cron/tabs directory enforce this."
(catch #t
- (lambda ()
- (let ((directory (opendir config-spool-dir)))
- (do ((file-name (readdir directory) (readdir directory)))
- ((eof-object? file-name))
- (and-let* ((user (valid-user file-name)))
- (set-configuration-user user) ;; / ?? !!!!
- (catch-mcron-error
- (read-vixie-file (string-append config-spool-dir
- "/"
- file-name)))))))
- (lambda (key . args)
- (mcron-error 4
- "You do not have permission to access the system crontabs."))))
+ (proc-in-directory config-spool-dir
+ (lambda (user-name)
+ (and-let* ((user (valid-user user-name))) ;crontab without user?
+ (set-configuration-user user)
+ (catch-mcron-error
+ (read-vixie-file
+ (string-append config-spool-dir "/" user-name))))))
+ (lambda (key . args)
+ (mcron-error 4
+ "You do not have permission to access the system crontabs."))))
(define (cron-file-descriptors)
"Establish a socket to listen for updates from a crontab program, and return
- [Bug-mcron] [PATCH 22/33] redirect: Use module (ice-9 regex)., (continued)
- [Bug-mcron] [PATCH 22/33] redirect: Use module (ice-9 regex)., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 23/33] mcron: Add forward declarations., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 28/33] main: Remove unused 'regular-file?' procedure., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 24/33] mcron: Use symbolic constants., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 25/33] mcron: Rework comments., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 20/33] build: Enable silent rules by default., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 13/33] main: Turn 'command-name' into a thunk., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 19/33] build: Compile and install '.go' files., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 18/33] main: Add (mcron main) module., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 30/33] Define directory-local variables for Emacs., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 31/33] main: Add 'proc-in-directory'.,
Mathieu Lirzin <=
- [Bug-mcron] [PATCH 32/33] main: Remove 'valid-user'., Mathieu Lirzin, 2015/09/27
- [Bug-mcron] [PATCH 33/33] core: Use SRFI-9 records for the job data structure., Mathieu Lirzin, 2015/09/27