all: Rename 'scm' directory to 'src'.

* scm/mcron/config.scm.in: Rename to ...
* src/mcron/config.scm.in: ... this.
* scm/mcron/crontab.scm: Rename to ...
* src/mcron/crontab.scm: ... this.
* scm/mcron/environment.scm: Rename to ...
* src/mcron/environment.scm: ... this.
* scm/mcron/job-specifier.scm: Rename to ...
* src/mcron/job-specifier.scm: ... this.
* scm/mcron/main.scm: Rename to ...
* src/mcron/main.scm: ... this.
* scm/mcron/mcron-core.scm: Rename to ...
* src/mcron/mcron-core.scm: ... this.
* scm/mcron/redirect.scm: Rename to ...
* src/mcron/redirect.scm: ... this.
* scm/mcron/vixie-specification.scm: Rename to ...
* src/mcron/vixie-specification.scm: ... this.
* scm/mcron/vixie-time.scm: Rename to ...
* src/mcron/vixie-time.scm: ... this.
* mcron.c: Rename to ...
* src/mcron.c: ... this.
* Makefile.am: Adapt to them.
* build-aux/pre-inst-env.in: Likewise.
* configure.ac (AC_CONFIG_FILES): Likewise.
(AC_CONFIG_HEADER): Set to 'src/config.h'.
* .gitignore: Update.

1 files changed, 401 insertions, 0 deletions

diff --git a/src/mcron/main.scm b/src/mcron/main.scm
new file mode 100644
index 0000000..1f2b068
--- /dev/null
+++ b/src/mcron/main.scm
@@ -0,0 +1,401 @@
+;;   Copyright (C) 2015, 2016 Mathieu Lirzin
+;;   Copyright (C) 2003, 2012 Dale Mellor
+;; 
+;;   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/>.
+
+;;; 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 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))
+
+(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)))
+
+(define (mcron-error exit-code . rest)
+  "Print an error message (made up from the parts of REST), and if the
+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))
+      (newline)))
+  (when (and exit-code (not (eq? exit-code 0)))
+    (primitive-exit exit-code)))
+
+(define-syntax-rule (catch-mcron-error exp ...)
+  "Evaluate EXP .... if an 'mcron-error exception occurs, print its diagnostics
+and exit with its error code."
+  (catch 'mcron-error
+    (lambda () exp ...)
+    (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 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)))
+  "Display version information for COMMAND and quit."
+  (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 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)))
+
+(define (show-package-information)
+  "Display where to get help and send bug reports."
+  (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))
+
+(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)))
+                                        ((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)?$")))
+    (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
+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."
+  (let* ((sock      (car (accept (car fdes-list))))
+         (user-name (read-line sock)))
+    (close sock)
+    (set-configuration-time (current-time))
+    (catch-mcron-error
+     (if (string=? user-name "/etc/crontab")
+         (begin
+           (clear-system-jobs)
+           (use-system-job-list)
+           (read-vixie-file "/etc/crontab" parse-system-vixie-line)
+           (use-user-job-list))
+         (let ((user (getpw user-name)))
+           (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 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 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))))))