Subject: Re: [bug#38429] [PATCH 1/5] document scron

From: Ludovic Courtès <[email-masked]>
Date: Sun, 08 Dec 2019 00:32:30 +0100

Hi Robert,

Robert Vollmert <[email-masked]> skribis:

> The first in a series of supplementary patches on top of the base scron
> service patch, to be squashed into that commit.

Attached is my attempt at squashing it all (except the mcron description
bit) and removing redundancy in the manual (it’s not necessary to copy
the whole mcron example and s/mcron/scron/ IMO).

However, the test fails, and I realize it’s also mostly copy/pasted from
the mcron test.  I think the two tests should be factorized, just like
we factorized the SSH daemon tests in (gnu tests ssh).

Could you pick it up from there?

Thanks in advance,
Ludo’.

>From 7afbcbcd0e00d2db26f139363be81ca26a61095f Mon Sep 17 00:00:00 2001
From: Robert Vollmert <[email-masked]>
Date: Fri, 29 Nov 2019 19:07:22 +0100
Subject: [PATCH] services: Add scron.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

It's a simple replacement for the mcron service.

If you have a mcron job definition like

(define cron-job
  #~(job "*/15 * * * *" #$(program-file ...)))

you can convert it into the valid scron job

(define cron-job
  (scron-job (schedule "/15 * * * *")
             (program-file ...)))

* gnu/services/scron.scm: New file.
* gnu/local.mk: Add it.
* gnu/tests/base.scm (%scron-os): New variable.
(run-scron-test): New procedure.
(%test-scron): New variable.
* doc/guix.texi: Add documentation for scron-service.

Signed-off-by: Ludovic Courtès <[email-masked]>
---
 doc/guix.texi          |  77 +++++++++++++++++++++++++++++-
 gnu/local.mk           |   1 +
 gnu/services/scron.scm | 103 +++++++++++++++++++++++++++++++++++++++++
 gnu/tests/base.scm     |  86 ++++++++++++++++++++++++++++++++++
 4 files changed, 266 insertions(+), 1 deletion(-)
 create mode 100644 gnu/services/scron.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 446534c576..0fa8a9bd01 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -282,7 +282,7 @@ System Configuration
 Services
 
 * Base Services::               Essential system services.
-* Scheduled Job Execution::     The mcron service.
+* Scheduled Job Execution::     Cron services.
 * Log Rotation::                The rottlog service.
 * Networking Services::         Network setup, SSH daemon, etc.
 * X Window::                    Graphical display.
@@ -12899,6 +12899,81 @@ specifications,, mcron, GNU@tie{}mcron}).
 @end deftp

+@cindex scron
+@cindex scheduling jobs
+The @code{(gnu services scron)} module provides an interface to
+scron, a simple daemon to run jobs at scheduled times. scron is
+similar to the traditional Unix @command{cron} daemon;
+the main difference is that it is much simpler.
+
+Jobs are executed as root @i{via} the shell with working direction
+@code{/}.  Use @code{su} or corresponding Guile functions
+(@pxref{Processes,,, guile, GNU Guile Reference Manual}).
+
+The example below defines an operating system that runs the
+@command{updatedb} command (@pxref{Invoking updatedb,,, find, Finding
+Files}) daily:
+
+@lisp
+(use-modules (guix) (gnu) (gnu services scron))
+(use-package-modules base)
+
+(define updatedb-job
+  ;; Run 'updatedb' at 3AM every day.
+  (let* ((exp #~(begin
+                  (execl (string-append #$findutils "/bin/updatedb")
+                         "updatedb"
+                         "--prunepaths=/tmp /var/tmp /gnu/store")))
+         (script (program-file "updatedb-job" exp)))
+    (scron-job
+      (schedule "0 3 * * *")
+      (command  script))))
+
+(operating-system
+  ;; @dots{}
+  (services (cons (service scron-service-type
+                           (scron-configuration
+                            (jobs (list updatedb-job))))
+                  %base-services)))
+@end lisp
+
+@defvr {Scheme Variable} scron-service-type
+
+This is the type of the @code{scron} service, whose value is an
+@code{scron-configuration} object.
+
+This service type can be the target of a service extension that provides
+it additional job specifications (@pxref{Service Composition}).  In
+other words, it is possible to define services that provide additional
+mcron jobs to run.
+@end defvr
+
+@deftp {Data Type} scron-configuration
+Data type representing the configuration of scron.
+
+@table @asis
+@item @code{scron} (default: @var{scron})
+The scron package to use.
+
+@item @code{jobs}
+This is a list of scron jobs.
+@end table
+@end deftp
+
+@deftp {Data Type} scron-job
+Data type representing an scron job.
+
+@table @asis
+@item @code{schedule}
+The job schedule, in Vixie cron syntax. See the @code{scron(1)}
+man page for more information.
+
+@item @code{command}
+The shell command to run, as a value that lowers to a string.
+@end table
+@end deftp
+
+
 @node Log Rotation
 @subsection Log Rotation
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 80ef0f04d0..4602e464f7 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -554,6 +554,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/services/nix.scm				\
   %D%/services/nfs.scm			\
   %D%/services/pam-mount.scm			\
+  %D%/services/scron.scm			\
   %D%/services/security-token.scm		\
   %D%/services/shepherd.scm			\
   %D%/services/sound.scm			\
