From 4da7aec83b6f8f854568ac150ed129502486bf14 Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <mthl@gnu.org>
Date: Mon, 7 Sep 2015 00:50:14 +0200
Subject: main: Add 'for-each-file' procedure.

* scm/mcron/main.scm (for-each-file): New procedure.
(process-files-in-user-directory, process-files-in-system-directory):
Use it.
---
 scm/mcron/main.scm | 61 +++++++++++++++++++++++++++++-------------------------
 1 file changed, 33 insertions(+), 28 deletions(-)

(limited to 'scm')

diff --git a/scm/mcron/main.scm b/scm/mcron/main.scm
index 9425cef..a84f82f 100644
--- a/scm/mcron/main.scm
+++ b/scm/mcron/main.scm
@@ -179,6 +179,15 @@ received."
                                         ((eof-object? in))
                                         (display in)))))
 
+(define (for-each-file proc directory)
+  "Apply PROC to each file in DIRECTORY.  DIRECTORY must be a valid directory name.
+PROC must be a procedure that take one file name argument.  The return value
+is not specified"
+  (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 +209,19 @@ 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
+             (lambda ()
+               (for-each-file
+                (lambda (file)
+                  (process-user-file (string-append dir "/" file)))
+                dir))
+             (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 +243,17 @@ 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."))))
+    (lambda ()
+      (for-each-file
+       (lambda (user)
+         (and-let* ((user* (valid-user user))) ;crontab without user?
+           (set-configuration-user user*)
+           (catch-mcron-error
+            (read-vixie-file (string-append config-spool-dir "/" user)))))
+       config-spool-dir))
+    (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
-- 
cgit v1.2.3