all: Separate programs in different executables.

This improves readability and complies with the GNU Coding Standards by
making the behavior of the programs independent of the name used to
invoke them.

* src/mcron/scripts/cron.scm: New file.
* src/mcron/scripts/crontab.scm: Likewise.
* src/mcron/scripts/mcron.scm: Likewise.
* Makefile.am (dist_mcronmodule_DATA): Remove 'src/mcron/crontab.scm'.
(bin_PROGRAMS): Add 'crontab'.
(sbin_PROGRAMS): Add 'cron'.
(mcron_CFLAGS, mcron_LDADD): Rename to ...
(AM_CFLAGS, LDADD): ... these.
(cron_SOURCES, cron_CPPFLAGS, cron_DEPENDENCIES)
(crontab_SOURCES, crontab_CPPFLAGS, crontab_DEPENDENCIES)
(mcron_CPPFLAGS, mcronscriptdir, dist_mcronscript_DATA): New variables.
(modules): Redefine it in terms of other '_DATA' variables.
* src/mcron/crontab.scm: Remove file.
* src/mcron/main.scm (parse-args): New procedure.
(command-name, command-type, options): Remove.
(show-version): Adapt.
(show-help, process-files-in-system-directory, cron-file-descriptors)
(main, process-user-file, process-files-in-user-directory): Move
procedures in the new files.
* src/mcron.c (inner_main): Define the current module at compile time.
* TODO: Update.
* .gitignore: Likewise.

1 files changed, 18 insertions, 301 deletions

diff --git a/src/mcron/main.scm b/src/mcron/main.scm
index db7dfd6..1faa1ae 100644
--- a/src/mcron/main.scm
+++ b/src/mcron/main.scm
@@ -16,30 +16,22 @@
 ;;   You should have received a copy of the GNU General Public License along
 ;;   with GNU mcron.  If not, see <http://www.gnu.org/licenses/>.
 
-;;; 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-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 base)
   #: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))
-
-(define* (command-name #:optional (command (car (command-line))))
-  "Extract the actual command name from COMMAND.  This returns the last part
-of COMMAND without any non-alphabetic characters.  For example \"in.cron\" and
-\"./mcron\" will return respectively \"cron\" and \"mcron\".
-
-When COMMAND is not specified this uses the first element of (command-line)."
-  (match:substring (regexp-exec (make-regexp "[[:alpha:]]*$") command)))
+  #:export (catch-mcron-error
+            mcron-error
+            parse-args
+            show-version
+            show-package-information
+            stdin->string
+            for-each-file
+            process-update-request)
+  #:re-export (option-ref))
 
 (define (mcron-error exit-code . rest)
   "Print an error message (made up from the parts of REST), and if the
@@ -47,7 +39,7 @@ EXIT-CODE error is fatal (present and non-zero) then exit to the system with
 EXIT-CODE."
   (with-output-to-port (current-error-port)
     (lambda ()
-      (for-each display (append (list (command-name) ": ") rest))
+      (for-each display (cons "mcron: " rest))
       (newline)))
   (when (and exit-code (not (eq? exit-code 0)))
     (primitive-exit exit-code)))
@@ -60,48 +52,14 @@ and exit with its error code."
     (lambda (key exit-code . msg)
       (apply mcron-error exit-code msg))))
 
