From 15fa52f7ec85b3c2cb9f00ec8609dfe63a9ea9cd Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <mthl@gnu.org>
Date: Mon, 26 Mar 2018 22:42:26 +0200
Subject: job-specifier: Box 'configuration-user' global variable

* src/mcron/job-specifier.scm (configuration-user): Box it using
SRFI-111 to be explicit about the mutability of this object.
(job): Adapt.
(set-configuration-user): Adapt and use 'get-user'.
* tests/job-specifier.scm ("set-configuration-user: passwd entry")
("set-configuration-user: invalid uid", "set-configuration-user: uid")
("set-configuration-user: invalid spec")
("set-configuration-user: name"): New tests.
---
 src/mcron/job-specifier.scm | 10 ++++------
 tests/job-specifier.scm     | 46 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 50 insertions(+), 6 deletions(-)

diff --git a/src/mcron/job-specifier.scm b/src/mcron/job-specifier.scm
index cbfa2df..120bf99 100644
--- a/src/mcron/job-specifier.scm
+++ b/src/mcron/job-specifier.scm
@@ -33,6 +33,7 @@
   #:use-module (mcron utils)
   #:use-module (mcron vixie-time)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-111)
   #:re-export (append-environment-mods)
   #:export (range
             next-year-from         next-year
@@ -186,17 +187,14 @@ go into the list.  For example, (range 1 6 2) returns '(1 3 5)."
 ;; time; a UID is stored with each job and it is that which takes effect when
 ;; the job actually runs.
 
-(define configuration-user (getpw (getuid)))
+(define configuration-user (box (getpw (getuid))))
 
 (define configuration-time
   ;; Use SOURCE_DATE_EPOCH environment variable to support reproducible tests.
   (if (getenv "SOURCE_DATE_EPOCH") 0 (current-time)))
 
 (define (set-configuration-user user)
-  (set! configuration-user (if (or (string? user)
-                                   (integer? user))
-                               (getpw user)
-                               user)))
+  (set-box! configuration-user (get-user user)))
 (define (set-configuration-time time) (set! configuration-time time))
 
 
@@ -218,7 +216,7 @@ go into the list.  For example, (range 1 6 2) returns '(1 3 5)."
 ;; right at the top of this program).
 
 (define* (job time-proc action #:optional displayable
-              #:key (user configuration-user))
+              #:key (user (unbox configuration-user)))
   (let ((action (cond ((procedure? action) action)
                       ((list? action) (lambda () (primitive-eval action)))
                       ((string? action) (lambda () (system action)))
diff --git a/tests/job-specifier.scm b/tests/job-specifier.scm
index d0c6ae3..636c1a1 100644
--- a/tests/job-specifier.scm
+++ b/tests/job-specifier.scm
@@ -18,6 +18,7 @@
 
 (use-modules (ice-9 match)
              (srfi srfi-64)
+             (srfi srfi-111)
              (mcron job-specifier))
 
 (test-begin "job-specifier")
@@ -86,4 +87,49 @@
   (list (next-second '(52 55))
         (next-second-from 14)))
 
+;;;
+;;; Check 'configuration-user' manipulation
+;;;
+
+(define configuration-user (@@ (mcron job-specifier) configuration-user))
+
+;;; Call 'set-configuration-user' with a valid uid.
+(let ((uid (getuid)))
+  (test-equal "set-configuration-user: uid"
+    uid
+    (begin
+      (set-configuration-user uid)
+      (passwd:uid (unbox configuration-user)))))
+
+(define entry
+  ;; Random user entry.
+  (getpw))
+
+;;; Call 'set-configuration-user' with a valid user name.
+(let ((name (passwd:name entry)))
+  (test-equal "set-configuration-user: name"
+    name
+    (begin
+      (set-configuration-user name)
+      (passwd:name (unbox configuration-user)))))
+
+(define root-entry (getpw 0))
+
+;;; Call 'set-configuration-user' with a passwd entry.
+(test-equal "set-configuration-user: passwd entry"
+  root-entry
+  (begin
+    (set-configuration-user root-entry)
+    (unbox configuration-user)))
+
+;;; Call 'set-configuration-user' with an invalid uid.
+(test-error "set-configuration-user: invalid uid"
+   #t
+   (set-configuration-user -20000))
+
+;;; Call 'set-configuration-user' with an invalid spec.
+(test-error "set-configuration-user: invalid spec"
+   #t
+   (set-configuration-user 'wrong))
+
 (test-end)
-- 
cgit v1.2.3