summaryrefslogtreecommitdiff
path: root/gnu/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-06-22 22:36:40 +0200
committerLudovic Courtès <ludo@gnu.org>2016-06-22 22:56:06 +0200
commitc311089b0b19f094e44d3f858c29f77d757332d1 (patch)
treecc96471da3dcaaefebc1e9aba35aa5634461918b /gnu/tests
parent159daace2fc5a35795b82bdf5dbe02d5a6af6acd (diff)
downloadpatches-c311089b0b19f094e44d3f858c29f77d757332d1.tar
patches-c311089b0b19f094e44d3f858c29f77d757332d1.tar.gz
services: Add 'mcron-service'.
* gnu/services/mcron.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * gnu/tests/base.scm (%mcron-os, %test-mcron): New variables. (run-mcron-test): New procedure. * doc/guix.texi (Scheduled Job Execution): New node.
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/base.scm106
1 files changed, 105 insertions, 1 deletions
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 3dfa28f7f5..8b1fefe9f8 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -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))))