-(define command-type
-  ;; 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.
-  (let* ((command   (command-name))
-         (command=? (cut string=? command <>)))
-    (cond ((command=? "mcron") 'mcron)
-          ((or (command=? "cron") (command=? "crond")) 'cron)
-          ((command=? "crontab") 'crontab)
-          (else (mcron-error 12 "The command name is invalid.")))))
+(define (parse-args args option-desc-list)
+  "Parse ARGS with OPTION-DESC-LIST specification."
+  (catch 'misc-error
+    (lambda () (getopt-long args option-desc-list))
+    (lambda (key func fmt args . rest)
+      (mcron-error 1 (apply format (append (list #f fmt) args))))))
 
-(define options
-  ;; 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.
-  (catch
-   'misc-error
-   (lambda ()
-     (getopt-long (command-line)
-                  (append
-                   (case command-type
-                     ((crontab)
-                      '((user     (single-char #\u) (value #t))
-                        (edit     (single-char #\e) (value #f))
-                        (list     (single-char #\l) (value #f))
-                        (remove   (single-char #\r) (value #f))))
-                     (else `((schedule (single-char #\s) (value #t)
-                                       (predicate
-                                        ,(lambda (value)
-                                           (string->number value))))
-                             (daemon   (single-char #\d) (value #f))
-                             (noetc    (single-char #\n) (value #f))
-                             (stdin    (single-char #\i) (value #t)
-                                       (predicate
-                                        ,(lambda (value)
-                                           (or (string=? "vixie" value)
-                                               (string=? "guile" value))))))))
-                   '((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))))))
-
-(define* (show-version #:optional (command (command-name)))
+(define (show-version command)
   "Display version information for COMMAND and quit."
   (let* ((name       config-package-name)
          (short-name (cadr (string-split name #\space)))
@@ -111,8 +69,7 @@ Copyright (C) 2015 the ~a authors.
 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 short-name)
-    (quit)))
+		   command name version short-name)))
 
 (define (show-package-information)
   "Display where to get help and send bug reports."
@@ -123,56 +80,6 @@ General help using GNU software: <http://www.gnu.org/gethelp/>\n"
 		 config-package-name
 		 config-package-url))
 
-(define* (show-help #:optional (command (command-name)))
-  "Display informations of usage for COMMAND and quit."
-  (simple-format #t "Usage: ~a" command)
-  (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 (delete-run-file)
-  "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."
-  (catch #t (lambda () (delete-file config-pid-file)
-                       (delete-file config-socket-file))
-            noop)
-  (quit))
-
 (define (stdin->string)
   "Return standard input as a string."
   (with-output-to-string (lambda () (do ((in (read-char) (read-char)))
@@ -188,83 +95,6 @@ is not specified"
         ((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)?$")))
-    (lambda* (file-name #:optional guile-syntax?)
-      "Process FILE-NAME according its extension.  When GUILE-SYNTAX? is TRUE,
-force guile syntax usage.  If FILE-NAME format is not recognized, it is
-silently ignored."
-      (cond ((string=? "-" file-name)
-             (if (string=? (option-ref options 'stdin "guile") "vixie")
-                 (read-vixie-port (current-input-port))
-                 (eval-string (stdin->string))))
-            ((or guile-syntax? (regexp-exec guile-regexp file-name))
-             (load file-name))
-            ((regexp-exec vixie-regexp file-name)
-             (read-vixie-file file-name))))))
-
-(define (process-files-in-user-directory)
-  "Process files in $XDG_CONFIG_HOME/cron and/or ~/.cron directories (if
-$XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
-  (let ((errors 0)
-        (home-directory (passwd:dir (getpw (getuid)))))
-    (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."))))
-
-(define (process-files-in-system-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 (user-entry name)
-    ;; Return the user database entry if NAME is valid, otherwise #f.
-    (false-if-exception (getpwnam name)))
-
-  (catch #t
-    (lambda ()
-      (for-each-file
-       (lambda (user)
-         (and-let* ((entry (user-entry user))) ;crontab without user?
-           (set-configuration-user entry)
-           (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
-a list containing the file descriptors correponding to the files read by
-crontab.  This requires that command-type is 'cron."
-  (if (eq? command-type 'cron)
-      (catch #t
-	(lambda ()
-	  (let ((sock (socket AF_UNIX SOCK_STREAM 0)))
-	    (bind sock AF_UNIX config-socket-file)
-	    (listen sock 5)
-	    (list sock)))
-	(lambda (key . args)
-	  (delete-file config-pid-file)
-	  (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file)))
-      '()))
-
 (define (process-update-request fdes-list)
   "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
@@ -286,116 +116,3 @@ comes in on the above socket."
            (remove-user-jobs user)
            (set-configuration-user user)
            (read-vixie-file (string-append config-spool-dir "/" user-name)))))))
-
-
-;;;
-;;; Entry point.
-;;;
-
-(define (main . args)
-  ;; Turn debugging on if indicated.
-  (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)
-    ;; XXX: 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 #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)
-     (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 (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.
-  (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 base, 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 FDES-LIST.
-  (catch-mcron-error
-   (let ((fdes-list (cron-file-descriptors)))
-     (while #t
-       (run-job-loop fdes-list)
-       (unless (null? fdes-list)
-         (process-update-request fdes-list))))))