Taken on board suggestions of Mathieu Lirzin as per e-mails to the bug-mcron@gnu.org mailing list around September 2015.

9 files changed, 461 insertions, 472 deletions

diff --git a/scm/mcron/config.scm.in b/scm/mcron/config.scm.in
index 6a0a85d..db2bc32 100644
--- a/scm/mcron/config.scm.in
+++ b/scm/mcron/config.scm.in
@@ -1,5 +1,6 @@
 ;; -*-scheme-*-
 
+;;   Copyright (C) 2015 Mathieu Lirzin
 ;;   Copyright (C) 2003 Dale Mellor
 ;; 
 ;;   This file is part of GNU mcron.
@@ -23,8 +24,11 @@
 (define-module (mcron config))
 
 (define-public config-debug @CONFIG_DEBUG@)
+(define-public config-package-name "@PACKAGE_NAME@")
+(define-public config-package-version "@PACKAGE_VERSION@")
 (define-public config-package-string "@PACKAGE_STRING@")
 (define-public config-package-bugreport "@PACKAGE_BUGREPORT@")
+(define-public config-package-url "@PACKAGE_URL@")
 (define-public config-sendmail "@SENDMAIL@")
 
 (define-public config-spool-dir "@CONFIG_SPOOL_DIR@")
diff --git a/scm/mcron/crontab.scm b/scm/mcron/crontab.scm
index 30e5592..6be5c61 100644
--- a/scm/mcron/crontab.scm
+++ b/scm/mcron/crontab.scm
@@ -221,8 +221,8 @@
  ;; The user is being silly. The message here is identical to the one Vixie cron
  ;; used to put out, for total compatibility.
 
- (else
-  (mcron-error 15 "usage error: file name must be specified for replace.")))
+ (else (mcron-error 15
+         "usage error: file name must be specified for replace.")))
 
 
 )) ;; End of file-level let-scopes.
diff --git a/scm/mcron/environment.scm b/scm/mcron/environment.scm
index 9f694f1..f364a38 100644
--- a/scm/mcron/environment.scm
+++ b/scm/mcron/environment.scm
@@ -1,4 +1,4 @@
-;;   Copyright (C) 2003 Dale Mellor
+;;   Copyright (C) 2003, 2015 Dale Mellor
 ;; 
 ;;   This file is part of GNU mcron.
 ;;
@@ -31,42 +31,12 @@
 
 
 (define-module (mcron environment)
+  #:use-module (srfi srfi-26)
   #:export (modify-environment
             clear-environment-mods
             append-environment-mods
             get-current-environment-mods-copy))
             
-            
-
-
-;; The env-alist is an association list of variable names and values. Variables
-;; later in the list will take precedence over variables before. We return a
-;; fixed-up version in which some variables are given specific default values
-;; (which the user can override), and two variables which the user is not
-;; allowed to control are added at the end of the list.
-
-(define (impose-default-environment env-alist passwd-entry)
-  (append `(("HOME"    . ,(passwd:dir passwd-entry))
-            ("CWD"     . ,(passwd:dir passwd-entry))
-            ("SHELL"   . ,(passwd:shell passwd-entry))
-            ("TERM"    . #f)
-            ("TERMCAP" . #f))
-          env-alist
-          `(("LOGNAME" . ,(passwd:name passwd-entry))
-            ("USER"    . ,(passwd:name passwd-entry)))))
-
-
-
-
-;; Modify the UNIX environment for the current process according to the given
-;; association list of variables, with the default variable values imposed.
-
-(define (modify-environment env-alist passwd-entry)
-  (for-each (lambda (variable)
-              (setenv (car variable) (cdr variable)))
-            (impose-default-environment env-alist passwd-entry)))
-
-
 
 
 ;; As we parse configuration files, we build up an alist of environment
@@ -103,3 +73,24 @@
   (set! current-environment-mods (append current-environment-mods
                                          (list (cons name value))))
   #t)
+
+
+
+;; Modify the UNIX environment for the current process according to the given
+;; association list of variables, with the default variable values imposed.
+
+(define (modify-environment env-alist passwd-entry)
+  (for-each (lambda (a) (setenv (car a) (cdr a)))
+            (let ((home-dir  (passwd:dir passwd-entry))
+                  (user-name (passwd:name passwd-entry)))
+              (append
+               ;; Default environment variables which can be overidden by ENV.
+               `(("HOME"    . ,home-dir)
+                 ("CWD"     . ,home-dir)
+                 ("SHELL"   . ,(passwd:shell passwd-entry))
+                 ("TERM"    . #f)
+                 ("TERMCAP" . #f))
+               env-alist
+               ;; Environment variables with imposed values.
+               `(("LOGNAME" . ,user-name)
+                 ("USER"    . ,user-name))))))
diff --git a/scm/mcron/job-specifier.scm b/scm/mcron/job-specifier.scm
index cce948c..7ed912b 100644
--- a/scm/mcron/job-specifier.scm
+++ b/scm/mcron/job-specifier.scm
@@ -34,7 +34,7 @@
             set-configuration-time
             job
             find-best-next)
-  #:use-module (mcron core)
+  #:use-module (mcron mcron-core)
   #:use-module (mcron environment)
   #:use-module (mcron vixie-time)
   #:re-export (append-environment-mods))
