merge from dm-v1.2.0 part 1

3 files changed, 151 insertions, 83 deletions

diff --git a/src/mcron/scripts/cron.scm b/src/mcron/scripts/cron.scm
index 1a97fdf..25c8a1a 100644
--- a/src/mcron/scripts/cron.scm
+++ b/src/mcron/scripts/cron.scm
@@ -17,6 +17,7 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Mcron.  If not, see <http://www.gnu.org/licenses/>.
 
+
 (define-module (mcron scripts cron)
   #:use-module (ice-9 getopt-long)
   #:use-module (ice-9 ftw)
@@ -28,6 +29,8 @@
   #:use-module (srfi srfi-2)
   #:export (main))
 
+
+
 (define (show-help)
   (display "Usage: cron [OPTIONS]
 Unless an option is specified, run a cron daemon as a detached process,
@@ -41,12 +44,15 @@ reading all the information in the users' crontabs and in /etc/crontab.
   (newline)
   (show-package-information))
 
-(define %options
-  `((schedule (single-char #\s) (value #t)
-              (predicate ,(λ (str) (string->number str))))
-    (noetc    (single-char #\n) (value #f))
-    (version  (single-char #\v) (value #f))
-    (help     (single-char #\h) (value #f))))
+
+
+(define  %options  `((schedule (single-char #\s) (value #t)
+                               (predicate ,string->number))
+                     (noetc    (single-char #\n) (value #f))
+                     (version  (single-char #\v) (value #f))
+                     (help     (single-char #\h) (value #f))))
+
+
 
 (define (delete-run-file)
   "Remove the /var/run/cron.pid file so that crontab and other invocations of
@@ -60,6 +66,8 @@ received."
     noop)
   (quit))
 
+
+
 (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
@@ -74,6 +82,8 @@ crontab.  This requires that command-type is 'cron."
       (delete-file config-pid-file)
       (mcron-error 1 "Cannot bind to UNIX socket " config-socket-file))))
 
+
+
 (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
@@ -103,9 +113,6 @@ operation.  The permissions on the /var/cron/tabs directory enforce this."
     (with-output-to-file config-pid-file noop))
   ;; Clear MAILTO so that outputs are sent to the various users.
   (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)
   ;; 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
@@ -138,42 +145,53 @@ option.\n")
   (let ((opts (getopt-long args %options)))
     (when config-debug
       (debug-enable 'backtrace))
-    (cond
-     ((option-ref opts 'help #f)
-      (show-help)
-      (exit 0))
-     ((option-ref opts 'version #f)
-      (show-version "cron")
-      (exit 0))
-     ((not (zero? (getuid)))
-      (mcron-error 16
-        "This program must be run by the root user (and should"
-        " have been installed as such)."))
-     ((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 ".)"))
-     (else
-      (%process-files (option-ref opts 'schedule #f)
-                      (option-ref opts 'noetc #f))
-      (cond ((option-ref opts 'schedule #f) ;display jobs schedule
-             => (λ (count)
-                  (display-schedule (max 1 (string->number count)))
-                  (exit 0)))
-            (else (case (primitive-fork) ;run the daemon
-                    ((0)
-                     (setsid)
-                     ;; we can now write the PID file.
-                     (with-output-to-file config-pid-file
-                       (λ () (display (getpid)) (newline))))
-                    (else (exit 0)))))
-      ;; Forever execute the 'run-job-loop', 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.
-      (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)))))))))
+    (cond  ((option-ref opts 'help #f)
+               (show-help)
+               (exit 0))
+           ((option-ref opts 'version #f)
+               (show-version "cron")
+               (exit 0))
+           ((not (zero? (getuid)))
+               (mcron-error 16
+                   "This program must be run by the root user (and should"
+                   " have been installed as such)."))
+           ((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 ".)"))
+           (else
+               (%process-files (option-ref opts 'schedule #f)
+                               (option-ref opts 'noetc #f))
+               (cond ((option-ref opts 'schedule #f)
+                      => (λ (count)
+                           (display-schedule (max 1 (string->number count)))
+                           (exit 0)))))))
+
+  ;; Daemonize ourself.
+  (unless  (eq? 0 (primitive-fork))  (exit 0))
+  (setsid)
+
+  ;; Set up process signal handlers, as signals are the only way to terminate
+  ;; the daemon and we MUST be graceful in defeat.
+  (for-each   (λ (x)  (sigaction  x
+                          (λ (sig)  (catch #t
+                                           (λ ()
+                                             (delete-file config-pid-file)
+                                             (delete-file config-socket-file))
+                                           noop)
+                             (exit EXIT_FAILURE))))
+                '(SIGTERM SIGINT SIGQUIT SIGHUP))
+
+  ;; We can now write the PID file.
+  (with-output-to-file  config-pid-file
+                        (λ () (display (getpid)) (newline)))
+
+  ;; Forever execute the 'run-job-loop', 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.
+  (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))))))
diff --git a/src/mcron/scripts/crontab.scm b/src/mcron/scripts/crontab.scm
index 902d3fc..480eadc 100644
--- a/src/mcron/scripts/crontab.scm
+++ b/src/mcron/scripts/crontab.scm
@@ -25,13 +25,13 @@
   #:use-module (mcron vixie-specification)
   #:export (main))
 
-(define* (show-help)
+(define (show-help)
   (display "Usage: 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")
+       -r      (delete user's crontab)")
   (newline)
   (show-package-information))
 
diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm
index 6545ada..0da1cdf 100644
--- a/src/mcron/scripts/mcron.scm
+++ b/src/mcron/scripts/mcron.scm
@@ -19,13 +19,40 @@
 
 (define-module (mcron scripts mcron)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 getopt-long)
+  #:use-module (ice-9 local-eval)
+  #:use-module (ice-9 rdelim)
   #:use-module (mcron base)
   #:use-module (mcron config)
-  #:use-module (mcron job-specifier)    ;for user/system files
+  #:use-module (mcron job-specifier)    ; For user/system files.
   #:use-module (mcron utils)
   #:use-module (mcron vixie-specification)
   #:export (main))
 
+
+
+(define (show-help)
+  (display "Usage: mcron [OPTION...] [FILE...]
+Run an mcron process according to the specifications in the FILE... (`-' for
+standard input), or use all the files in ~/.config/cron (or the deprecated
+~/.cron) with .guile or .vixie extensions.
+
+  -d, --daemon               Run as a daemon process
+  -i, --stdin=(guile|vixie)  Format of data passed as standard input or file
+                             arguments (default guile)
+  -s, --schedule[=N]         Display the next N (or 8) jobs that will be run
+  -?, --help                 Give this help list
+  -V, --version              Print program version
+
+Mandatory or optional arguments to long options are also mandatory or optional
+for any corresponding short options.
+
+Report bugs to bug-mcron@gnu.org.
+
+"))
+
+
+
 (define process-user-file
   (let ((guile-regexp (make-regexp "\\.gui(le)?$"))
         (vixie-regexp (make-regexp "\\.vix(ie)?$")))
@@ -34,13 +61,17 @@
 force guile syntax usage.  If FILE-NAME format is not recognized, it is
 silently ignored."
       (cond ((string=? "-" file-name)
-             (if (string=? input "vixie")
-                 (read-vixie-port (current-input-port))
-                 (eval-string (read-string))))
+                  (if (string=? input "vixie")
+                      (read-vixie-port (current-input-port))
+                      (eval-string (read-string)
+                                   (resolve-module '(mcron job-specifier)))))
             ((or guile-syntax? (regexp-exec guile-regexp file-name))
-             (load file-name))
+                  (eval-string (read-delimited "" (open-input-file file-name))
+                               (resolve-module '(mcron job-specifier))))
             ((regexp-exec vixie-regexp file-name)
-             (read-vixie-file file-name))))))
+                  (read-vixie-file file-name))))))
+
+
 
 (define (process-files-in-user-directory input-type)
   "Process files in $XDG_CONFIG_HOME/cron and/or ~/.cron directories (if
@@ -64,6 +95,8 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
       (mcron-error 13
         "Cannot read files in your ~/.config/cron (or ~/.cron) directory."))))
 
+
+
 (define (%process-files files input-type)
   (if (null? files)
       (process-files-in-user-directory input-type)
@@ -74,30 +107,47 @@ $XDG_CONFIG_HOME is not defined uses ~/.config/cron instead)."
 ;;; Entry point.
 ;;;
 
-(define* (main #:optional (opts '()))
-  (when config-debug
-    (debug-enable 'backtrace))
-
-  (%process-files (or (assq-ref opts 'files) '())
-                  (if (assq-ref opts 'vixie) "vixie" "guile"))
-
-  (cond ((assq-ref opts 'schedule) ;display jobs schedule
-         => (λ (count)
-              (display-schedule (max 1 count))
-              (exit 0)))
-        ((assq-ref opts 'daemon) ;run mcron as a daemon
-         (case (primitive-fork)
-           ((0)  (setsid))
-           (else (exit 0)))))
-
-  ;; Forever execute the 'run-job-loop', 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.
-  (catch-mcron-error
-   (let ((fdes-list '()))
-     (while #t
-       (run-job-loop fdes-list)
-       ;; we can also drop out of run-job-loop because of a SIGCHLD,
-       ;; so must test FDES-LIST.
-       (unless (null? fdes-list)
-         (process-update-request fdes-list))))))
+(define (main)
+
+  (let ((options
+            (getopt-long
+                (command-line)
+                `((daemon   (single-char #\d) (value #f))
+                  (stdin    (single-char #\i) (value #t)
+                            (predicate ,(λ (in) (or (string=? in "guile")
+                                                    (string=? in "vixie")))))
+                  (schedule (single-char #\s) (value optional)
+                            (predicate ,string->number))
+                  (help     (single-char #\?))
+                  (version  (single-char #\V))))))
+
+    (cond ((option-ref options 'help #f)      (show-help)             (exit 0))
+          ((option-ref options 'version #f)   (show-version "mcron")  (exit 0)))
+  
+    (when config-debug
+      (debug-enable 'backtrace))
+
+    (%process-files (option-ref options '() '())
+                    (option-ref options 'stdin "guile"))
+
+    (cond ((option-ref options 'schedule #f)
+               => (λ (count)
+                     (let ((c (if (string? count) (string->number count) 8)))
+                       (display-schedule  (if (exact-integer? c) (max 1 c) 8)))
+                     (exit 0)))
+          ((option-ref options 'daemon #f)
+               (case (primitive-fork)
+                     ((0)  (setsid))
+                     (else (exit 0)))))
+
+    ;; Forever execute the 'run-job-loop', 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.
+    (catch-mcron-error
+     (let ((fdes-list '()))
+       (while #t
+         (run-job-loop fdes-list)
+         ;; we can also drop out of run-job-loop because of a SIGCHLD,
+         ;; so must test FDES-LIST.
+         (unless (null? fdes-list)
+           (process-update-request fdes-list)))))))