bug-mcron
[Top][All Lists]
Advanced

[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

reply via email to

[Prev in Thread] Current Thread [Next in Thread]