project: banish need for C compiler

This patch gets rid of the thin veneer that we currently have around the three
executables.  This was done for historical reasons (circa 2003 Guile couldnʼt
deal with process signals and forks).  In fact these problems were fixed many
moons ago, and there is now no need for it.  The project becomes 100% Guile!

Many files are affected; interested coders should use the GIT repository to
understand the details of all the changes.

1 files changed, 78 insertions, 31 deletions

diff --git a/src/mcron/scripts/mcron.scm b/src/mcron/scripts/mcron.scm
index 8ae61cf..0da1cdf 100644
--- a/src/mcron/scripts/mcron.scm
+++ b/src/mcron/scripts/mcron.scm
@@ -19,14 +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)?$")))
@@ -35,15 +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))
+                  (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))
                   (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
@@ -67,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)
@@ -77,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)))))))