From 7afbcbcd0e00d2db26f139363be81ca26a61095f Mon Sep 17 00:00:00 2001
From: Robert Vollmert <rob@vllmrt.net>
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 <ludo@gnu.org>
---
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
@@ -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
@@ -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 \
new file mode 100644
@@ -0,0 +1,103 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
+;;;
+;;; 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))))
@@ -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