diff --git a/gnu/services/scron.scm b/gnu/services/scron.scm
new file mode 100644
index 0000000000..b9b2983e96
--- /dev/null
+++ b/gnu/services/scron.scm
@@ -0,0 +1,103 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Robert Vollmert <[email-masked]>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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 Guix 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 Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services scron)
+  #:use-module (gnu services)
+  #:use-module (gnu services shepherd)
+  #:autoload   (gnu packages suckless) (scron)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (guix store)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (scron-configuration
+            scron-configuration?
+            scron-configuration-scron
+            scron-configuration-jobs
+
+            scron-job
+            scron-job?
+            scron-job-schedule
+            scron-job-command
+
+            scron-service-type
+            scron-service))
+
+;;; Commentary:
+;;;
+;;; This module implements a service to run instances of scron, a
+;;; periodic job execution daemon.  Example of a service:
+;;
+;;  (service scron-service-type
+;;           (scron-configuration
+;;            (jobs (list (scron-job (schedule "*/15 * * * *")
+;;                                   (command  "echo hello!"))))))
+;;;
+;;; Code:
+
+(define-record-type* <scron-configuration> scron-configuration
+  make-scron-configuration
+  scron-configuration?
+  (scron             scron-configuration-scron    ;package
+                     (default scron))
+  (jobs              scron-configuration-jobs     ;list of <scron-job>
+                     (default '())))
+
+(define-record-type* <scron-job> scron-job
+  make-scron-job
+  scron-job?
+  (schedule scron-job-schedule)
+  (command  scron-job-command))
+
+(define (crontab jobs)
+  (apply mixed-text-file "crontab"
+    (concatenate
+      (map
+        (match-lambda
+          (($ <scron-job> schedule command)
+            (list schedule " " command "\n")))
+        jobs))))
+
+(define scron-shepherd-services
+  (match-lambda
+    (($ <scron-configuration> scron jobs)
+     (list
+       (shepherd-service
+        (provision '(scron))
+        (requirement '(user-processes))
+        (start #~(make-forkexec-constructor
+                  (list (string-append #$scron "/bin/crond")
+                        "-n" ; don't fork
+                        "-f" #$(crontab jobs))
+                  #:log-file "/var/log/scron.log"))
+        (stop #~(make-kill-destructor)))))))
+
+(define scron-service-type
+  (service-type (name 'scron)
+                (description
+                 "Run the scron job scheduling daemon.")
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          scron-shepherd-services)))
+                (compose concatenate)
+                (extend (lambda (config jobs)
+                          (scron-configuration
+                           (inherit config)
+                           (jobs (append (scron-configuration-jobs config)
+                                         jobs)))))
+                (default-value (scron-configuration))))
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index a891711844..b80e77be66 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -28,6 +28,7 @@
   #:use-module (gnu services dbus)
   #:use-module (gnu services avahi)
   #:use-module (gnu services mcron)
+  #:use-module (gnu services scron)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services networking)
   #:use-module (gnu packages base)
@@ -48,6 +49,7 @@
             %test-halt
             %test-cleanup
             %test-mcron
+            %test-scron
             %test-nss-mdns))
 
 (define %simple-os
@@ -720,6 +722,90 @@ non-ASCII names from /tmp.")
    (description "Make sure the mcron service works as advertised.")
    (value (run-mcron-test name))))
 
+
+;;;
+;;; Scron.
+;;;
+
+(define %scron-os
+  ;; System with an scron service, with one scron job for "root" and one scron
+  ;; job for an unprivileged user.
+  (let ((job1
+         (scron-job
+          (schedule "* * * * *")
+          (command  "(id -u; id -g) > witness")))
+        (job2
+         (scron-job
+          (schedule "* * * * *")
+          (command  "su -c '(id -u; id -g) > ~/witness' alice")))
+        (job3
+         (scron-job
+          (schedule "* * * * *")
+          (command  "touch witness-touch"))))
+    (simple-operating-system
+     (service scron-service-type
+              (scron-configuration (jobs (list job1 job2 job3)))))))
+
+(define (run-scron-test name)
+  (define os
+    (marionette-operating-system
+     %scron-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "scron")
+
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'scron))
+             marionette))
+
+          ;; Make sure root's scron job runs, has its cwd set to "/", and
+          ;; runs with the right UID/GID.
+          (test-equal "root's job"
+            '(0 0)
+            (wait-for-file "/witness" marionette))
+
+          ;; Likewise for Alice's job.  We cannot know what its GID is since
+          ;; it's chosen by 'groupadd', but it's strictly positive.
+          (test-assert "alice's job"
+            (match (wait-for-file "/home/alice/witness" marionette)
+              ((1000 gid)
+               (>= gid 100))))
+
+          ;; Last, the job that uses a command; allows us to test whether
+          ;; $PATH is sane.
+          (test-equal "root's job with command"
+            ""
+            (wait-for-file "/witness-touch" marionette
+                           #:read '(@ (ice-9 rdelim) read-string)))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation name test))
+
+(define %test-scron
+  (system-test
+   (name "scron")
+   (description "Make sure the scron service works as advertised.")
+   (value (run-scron-test name))))
+
 
 ;;;
 ;;; Avahi and NSS-mDNS.
-- 
2.24.0