@@ -203,11 +203,16 @@
 (define configuration-user (getpw (getuid)))
 (define configuration-time (current-time))
 
+
+
 (define (set-configuration-user user)
   (set! configuration-user (if (or (string? user)
                                    (integer? user))
                                (getpw user)
                                user)))
+
+
+
 (define (set-configuration-time time) (set! configuration-time time))
 
 
@@ -233,10 +238,9 @@
                       ((list? action) (lambda () (primitive-eval action)))
                       ((string? action) (lambda () (system action)))
                       (else 
-           (throw 'mcron-error 
-                  2
-                  "job: invalid second argument (action; should be lambda"
-                  " function, string or list)"))))
+           (throw 'mcron-error 2
+                  "job: invalid second argument (action; should be lambda "
+                  "function, string or list)"))))
 
         (time-proc
          (cond ((procedure? time-proc) time-proc)
@@ -244,10 +248,9 @@
                ((list? time-proc)      (lambda (current-time)
                                          (primitive-eval time-proc)))
                (else
-          (throw 'mcron-error 
-                 3       
-                 "job: invalid first argument (next-time-function; should ")
-                 "be function, string or list)")))
+                (throw 'mcron-error 3
+                       "job: invalid first argument (next-time-function; "
+                       "should be function, string or list)"))))
         (displayable
          (cond ((not (null? displayable)) (car displayable))
                ((procedure? action) "Lambda function")
diff --git a/scm/mcron/main.scm b/scm/mcron/main.scm
index 36adef9..dc839cc 100644
--- a/scm/mcron/main.scm
+++ b/scm/mcron/main.scm
@@ -1,4 +1,4 @@
-;;   Copyright (C) 2003, 2012 Dale Mellor
+;;   Copyright (C) 2003, 2012, 2015 Dale Mellor
 ;; 
 ;;   This file is part of GNU mcron.
 ;;
@@ -16,34 +16,24 @@
 ;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
 
 
-
-;; This is the 'main' routine for the whole system; the top of this file is the
-;; global entry point (after the minimal C wrapper, mcron.c.template); to all
-;; intents and purposes the program is pure Guile and starts here.
-;;
-;; This file is built into mcron.c.template by the makefile, which stringifies
-;; the whole lot, and escapes quotation marks and escape characters
-;; accordingly. Bear this in mind when considering literal multi-line strings.
-;;
-;; (l0ad "crontab.scm") (sic) is inlined by the makefile. All other
-;; functionality comes through modules in .../share/guile/site/mcron/*.scm.
-
-
-
-;; Pull in some constants set by the builder (via autoconf) at configuration
-;; time. Turn debugging on if indicated.
-
-(use-modules (mcron config))
-(if config-debug (begin (debug-enable 'debug)
-                        (debug-enable 'backtrace)))
+(define-module (mcron main)
+  #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (mcron config)
+  #:use-module (mcron mcron-core)
+  #:use-module (mcron job-specifier)
+  #:use-module (mcron vixie-specification)
+  #:use-module (srfi srfi-2)
+  #:use-module (srfi srfi-26)
+  #:export (delete-run-file
+            main))
 
 
 
-;; To determine the name of the program, scan the first item of the command line
-;; backwards for the first non-alphabetic character. This allows names like
-;; in.cron to be accepted as an invocation of the cron command.
-
-(use-modules (ice-9 regex) (ice-9 rdelim))
+;; Extract the actual command name from \a command.  This returns the last
+;; part of \a command without any non-alphabetic characters.  For example
+;; "in.cron" and "./mcron" will return respectively "cron" and "mcron".
 
 (define command-name (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$")
                                                    (car (command-line)))))
@@ -51,49 +41,49 @@
 
 
 ;; Code contributed by Sergey Poznyakoff.  Print an error message (made up from
-;; the parts of rest), and if the error is fatal (present and non-zero) then
-;; exit to the system with this code.
+;; the parts of \a rest), and if the \a exit-code error is fatal (present and
+;; non-zero) then exit to the system with \a exit-code.
 
 (define (mcron-error exit-code . rest)
   (with-output-to-port (current-error-port)
     (lambda ()
-      (for-each display (append (list command-name ": ") rest))
+      (for-each display
+                (cons* command-name ": " rest))
       (newline)))
-  (if (and exit-code (not (eq? exit-code 0)))
-      (primitive-exit exit-code)))
+  (when (and exit-code
+             (not (eq? exit-code 0)))
+    (primitive-exit exit-code)))
 
 
 
-;; Code contributed by Sergey Poznyakoff.  Execute body. If an 'mcron-error
+;; Code contributed by Sergey Poznyakoff and improved upon by Mathieu Lirzin
+;; with newer guile features.  Execute the expressions.  If an 'mcron-error
 ;; exception occurs, print its diagnostics and exit with its error code.
 
-(defmacro catch-mcron-error (. body)
-  `(catch 'mcron-error
-          (lambda ()
-            ,@body)
-          (lambda (key exit-code . msg)
-            (apply mcron-error exit-code msg))))
+(define-syntax-rule (catch-mcron-error exp ...)
+  (catch 'mcron-error
+    (lambda () exp ...)
+    (lambda (key exit-code . msg)
+      (apply mcron-error exit-code msg))))
 
 
 
-;; We will be doing a lot of testing of the command name, so it makes sense to
-;; perform the string comparisons once and for all here.
+;; One of the symbols \c mcron, \c crond or \c crontab according to the means
+;; of our invocation.
 
-(define command-type (cond ((string=? command-name "mcron") 'mcron)
-                           ((or (string=? command-name "cron")
-                                (string=? command-name "crond")) 'cron)
-                           ((string=? command-name "crontab") 'crontab)
-                           (else
-                            (mcron-error 12 "The command name is invalid."))))
+(define command-type
+  (let ((command=? (cute string=? command-name <>)))
+    (cond ((command=? "mcron") 'mcron)
+          ((or (command=? "cron") (command=? "crond")) 'cron)
+          ((command=? "crontab") 'crontab)
+          (else (mcron-error 12 "The command name is invalid.")))))
 
 
 
-;; There are a different set of options for the crontab personality compared to
-;; all the others, with the --help and --version options common to all the
+;; There are a different set of options for the crontab personality compared
+;; to all the others, with the --help and --version options common to all the
 ;; personalities.
 
-(use-modules (ice-9 getopt-long))
-
 (define options
   (catch
    'misc-error
@@ -120,129 +110,96 @@
                    '((version  (single-char #\v) (value #f))
                      (help     (single-char #\h) (value #f))))))
    (lambda (key func fmt args . rest)
-     (mcron-error 1 (apply format (append (list #f fmt) args))))))
-
-;; If the user asked for the version of this program, give it to him and get
-;; out.
-
-(if (option-ref options 'version #f)
-    (begin
-      (display (string-append "\n
-" command-name "  (" config-package-string ")\n
-Written by Dale Mellor\n
-\n
-Copyright (C) 2003, 2006, 2014  Dale Mellor\n
-This is free software; see the source for copying conditions.  There is NO\n
-warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n
-"))
-      (quit)))
-
-
-
-;; Likewise if the user requested the help text.
-
-(if (option-ref options 'help #f)
-    (begin
-      (display (string-append "
-Usage: " (car (command-line))
-(case command-type
-
-  ((mcron)
-" [OPTIONS] [FILES]\n
-Run an mcron process according to the specifications in the FILES (`-' for\n
-standard input), or use all the files in ~/.config/cron (or the \n
-deprecated ~/.cron) with .guile or .vixie extensions.\n
-\n
-  -v, --version             Display version\n
-  -h, --help                Display this help message\n
-  -sN, --schedule[=]N       Display the next N jobs that will be run by mcron\n
-  -d, --daemon              Immediately detach the program from the terminal\n
-                              and run as a daemon process\n
-  -i, --stdin=(guile|vixie) Format of data passed as standard input or\n
-                              file arguments (default guile)")
+     (mcron-error 1 (apply format (cons* #f fmt args))))))
 
-  ((cron)
-" [OPTIONS]\n
-Unless an option is specified, run a cron daemon as a detached process, \n
-reading all the information in the users' crontabs and in /etc/crontab.\n
-\n
-  -v, --version             Display version\n
-  -h, --help                Display this help message\n
-  -sN, --schedule[=]N       Display the next N jobs that will be run by cron\n
-  -n, --noetc               Do not check /etc/crontab for updates (HIGHLY\n
-                              RECOMMENDED).")
-  
-  ((crontab)
-           (string-append " [-u user] file\n"
-           "       " (car (command-line)) " [-u user] { -e | -l | -r }\n"
-           "               (default operation is replace, per 1003.2)\n"
-           "       -e      (edit user's crontab)\n"
-           "       -l      (list user's crontab)\n"
-           "       -r      (delete user's crontab)\n"))
 
-  (else "rubbish"))
 
-"\n\n
-Report bugs to " config-package-bugreport ".\n
-"))
-      (quit)))
+;; Display version information for \a command and quit.
 
+(define* (show-version #:optional (command command-name))
+  (let* ((name       config-package-name)
+         (short-name (cadr (string-split name #\space)))
+         (version    config-package-version))
+    (simple-format #t "~a (~a) ~a
+Copyright (C) 2015 Free Software Foundation, Inc.
 
+License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
+This is free software: you are free to change and redistribute it.
+There is NO WARRANTY, to the extent permitted by law.\n"
+		   command name version)
+    (quit)))
 
-;; This is called from the C front-end whenever a terminal signal is
-;; received. We remove the /var/run/cron.pid file so that crontab and other
-;; invocations of cron don't get the wrong idea that a daemon is currently
-;; running.
 
-(define (delete-run-file)
-  (catch #t (lambda () (delete-file config-pid-file)
-                       (delete-file config-socket-file))
-            noop)
-  (quit))
 
+;; Display where to get help and send bug reports.
 
+(define (show-package-information)
+  (simple-format #t "\nReport bugs to: ~a.
+~a home page: <~a>
+General help using GNU software: <http://www.gnu.org/gethelp/>\n"
+		 config-package-bugreport
+		 config-package-name
+		 config-package-url))
 
-;; Setup the cron process, if appropriate. If there is already a
-;; /var/run/cron.pid file, then we must assume a cron daemon is already running
-;; and refuse to start another one.
-;;
-;; Otherwise, clear the MAILTO environment variable so that output from cron
-;; jobs is sent to the various users (this may still be overridden in the
-;; configuration files), and call the function in the C wrapper to set up
-;; terminal signal responses to vector to the procedure above. The PID file will
-;; be filled in properly later when we have forked our daemon process (but not
-;; done if we are only viewing the schedules).
 
-(if (eq? command-type 'cron)
-    (begin
-      (if (not (eqv? (getuid) 0))
-          (mcron-error 16
-                       "This program must be run by the root user (and should "
-                       "have been installed as such)."))
-      (if (access? config-pid-file F_OK)
-          (mcron-error 1
-		       "A cron daemon is already running.\n"
-		       "  (If you are sure this is not true, remove the file\n"
-		       "   "
-		       config-pid-file
-		       ".)"))
-      (if (not (option-ref options 'schedule #f))
-          (with-output-to-file config-pid-file noop))
-      (setenv "MAILTO" #f)
-      (c-set-cron-signals)))
 
+;; Display usage information and quit.
+
+(define (show-help)
+  (simple-format #t "Usage: ~a" command-name)
+  (display
+   (case command-type
+     ((mcron)
+      " [OPTIONS] [FILES]
+Run an mcron process according to the specifications in the FILES (`-' for
+standard input), or use all the files in ~/.config/cron (or the
+deprecated ~/.cron) with .guile or .vixie extensions.
+
+  -v, --version             Display version
+  -h, --help                Display this help message
+  -sN, --schedule[=]N       Display the next N jobs that will be run by mcron
+  -d, --daemon              Immediately detach the program from the terminal
+                              and run as a daemon process
+  -i, --stdin=(guile|vixie) Format of data passed as standard input or
+                              file arguments (default guile)")
+     ((cron)
+      " [OPTIONS]
+Unless an option is specified, run a cron daemon as a detached process,
+reading all the information in the users' crontabs and in /etc/crontab.
+
+  -v, --version             Display version
+  -h, --help                Display this help message
+  -sN, --schedule[=]N       Display the next N jobs that will be run by cron
+  -n, --noetc               Do not check /etc/crontab for updates (HIGHLY
+                              RECOMMENDED).")
+     ((crontab)
+      " [-u user] file
+       crontab [-u user] { -e | -l | -r }
+               (default operation is replace, per 1003.2)
+       -e      (edit user's crontab)
+       -l      (list user's crontab)
+       -r      (delete user's crontab)")
+     (else "\nrubbish")))
+  (newline)
+  (show-package-information)
+  (quit))
 
 
-;; Define the functions available to the configuration files. While we're here,
-;; we'll get the core loaded as well.
 
-(use-modules (mcron core)
-             (mcron job-specifier)
-             (mcron vixie-specification))
+;; Remove the /var/run/cron.pid file so that crontab and other invocations of
+;; cron don't get the wrong idea that a daemon is currently running.  This
+;; procedure is called from the C front-end whenever a terminal signal is
+;; received.
 
+(define (delete-run-file)
+  (catch #t (lambda () (delete-file config-pid-file)
+                       (delete-file config-socket-file))
+            noop)
+  (quit))
 
 
-;; Procedure to slurp the standard input into a string.
+
+;; Return standard input as a string.
 
 (define (stdin->string)
   (with-output-to-string (lambda () (do ((in (read-char) (read-char)))
@@ -251,183 +208,83 @@ Report bugs to " config-package-bugreport ".\n
 
 
 
-;; Now we have the procedures in place for dealing with the contents of
-;; configuration files, the crontab personality is able to validate such
-;; files. If the user requested the crontab personality, we load and run the
-;; code here and then get out.
-
-(if (eq? command-type 'crontab)
-    (begin
-      (load "crontab.scm")
-      (quit)))
-
-
+;; Return a thunk which process each file in \a directory with \a proc.  The
+;; \a directory must be a directory name.  The \a proc argument must be a
+;; procedure that takes one file name argument.
 
-;; Code contributed by Sergey Poznyakoff.  Determine if the given file is a
-;; regular file or not.
+(define (proc-in-directory directory proc)
+  (let ((dir (opendir directory)))
+    (do ((file-name (readdir dir) (readdir dir)))
+        ((eof-object? file-name) (closedir dir))
+      (proc file-name))))
 
-(define (regular-file? file)
-  (catch 'system-error
-	 (lambda ()
-	   (eq? (stat:type (stat file)) 'regular))
-	 (lambda (key call fmt args . rest)
-	   (mcron-error 0 (apply format (append (list #f fmt) args)))
-	   #f)))
 
 
+;; Process \a file-name according its extension.  When \a guile-syntax? is \c
+;; TRUE, force guile syntax usage.  If \a file-name format is not recognized,
+;; it is silently ignored (this deals properly with most editors' backup
+;; files, for instance).
 
-;; Procedure which processes any configuration file according to the
-;; extension. If a file is not recognized, it is silently ignored (this deals
-;; properly with most editors' backup files, for instance).
+(define process-user-file
+  (let ((guile-regexp (make-regexp "\\.gui(le)?$"))
+        (vixie-regexp (make-regexp "\\.vix(ie)?$")))
+    (lambda* (file-path #:optional assume-guile)
+      (cond ((string=? "-" file-path)
+             (if (string=? (option-ref options 'stdin "guile") "vixie")
+                 (read-vixie-port (current-input-port))
+                 (eval-string (stdin->string))))
+            ((regexp-exec vixie-regexp file-path)
+             (read-vixie-file file-path))
+            ((or assume-guile
+                 (regexp-exec guile-regexp file-path))
+             (load file-path))))))
 
-(define guile-file-regexp (make-regexp "\\.gui(le)?$"))
-(define vixie-file-regexp (make-regexp "\\.vix(ie)?$"))
 
-(define (process-user-file file-path . assume-guile)
-  (cond ((string=? file-path "-")
-               (if (string=? (option-ref options 'stdin "guile") "vixie")
-                   (read-vixie-port (current-input-port))
-                   (eval-string (stdin->string))))
-        ((or (not (null? assume-guile))
-             (regexp-exec guile-file-regexp file-path))
-         (load file-path))
-        ((regexp-exec vixie-file-regexp file-path)
-         (read-vixie-file file-path))))
 
-
-
-;; Procedure to run through all the files in a user's ~/.cron and/or
-;; $XDG_CONFIG_HOME/cron or ~/.config/cron directories (only happens under the
-;; mcron personality).
+;; Process files in $XDG_CONFIG_HOME/cron and/or ~/.cron directories (if
+;; $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead).
 
 (define (process-files-in-user-directory)
   (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")))
-    (if (eq? 2 errors)
-        (mcron-error 13
-                     "Cannot read files in your ~/.config/cron (or ~/.cron) "
-                     "directory."))))
-
-
-
-;; Procedure to check that a user name is in the passwd database (it may happen
-;; that a user is removed after creating a crontab). If the user name is valid,
-;; the full passwd entry for that user is returned to the caller.
-
-(define (valid-user user-name)
-  (setpwent)
-  (do ((entry (getpw) (getpw)))
-      ((or (not entry)
-           (string=? (passwd:name entry) user-name))
-       (endpwent)
-       entry)))
-
-
-
-;; Procedure to process all the files in the crontab directory, making sure that
-;; each file is for a legitimate user and setting the configuration-user to that
-;; user. In this way, when the job procedure is run on behalf of the
-;; configuration files, the jobs are registered with the system with the
-;; appropriate user. Note that only the root user should be able to perform this
-;; operation, but we leave it to the permissions on the /var/cron/tabs directory
-;; to enforce this.
-
-(use-modules (srfi srfi-2))  ;; For and-let*.
+    (map (lambda (dir)
+           (catch #t
+                  (lambda ()
+                    (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."))))
+
+
+
+;; Process all the files in the crontab directory.  When the job procedure is
+;; 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.
 
 (define (process-files-in-system-directory)
   (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."))))
-
-
-
-;; Having defined all the necessary procedures for scanning various sets of
-;; files, we perform the actual configuration of the program depending on the
-;; personality we are running as. If it is mcron, we either scan the files
-;; passed on the command line, or else all the ones in the user's .config/cron
-;; (or .cron) directory. If we are running under the cron personality, we read
-;; the /var/cron/tabs directory and also the /etc/crontab file.
-
-(case command-type
-  ((mcron) (if (null? (option-ref options '() '()))
-                (process-files-in-user-directory)
-                (for-each (lambda (file-path)
-                            (process-user-file file-path #t))
-                          (option-ref options '() '()))))
-  
-  ((cron) (process-files-in-system-directory)
-   (use-system-job-list)
-   (catch-mcron-error
-    (read-vixie-file "/etc/crontab" parse-system-vixie-line))
-   (use-user-job-list)
-   (if (not (option-ref options 'noetc #f))
-       (begin
-         (display
-"WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do\n
-not use this file, or you are prepared to manually restart cron whenever you\n
-make a change, then it is HIGHLY RECOMMENDED that you use the --noetc\n
-option.\n")
-         (set-configuration-user "root")
-         (job '(- (next-minute-from (next-minute)) 6)
-              check-system-crontab
-              "/etc/crontab update checker.")))))
-
-
-
-;; If the user has requested a schedule of jobs that will run, we provide the
-;; information here and then get out.
-;;
-;; Start by determining the number of time points in the future that output is
-;; required for. This may be provided on the command line as a parameter to the
-;; --schedule option, or else we assume a default of 8. Finally, ensure that the
-;; count is some positive integer.
-
-(and-let* ((count (option-ref options 'schedule #f)))
-          (set! count (string->number count))
-          (display (get-schedule (if (<= count 0) 1 count)))
-          (quit))
-    
-
-
-;; If we are supposed to run as a daemon process (either a --daemon option has
-;; been explicitly used, or we are running as cron or crond), detach from the
-;; terminal now. If we are running as cron, we can now write the PID file.
-
-(if (option-ref options 'daemon (eq? command-type 'cron))
-    (begin
-      (if (not (eqv? (primitive-fork) 0))
-          (quit))
-      (setsid)
-      (if (eq? command-type 'cron)
-          (with-output-to-file config-pid-file
-            (lambda () (display (getpid)) (newline))))))
+    (lambda ()
+      (proc-in-directory
+         config-spool-dir
+         (lambda (user-name)
+           (and-let* ((user (false-if-exception (getpwnam user-name))))
+                     (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."))))
 
 
 
@@ -436,32 +293,30 @@ option.\n")
 ;; inform the main wait-run-wait execution loop to listen for incoming messages
 ;; on this socket.
 
-(define fd-list '())
+(define (cron-file-descriptors)
+  (if (eq? command-type 'cron)
+      (catch #t
+             (lambda ()
+               (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
+                 (bind socket AF_UNIX config-socket-file)
+                 (listen socket 5)
+                 (list socket)))
+             (lambda (key . args)
+               (delete-file config-pid-file)
+               (mcron-error 1 
+                 "Cannot bind to UNIX socket " config-socket-file)))
+      '()))
 
-(if (eq? command-type 'cron)
-    (catch #t
-           (lambda ()
-             (let ((socket (socket AF_UNIX SOCK_STREAM 0)))
-               (bind socket AF_UNIX config-socket-file)
-               (listen socket 5)
-               (set! fd-list (list socket))))
-           (lambda (key . args)
-             (delete-file config-pid-file)
-             (mcron-error 1
-                          "Cannot bind to UNIX socket "
-                          config-socket-file))))
-		     
 
 
-
-;; This function is called whenever a message comes in on the above socket. We
-;; read a user name from the socket, dealing with the "/etc/crontab" special
+;; Read a user name from the socket, dealing with the /etc/crontab special
 ;; case, remove all the user's jobs from the job list, and then re-read the
-;; user's updated file. In the special case we drop all the system jobs and
-;; re-read the /etc/crontab file.
+;; user's updated file.  In the special case drop all the system jobs and
+;; re-read the /etc/crontab file.  This function should be called whenever a
+;; message comes in on the above socket.
 
-(define (process-update-request)
-  (let* ((socket (car (accept (car fd-list))))
+(define (process-update-request fd-list)
+  (let* ((socket    (car (accept (car fd-list))))
          (user-name (read-line socket)))
     (close socket)
     (set-configuration-time (current-time))
@@ -475,29 +330,123 @@ option.\n")
          (let ((user (getpw user-name)))
            (remove-user-jobs user)
            (set-configuration-user user)
-           (read-vixie-file (string-append config-spool-dir "/" user-name)))))))
-
-
-
-;; Added by Sergey Poznyakoff.  This no-op will collect zombie child processes
-;; as soon as they die.  This is a big improvement as previously they stayed
-;; around the system until the next time mcron wakes to fire a new job off.
-
-;; Unfortunately it seems to interact badly with the select system call,
-;; wreaking havoc...
-
-;; (sigaction SIGCHLD (lambda (sig) noop) SA_RESTART)
-
+           (read-vixie-file 
+                         (string-append config-spool-dir "/" user-name)))))))
 
 
-;; Now the main loop. Forever execute the run-job-loop procedure in the mcron
-;; core, and when it drops out (can only be because a message has come in on the
-;; socket) we process the socket request before restarting the loop again.
-;; Sergey Poznyakoff: we can also drop out of run-job-loop because of a SIGCHLD,
-;; so must test fd-list.
-
-(catch-mcron-error
- (while #t
-        (run-job-loop fd-list)
-        (if (not (null? fd-list))
-            (process-update-request))))
+;; Entry point.
+;;
+;; This is the 'main' routine for the whole system; this module is the global
+;; entry point (after the minimal C wrapper); to all intents and purposes the
+;; program is pure Guile and starts here.
+
+(define (main . args)
+  ;; Added by Sergey Poznyakoff.  This no-op will collect zombie child processes
+  ;; as soon as they die.  This is a big improvement as previously they stayed
+  ;; around the system until the next time mcron wakes to fire a new job off.
+  (when config-debug
+        (debug-enable 'backtrace))
+  (when (option-ref options 'version #f)
+        (show-version))
+  (when (option-ref options 'help #f)
+        (show-help))
+  
+  ;; Setup the cron process, if appropriate. If there is already a
+  ;; /var/run/cron.pid file, then we must assume a cron daemon is already
+  ;; running and refuse to start another one.
+  ;;
+  ;; Otherwise, clear the MAILTO environment variable so that output from cron
+  ;; jobs is sent to the various users (this may still be overridden in the
+  ;; configuration files), and call the function in the C wrapper to set up
+  ;; terminal signal responses to vector to the procedure above. The PID file
+  ;; will be filled in properly later when we have forked our daemon process
+  ;; (but not done if we are only viewing the schedules).
+  (when (eq? command-type 'cron)
+    (unless (eqv? (getuid) 0)
+      (mcron-error 16
+        "This program must be run by the root user (and should have been "
+        "installed as such)."))
+    (when (access? config-pid-file F_OK)
+      (mcron-error 1
+        "A cron daemon is already running.\n  (If you are sure this is not"
+        " true, remove the file\n   " config-pid-file ".)"))
+    (unless (option-ref options 'schedule #f)
+      (with-output-to-file config-pid-file noop))
+    (setenv "MAILTO" #f)
+    ;; Mathieu Lirzin: At compile time, this yields a "possibly unbound
+    ;; variable" warning, but this is OK since it is bound in the C wrapper.
+    (c-set-cron-signals))
+
+  ;; Now we have the procedures in place for dealing with the contents of
+  ;; configuration files, the crontab personality is able to validate such
+  ;; files. If the user requested the crontab personality, we load and run the
+  ;; code here and then get out.
+  (when (eq? command-type 'crontab)
+    (load "crontab.scm")
+    (quit))
+
+  ;; Having defined all the necessary procedures for scanning various sets of
+  ;; files, we perform the actual configuration of the program depending on
+  ;; the personality we are running as. If it is mcron, we either scan the
+  ;; files passed on the command line, or else all the ones in the user's
+  ;; .config/cron (or .cron) directory. If we are running under the cron
+  ;; personality, we read the /var/cron/tabs directory and also the
+  ;; /etc/crontab file.
+  (case command-type
+    ((mcron)
+     (if (null? (option-ref options '() '()))
+         (process-files-in-user-directory)
+         (for-each (lambda (file-path) (process-user-file file-path 
+                                                          'guile-syntax))
+                   (option-ref options '() '()))))
+    ((cron)
+     (process-files-in-system-directory)
+     (use-system-job-list)
+     (catch-mcron-error (read-vixie-file "/etc/crontab"
+                                         parse-system-vixie-line))
+     (use-user-job-list)
+     (unless (option-ref options 'noetc #f)
+       (display "\
+WARNING: cron will check for updates to /etc/crontab EVERY MINUTE. If you do
+not use this file, or you are prepared to manually restart cron whenever you
+make a change, then it is HIGHLY RECOMMENDED that you use the --noetc
+option.\n")
+       (set-configuration-user "root")
+       (job '(- (next-minute-from (next-minute)) 6)
+            check-system-crontab
+            "/etc/crontab update checker."))))
+
+  ;; If the user has requested a schedule of jobs that will run, we provide
+  ;; the information here and then get out.  Start by determining the number
+  ;; of time points in the future that output is required for. This may be
+  ;; provided on the command line as a parameter to the --schedule option, or
+  ;; else we assume a default of 8. Finally, ensure that the count is some
+  ;; positive integer.
+  (and-let* ((count (option-ref options 'schedule #f)))
+            (set! count (string->number count))
+            (display (get-schedule (max 1 count)))
+            (quit))
+
+  ;; If we are supposed to run as a daemon process (either a --daemon option
+  ;; has been explicitly used, or we are running as cron or crond), detach
+  ;; from the terminal now. If we are running as cron, we can now write the
+  ;; PID file.
+  (when (option-ref options 'daemon (eq? command-type 'cron))
+    (unless (eqv? (primitive-fork) 0)
+            (quit))
+    (setsid)
+    (when (eq? command-type 'cron)
+          (with-output-to-file config-pid-file
+            (lambda () (display (getpid)) (newline)))))
+  
+  ;; Now the main loop.  Forever execute the run-job-loop procedure in the
+  ;; mcron core, and when it drops out (can only be because a message has come
+  ;; in on the socket) we process the socket request before restarting the
+  ;; loop again.  Sergey Poznyakoff: we can also drop out of run-job-loop
+  ;; because of a SIGCHLD, so must test fd-list.
+  (catch-mcron-error
+   (let ((fd-list (cron-file-descriptors)))
+     (while #t
+       (run-job-loop fd-list)
+       (unless (null? fd-list)
+         (process-update-request fd-list))))))
diff --git a/scm/mcron/makefile.am b/scm/mcron/makefile.am
index 931b03b..e371311 100644
--- a/scm/mcron/makefile.am
+++ b/scm/mcron/makefile.am
@@ -1,15 +1,60 @@
-EXTRA_DIST = main.scm mcron-core.scm vixie-specification.scm \
-             crontab.scm environment.scm job-specifier.scm redirect.scm \
-             vixie-time.scm
+## Makefile for the scm/mcron directory of mcron.
 
-pkgdata_DATA = core.scm environment.scm job-specifier.scm redirect.scm \
-               vixie-time.scm vixie-specification.scm config.scm
+#  Copyright (C) 2015 Mathieu Lirzin
+#
+#  This file is part of GNU mcron.
+# 
+#  GNU mcron is free software: you can redistribute it and/or modify it under
+#  the terms of the GNU General Public License as published by the Free Software
+#  Foundation, either version 3 of the License, or (at your option) any later
+#  version.
+# 
+#  GNU mcron is distributed in the hope that it will be useful, but WITHOUT ANY
+#  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+#  A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+# 
+#  You should have received a copy of the GNU General Public License along with
+#  GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
 
+## Process this file with automake to produce makefile.in.
 
-# If you're wondering, the configure script keeps deleting all files with a name
-# like core.*, so we have to keep re-making it (I lost a good day's work because
-# of this).
 
-core.scm : mcron-core.scm
-	$(CP) mcron-core.scm core.scm
+MODULES = environment.scm			\
+          job-specifier.scm			\
+          main.scm					\
+          mcron-core.scm			\
+          redirect.scm				\
+          vixie-specification.scm	\
+          vixie-time.scm
 
+GOBJECTS = $(MODULES:%.scm=%.go) config.go
+
+nobase_dist_guilemodule_DATA = $(MODULES) crontab.scm
+nobase_nodist_guilemodule_DATA = $(GOBJECTS) config.scm
+
+CLEANFILES = $(GOBJECTS)
+
+AM_V_GUILEC = $(AM_V_GUILEC_$(V))
+AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY))
+AM_V_GUILEC_0 = @echo "  GUILEC" $@;
+
+# Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling.  Otherwise, if
+# $GUILE_LOAD_COMPILED_PATH contains $(moduledir), we may find .go files in
+# there that are newer than the local .scm files (for instance because the
+# user ran 'make install' recently).  When that happens, we end up loading
+# those previously-installed .go files, which may be stale, thereby breaking
+# the whole thing.
+#
+# XXX: Use the C locale for when Guile lacks
+# <http://git.sv.gnu.org/cgit/guile.git/commit/?h=stable-2.0&id=e2c6bf3866d1186c60bacfbd4fe5037087ee5e3f>.
+.scm.go:
+	$(AM_V_GUILEC)$(MKDIR_P) `dirname "$@"` ;			\
+	unset GUILE_LOAD_COMPILED_PATH ;					\
+	LC_ALL=C											\
+	$(GUILD) compile									\
+	  -L "$(top_builddir)/scm" -L "$(top_srcdir)/scm"	\
+	  -Wformat -Wunbound-variable -Warity-mismatch		\
+	  --target="$(host)"								\
+	  -o "$@" "$<"
+
+SUFFIXES = .go
diff --git a/scm/mcron/mcron-core.scm b/scm/mcron/mcron-core.scm
index 518bcac..9b83faf 100644
--- a/scm/mcron/mcron-core.scm
+++ b/scm/mcron/mcron-core.scm
@@ -1,4 +1,4 @@
-;;   Copyright (C) 2003 Dale Mellor
+;;   Copyright (C) 2003, 2015 Dale Mellor
 ;; 
 ;;   This file is part of GNU mcron.
 ;;
@@ -17,8 +17,9 @@
 
 
 
-(define-module (mcron core)
+(define-module (mcron mcron-core)
   #:use-module (mcron environment)
+  #:use-module (srfi srfi-9)
   #:export     (add-job
                 remove-user-jobs
                 get-schedule
@@ -38,7 +39,7 @@
 
 ;; The list of all jobs known to the system. Each element of the list is
 ;;
-;;  (vector user next-time-function action environment displayable next-time)
+;;  (make-job 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
@@ -60,18 +61,17 @@
 (define (use-system-job-list) (set! configuration-source 'system))
 (define (use-user-job-list) (set! configuration-source 'user))
 
-
-
-;; 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))
-
-
+;; 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!))
 
 ;; 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 (vector configuration-user
-                       time-proc
-                       action
-                       (get-current-environment-mods-copy)
-                       displayable
-                       (time-proc configuration-time))))
+  (let ((entry (make-job 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,18 +165,17 @@
     (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)
-                      (vector-set! job
-                                   5
-                                   ((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)
+                     (job:next-time-set! job ((job:next-time-function job)
+                                              (job:next-time job))))
+                   (cdr next-jobs)))))))
 
 
 
@@ -195,22 +194,21 @@
 ;; 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))
-                    (vector-set! job
-                                 5
-                                 ((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))
+           (job:next-time-set! job ((job:next-time-function job)
+                                    (current-time))))))
+   jobs-list))
 
 
 
diff --git a/scm/mcron/redirect.scm b/scm/mcron/redirect.scm
index 312b768..af763cb 100644
--- a/scm/mcron/redirect.scm
+++ b/scm/mcron/redirect.scm
@@ -31,6 +31,7 @@
 
 (define-module (mcron redirect)
   #:export (with-mail-out)
+  #:use-module (ice-9 regex)
   #:use-module ((mcron config) :select (config-sendmail))
   #:use-module (mcron vixie-time))
 
diff --git a/scm/mcron/vixie-specification.scm b/scm/mcron/vixie-specification.scm
index ab002ba..e7fab0a 100644
--- a/scm/mcron/vixie-specification.scm
+++ b/scm/mcron/vixie-specification.scm
@@ -30,7 +30,7 @@
             read-vixie-file
             check-system-crontab)
   #:use-module ((mcron config) :select (config-socket-file))
-  #:use-module (mcron core)
+  #:use-module (mcron mcron-core)
   #:use-module (mcron job-specifier)
   #:use-module (mcron redirect)
   #:use-module (mcron vixie-time))
@@ -162,13 +162,11 @@
                          (parse-vixie-environment line)
                          (parse-vixie-line line)))
                    (lambda (key exit-code . msg)
-                     (throw
-                      'mcron-error
-                      exit-code
-                      (apply string-append
-                             (number->string report-line)
-                             ": "
-                             msg)))))))))
+                     (throw 'mcron-error exit-code
+                            (apply string-append
+                                   (number->string report-line)
+                                   ": "
+                                   msg)))))))))