M doc/guix.texi => doc/guix.texi +78 -0
@@ 204,6 204,7 @@ System Configuration
Services
* Base Services:: Essential system services.
+* Scheduled Job Execution:: The mcron service.
* Networking Services:: Network setup, SSH daemon, etc.
* X Window:: Graphical display.
* Desktop Services:: D-Bus and desktop services.
@@ 7185,6 7186,7 @@ declaration.
@menu
* Base Services:: Essential system services.
+* Scheduled Job Execution:: The mcron service.
* Networking Services:: Network setup, SSH daemon, etc.
* X Window:: Graphical display.
* Desktop Services:: D-Bus and desktop services.
@@ 7463,6 7465,82 @@ archive}). If that is not the case, the service will fail to start.
@end deffn
+@node Scheduled Job Execution
+@subsubsection Scheduled Job Execution
+
+@cindex cron
+@cindex scheduling jobs
+The @code{(gnu services mcron)} module provides an interface to
+GNU@tie{}mcron, a daemon to run jobs at scheduled times (@pxref{Top,,,
+mcron, GNU@tie{}mcron}). GNU@tie{}mcron is similar to the traditional
+Unix @command{cron} daemon; the main difference is that it is
+implemented in Guile Scheme, which provides a lot of flexibility when
+specifying the scheduling of jobs and their actions.
+
+For example, to define an operating system that runs the
+@command{updatedb} (@pxref{Invoking updatedb,,, find, Finding Files})
+and the @command{guix gc} commands (@pxref{Invoking guix gc}) daily:
+
+@lisp
+(use-modules (guix) (gnu) (gnu services mcron))
+
+(define updatedb-job
+ ;; Run 'updatedb' at 3 AM every day.
+ #~(job '(next-hour '(3))
+ "updatedb --prunepaths='/tmp /var/tmp /gnu/store'"))
+
+(define garbage-collector-job
+ ;; Collect garbage 5 minutes after midnight every day.
+ #~(job "5 0 * * *" ;Vixie cron syntax
+ "guix gc -F 1G"))
+
+(operating-system
+ ;; @dots{}
+ (services (cons (mcron-service (list garbage-collector-job
+ updatedb-job))
+ %base-services)))
+@end lisp
+
+@xref{Guile Syntax, mcron job specifications,, mcron, GNU@tie{}mcron},
+for more information on mcron job specifications. Below is the
+reference of the mcron service.
+
+@deffn {Scheme Procedure} mcron-service @var{jobs} [#:mcron @var{mcron2}]
+Return an mcron service running @var{mcron} that schedules @var{jobs}, a
+list of gexps denoting mcron job specifications.
+
+This is a shorthand for:
+@example
+ (service mcron-service-type
+ (mcron-configuration (mcron mcron) (jobs jobs)))
+@end example
+@end deffn
+
+@defvr {Scheme Variable} mcron-service-type
+This is the type of the @code{mcron} service, whose value is an
+@code{mcron-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 addition
+mcron jobs to run.
+@end defvr
+
+@deftp {Data Type} mcron-configuration
+Data type representing the configuration of mcron.
+
+@table @asis
+@item @code{mcron} (default: @var{mcron2})
+The mcron package to use.
+
+@item @code{jobs}
+This is a list of gexps (@pxref{G-Expressions}), where each gexp
+corresponds to an mcron job specification (@pxref{Syntax, mcron job
+specifications,, mcron, GNU@tie{}mcron}).
+@end table
+@end deftp
+
+
@node Networking Services
@subsubsection Networking Services
M gnu/local.mk => gnu/local.mk +1 -0
@@ 377,6 377,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/dict.scm \
%D%/services/lirc.scm \
%D%/services/mail.scm \
+ %D%/services/mcron.scm \
%D%/services/networking.scm \
%D%/services/shepherd.scm \
%D%/services/herd.scm \
A gnu/services/mcron.scm => gnu/services/mcron.scm +115 -0
@@ 0,0 1,115 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 mcron)
+ #:use-module (gnu services)
+ #:use-module (gnu services base)
+ #:use-module (gnu services shepherd)
+ #:autoload (gnu packages guile) (mcron2)
+ #:use-module (guix records)
+ #:use-module (guix gexp)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 vlist)
+ #:export (mcron-configuration
+ mcron-configuration?
+ mcron-configuration-mcron
+ mcron-configuration-jobs
+
+ mcron-service-type
+ mcron-service))
+
+;;; Commentary:
+;;;
+;;; This module implements a service that to run instances of GNU mcron, a
+;;; periodic job execution daemon. Example of a service:
+;;
+;; (service mcron-service-type
+;; (mcron-configuration
+;; (jobs (list #~(job next-second-from
+;; (lambda ()
+;; (call-with-output-file "/dev/console"
+;; (lambda (port)
+;; (display "hello!\n" port)))))))))
+;;;
+;;; Code:
+
+(define-record-type* <mcron-configuration> mcron-configuration
+ make-mcron-configuration
+ mcron-configuration?
+ (mcron mcron-configuration-mcron ;package
+ (default mcron2))
+ (jobs mcron-configuration-jobs ;list of <mcron-job>
+ (default '())))
+
+(define (job-file job)
+ (scheme-file "mcron-job" job))
+
+(define mcron-shepherd-services
+ (match-lambda
+ (($ <mcron-configuration> mcron ()) ;nothing to do!
+ '())
+ (($ <mcron-configuration> mcron jobs)
+ (list (shepherd-service
+ (provision '(mcron))
+ (requirement '(user-processes))
+ (modules `((srfi srfi-1)
+ (srfi srfi-26)
+ ,@%default-modules))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$mcron "/bin/mcron")
+ #$@(map job-file jobs))
+
+ ;; Disable auto-compilation of the job files and set a
+ ;; sane value for 'PATH'.
+ #:environment-variables
+ (cons* "GUILE_AUTO_COMPILE=0"
+ "PATH=/run/current-system/profile/bin"
+ (remove (cut string-prefix? "PATH=" <>)
+ (environ)))))
+ (stop #~(make-kill-destructor)))))))
+
+(define mcron-service-type
+ (service-type (name 'mcron)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ mcron-shepherd-services)
+ (service-extension profile-service-type
+ (compose list
+ mcron-configuration-mcron))))
+ (compose concatenate)
+ (extend (lambda (config jobs)
+ (mcron-configuration
+ (inherit config)
+ (jobs (append (mcron-configuration-jobs config)
+ jobs)))))))
+
+(define* (mcron-service jobs #:optional (mcron mcron2))
+ "Return an mcron service running @var{mcron} that schedules @var{jobs}, a
+list of gexps denoting mcron job specifications.
+
+This is a shorthand for:
+@example
+ (service mcron-service-type
+ (mcron-configuration (mcron mcron) (jobs jobs)))
+@end example
+"
+ (service mcron-service-type
+ (mcron-configuration (mcron mcron) (jobs jobs))))
+
+;;; mcron.scm ends here
M gnu/tests/base.scm => gnu/tests/base.scm +105 -1
@@ 24,6 24,7 @@
#:use-module (gnu system shadow)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
#:use-module (guix gexp)
#:use-module (guix store)
@@ 31,7 32,8 @@
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:export (run-basic-test
- %test-basic-os))
+ %test-basic-os
+ %test-mcron))
(define %simple-os
(operating-system
@@ 178,3 180,105 @@ functionality tests.")
;; 'system-qemu-image/shared-store-script'.
(run-basic-test (virtualized-operating-system os '())
#~(list #$run))))))
+
+
+;;;
+;;; Mcron.
+;;;
+
+(define %mcron-os
+ ;; System with an mcron service, with one mcron job for "root" and one mcron
+ ;; job for an unprivileged user (note: #:user is an 'mcron2' thing.)
+ (let ((job1 #~(job next-second-from
+ (lambda ()
+ (call-with-output-file "witness"
+ (lambda (port)
+ (display (list (getuid) (getgid)) port))))))
+ (job2 #~(job next-second-from
+ (lambda ()
+ (call-with-output-file "witness"
+ (lambda (port)
+ (display (list (getuid) (getgid)) port))))
+ #:user "alice"))
+ (job3 #~(job next-second-from ;to test $PATH
+ "touch witness-touch")))
+ (operating-system
+ (inherit %simple-os)
+ (services (cons (mcron-service (list job1 job2 job3))
+ (operating-system-user-services %simple-os))))))
+
+(define (run-mcron-test name)
+ (mlet* %store-monad ((os -> (marionette-operating-system
+ %mcron-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+ (command (system-qemu-image/shared-store-script
+ os #:graphic? #f)))
+ (define test
+ #~(begin
+ (use-modules (gnu build marionette)
+ (srfi srfi-64)
+ (ice-9 match))
+
+ (define marionette
+ (make-marionette (list #$command)))
+
+ (define (wait-for-file file)
+ ;; Wait until FILE exists in the guest; 'read' its content and
+ ;; return it.
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((file-exists? ,file)
+ (call-with-input-file ,file read))
+ ((> i 0)
+ (sleep 1)
+ (loop (- i 1)))
+ (else
+ (error "file didn't show up" ,file))))
+ marionette))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "mcron")
+
+ (test-eq "service running"
+ 'running!
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'mcron)
+ 'running!)
+ marionette))
+
+ ;; Make sure root's mcron job runs, has its cwd set to "/root", and
+ ;; runs with the right UID/GID.
+ (test-equal "root's job"
+ '(0 0)
+ (wait-for-file "/root/witness"))
+
+ ;; 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")
+ ((1000 gid)
+ (>= gid 100))))
+
+ ;; Last, the job that uses a command; allows us to test whether
+ ;; $PATH is sane. (Note that 'marionette-eval' stringifies objects
+ ;; that don't have a read syntax, hence the string.)
+ (test-equal "root's job with command"
+ "#<eof>"
+ (wait-for-file "/root/witness-touch"))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0))))
+
+ (gexp->derivation name test
+ #:modules '((gnu build marionette)))))
+
+(define %test-mcron
+ (system-test
+ (name "mcron")
+ (description "Make sure the mcron service works as advertised.")
+ (value (run-mcron-test name))))