[shepherd] 04/05: timer: Add ‘cron-string->calendar-event’.

[Ludovic Courtès]

civodul pushed a commit to branch devel
in repository shepherd.

commit 40db61351ffefb69d048e744c4a92888ac5652ba
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Mar 28 20:26:47 2024 +0100

    timer: Add ‘cron-string->calendar-event’.
    
    * modules/shepherd/service/timer.scm (cron-string->calendar-event): New
    procedure.
    * tests/services/timer-events.scm (test-cron, test-cron-error): New
    macros and tests.
    * doc/shepherd.texi (Timers): Document it.
---
 doc/shepherd.texi                  | 33 +++++++++++++++
 modules/shepherd/service/timer.scm | 87 ++++++++++++++++++++++++++++++++++++++
 tests/services/timer-events.scm    | 62 +++++++++++++++++++++++++++
 3 files changed, 182 insertions(+)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index ca7e755..e911165 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -1461,6 +1461,36 @@ hours, minutes, and so on.  Here are a few examples:
 Return a calendar event that obeys the given constraints.
 @end deffn
 
+@cindex Vixie cron, converting date specifications
+@cindex cron, converting date specifications
+Users familiar with the venerable Vixie cron can instead convert
+cron-style date specifications to a calendar event data structure using
+the @code{cron-string->calendar-event} procedure described below.
+
+@deffn {Procedure} cron-string->calendar-event @var{str}
+Convert @var{str}, which contains a Vixie cron date line, into the
+corresponding @code{calendar-event}.  Raise an error if @var{str} is invalid.
+
+A valid cron date line consists of 5 space-separated fields: minute, hour, day
+of month, month, and day of week.  Each field can be an integer, or a
+comma-separate list of integers, or a range.  Ranges are represented by two
+integers separated by a hyphen, optionally followed by slash and a number of
+repetitions.  Here are examples:
+
+@table @code
+@item 30 4 1,15 * *
+4:30AM on the 1st and 15th of each month;
+@item 5 0 * * *
+five minutes after midnight, every day;
+@item 23 0-23/2 * * 1-5
+23 minutes after the hour every two hour, on weekdays.
+@end table
+@end deffn
+
+To create a timer, you create a service with the procedures described
+below as its @code{start} and @code{stop} methods (@pxref{Defining
+Services}).
+
 @deffn {Procedure} make-timer-constructor @var{event} @var{action} @
   [#:wait-for-termination?]
 Return a procedure for use as the @code{start} method of a service.  The
@@ -1516,6 +1546,8 @@ This is the @code{trigger} service action.  When invoked, 
its effect is
 to invoke the action passed to @code{make-timer-constructor}.
 @end defvar
 
+@xref{timer-example, timer example}, to see how to put it all together.
+
 @c @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 
 @node The root Service
@@ -1758,6 +1790,7 @@ passing it the client connection.  The 
@code{#:max-connections}
 parameter instructs @command{shepherd} to accept at most 10 simultaneous
 client connections.
 
+@anchor{timer-example}
 @cindex timer, example
 Let's now look at @dfn{timers}---services that run periodically, on
 chosen calendar events.  If you ever used the systemd timers or the
diff --git a/modules/shepherd/service/timer.scm 
b/modules/shepherd/service/timer.scm
index 9a26ac7..fa2e079 100644
--- a/modules/shepherd/service/timer.scm
+++ b/modules/shepherd/service/timer.scm
@@ -26,6 +26,8 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:export (calendar-event
@@ -37,6 +39,7 @@
             calendar-event-minutes
             calendar-event-seconds
             sexp->calendar-event
+            cron-string->calendar-event
 
             next-calendar-event
 
@@ -289,6 +292,90 @@ event record."
     (+ 1 (time-second diff)
          (if (>= (time-nanosecond diff) 5e8) 1 0))))
 
+(define (cron-string->calendar-event str)
+  "Convert @var{str}, which contains a Vixie cron date line, into the
+corresponding @code{calendar-event}.  Raise an error if @var{str} is invalid.
+
+A valid cron date line consists of 5 space-separated fields: minute, hour, day
+of month, month, and day of week.  Each field can be an integer, or a
+comma-separate list of integers, or a range.  Ranges are represented by two
+integers separated by a hyphen, optionally followed by slash and a number of
+repetitions.  Here are examples:
+
+@table @code
+@item 30 4 1,15 * *
+4:30AM on the 1st and 15th of each month;
+@item 5 0 * * *
+five minutes after midnight, every day;
+@item 23 0-23/2 * * 1-5
+23 minutes after the hour every two hour, on weekdays.
+@end table"
+  (define not-comma
+    (char-set-complement (char-set #\,)))
+  (define not-hyphen
+    (char-set-complement (char-set #\-)))
+
+  (define (parse-component component count min)
+    (define (in-range? n)
+      (and (integer? n)
+           (>= n min) (< n (+ min count))))
+
+    (define (range->numbers str)
+      (let ((str step (match (string-index str #\/)
+                        (#f (values str 1))
+                        (index
+                         (values (string-take str index)
+                                 (string->number
+                                  (string-drop str (+ 1 index))))))))
+        (match (string-tokenize str not-hyphen)
+          (((= string->number min) (= string->number max))
+           (and (>= max min)
+                (in-range? min) (in-range? max)
+                (iota (floor-quotient (+ 1 (- max min)) step)
+                      min step)))
+          (((= string->number n))
+           (and (in-range? n) (list n)))
+          (_ #f))))
+
+    (match component
+      ("*" (if (= 7 count)                        ;days of week?
+               *unspecified*
+               (iota count min)))
+      (str (match (string-tokenize str not-comma)
+             (((= range->numbers numbers) ...)
+              (and (every list? numbers)
+                   (concatenate numbers)))
+             (_ #f)))))
+
+  (define (fail component)
+    (raise (condition
+            (&message
+             (message (format #f "~s: invalid ~a cron field"
+                              str component))))))
+
+  (match (string-tokenize str)
+    ((minutes hours days-of-month months days-of-week)
+     (letrec-syntax ((parse (syntax-rules ()
+                              ((_ ((id count min) rest ...) args)
+                               (let ((id (parse-component id count min)))
+                                 (if id
+                                     (parse (rest ...)
+                                            (if (unspecified? id)
+                                                args
+                                                (cons* (symbol->keyword 'id) id
+                                                       args)))
+                                     (fail 'id))))
+                              ((_ () args)
+                               (apply calendar-event args)))))
+       (parse ((minutes 60 0) (hours 60 0)
+               (days-of-month 31 1) (months 12 1) (days-of-week 7 0))
+              '())))
+    (_
+     (raise (condition
+             (&message
+              (message (format #f "~s: wrong number of cron date fields"
+                               str))))))))
+
 
 ;;;
 ;;; Timer services.
diff --git a/tests/services/timer-events.scm b/tests/services/timer-events.scm
index bdd10cc..cec61d3 100644
--- a/tests/services/timer-events.scm
+++ b/tests/services/timer-events.scm
@@ -20,6 +20,8 @@
   #:use-module (shepherd service timer)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-64))
 
 (test-begin "timer")
@@ -87,4 +89,64 @@
             (loop date (+ 1 n) (cons date result)))
           (reverse result)))))
 
+(let-syntax ((test-cron (syntax-rules ()
+                          ((_ str calendar)
+                           (test-equal (string-append
+                                        "cron-string->calendar-event, "
+                                        (object->string str))
+                             calendar
+                             (cron-string->calendar-event str))))))
+
+  ;; The following examples come from the mcron manual (info "(mcron) Crontab
+  ;; file").
+
+  ;; 4:30 am on the 1st and 15th of each month, plus every Friday
+  (test-cron "30 4 1,15 * 5"
+             (calendar-event #:minutes '(30)
+                             #:hours '(4)
+                             #:days-of-month '(1 15)
+                             #:days-of-week '(5)))
+
+  ;; five minutes after midnight, every day
+  (test-cron "5 0 * * *"
+             (calendar-event #:minutes '(5)
+                             #:hours '(0)))
+  ;; 2:15pm on the first of every month
+  (test-cron "15 14 1 * *"
+             (calendar-event #:minutes '(15)
+                             #:hours '(14)
+                             #:days-of-month '(1)))
+  ;; 10 pm on weekdays
+  (test-cron "0 22 * * 1-5"
+             (calendar-event #:minutes '(0)
+                             #:hours '(22)
+                             #:days-of-week '(1 2 3 4 5)))
+
+  ;; 23 minutes after midnight, 2am, 4am ..., everyday
+  (test-cron "23 0-23/2 * * *"
+             (calendar-event #:minutes '(23)
+                             #:hours (iota 12 0 2)))
+
+  ;; at 5 after 4 every Sunday
+  (test-cron "5 4 * * 0"
+             (calendar-event #:minutes '(5)
+                             #:hours '(4)
+                             #:days-of-week '(0))))
+
+(let-syntax ((test-cron-error
+              (syntax-rules ()
+                ((_ str invalid-field)
+                 (test-equal (format #f "cron-string->calendar-event, \
+invalid ~a field"
+                                     invalid-field)
+                   (format #f "~s: invalid ~a cron field"
+                           str invalid-field)
+                   (guard (c ((message-condition? c)
+                              (condition-message c)))
+                     (cron-string->calendar-event str)))))))
+
+  (test-cron-error "30 4 1,55 * 0" 'days-of-month)
+  (test-cron-error "30 4 22 * 9" 'days-of-week)
+  (test-cron-error "0-99 4 22 * *" 'minutes))
+
 (test-end "timer")