From efe7d19a9edafb793dca21dcefce89ead3465030 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 15 Apr 2017 22:12:37 +0200 Subject: services: 'service-parameters' becomes 'service-value'. * gnu/services.scm ()[parameters]: Rename to... [value]: ... this. Change calls to 'service-parameters' to 'service-value'. * gnu/system.scm, gnu/tests/base.scm, guix/scripts/system.scm, tests/services.scm: Likewise. * doc/guix.texi (Service Reference): Adjust accordingly. --- gnu/tests/base.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/tests/base.scm') diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index bcb8299c73..6ce5ab3de1 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -56,7 +56,7 @@ passed a gexp denoting the marionette, and it must return gexp that is inserted before the first test. This is used to introduce an extra initialization step, such as entering a LUKS passphrase." (define special-files - (service-parameters + (service-value (fold-services (operating-system-services os) #:target-type special-files-service-type))) -- cgit v1.2.3 From d5094c81156b587a3403a1881a4952f6d19b2076 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 12 May 2017 22:05:23 +0200 Subject: tests: Strengthen GC root test. * gnu/tests/base.scm (run-basic-test)["/run/current-system is a GC root"]: Check for a specific return value, 'success!. --- gnu/tests/base.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'gnu/tests/base.scm') diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 6ce5ab3de1..8fb978dde1 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -296,7 +296,8 @@ info --version") (setlocale LC_ALL before)) marionette)) - (test-assert "/run/current-system is a GC root" + (test-eq "/run/current-system is a GC root" + 'success! (marionette-eval '(begin ;; Make sure the (guix …) modules are found. (eval-when (expand load eval) @@ -317,7 +318,8 @@ info --version") (let ((system (readlink "/run/current-system"))) (guard (c ((nix-protocol-error? c) - (file-exists? system))) + (and (file-exists? system) + 'success!))) (with-store store (delete-paths store (list system)) #f)))) -- cgit v1.2.3 From e2f9832f454a63884aebd2d8bf85829012b58f1c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 12 May 2017 22:07:52 +0200 Subject: tests: "basic" test loads (guix …) modules from the right place. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is a followup to 7561881f2a5d2dc463c24713745eca03e67044bf. * gnu/tests/base.scm (run-basic-test)["/run/current-system is a GC root"]: Remove 'set!' statements, add 'add-to-load-path' statement for GUIX. --- gnu/tests/base.scm | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) (limited to 'gnu/tests/base.scm') diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 8fb978dde1..37aab8ef67 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -31,6 +31,7 @@ #:use-module (gnu services networking) #:use-module (gnu packages imagemagick) #:use-module (gnu packages ocr) + #:use-module (gnu packages package-management) #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) @@ -300,19 +301,13 @@ info --version") 'success! (marionette-eval '(begin ;; Make sure the (guix …) modules are found. - (eval-when (expand load eval) - (set! %load-path - (cons - (string-append - "/run/current-system/profile/share/guile/site/" - (effective-version)) - %load-path)) - (set! %load-compiled-path - (cons - (string-append - "/run/current-system/profile/share/guile/site/" - (effective-version)) - %load-compiled-path))) + ;; + ;; XXX: Currently shepherd and marionette run + ;; on Guile 2.0 whereas Guix is on 2.2. Yet + ;; we should be able to load the 2.0 Scheme + ;; files since it's pure Scheme. + (add-to-load-path + #+(file-append guix "/share/guile/site/2.2")) (use-modules (srfi srfi-34) (guix store)) -- cgit v1.2.3 From 41f76ae08a7a830cdeb1eaac271d714cb58fbce3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 18 May 2017 10:08:55 +0200 Subject: services: user-homes: Do not create home directories marked as no-create. Fixes a bug whereby GuixSD would create the /nonexistent directory, from user 'nobody', even though it has 'create-home-directory?' set to #f. * gnu/build/activation.scm (activate-users+groups): Add comment for \#:create-home?. (activate-user-home)[ensure-user-home]: Skip when CREATE-HOME? is #f or SYSTEM? is #t. * gnu/tests/base.scm (run-basic-test)["no extra home directories"]: New tests. --- gnu/build/activation.scm | 9 ++++++++- gnu/tests/base.scm | 22 ++++++++++++++++++++++ 2 files changed, 30 insertions(+), 1 deletion(-) (limited to 'gnu/tests/base.scm') diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index beee56d437..a1d2a9cc7d 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -227,7 +227,11 @@ numeric gid or #f." #:supplementary-groups supplementary-groups #:comment comment #:home home + + ;; Home directories of non-system accounts are created by + ;; 'activate-user-home'. #:create-home? (and create-home? system?) + #:shell shell #:password password) @@ -282,7 +286,10 @@ they already exist." (match-lambda ((name uid group supplementary-groups comment home create-home? shell password system?) - (unless (or (not home) (directory-exists? home)) + ;; The home directories of system accounts are created during + ;; activation, not here. + (unless (or (not home) (not create-home?) system? + (directory-exists? home)) (let* ((pw (getpwnam name)) (uid (passwd:uid pw)) (gid (passwd:gid pw))) diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 37aab8ef67..e5ac320b74 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -199,6 +199,28 @@ info --version") ',users+homes)) marionette))) + (test-equal "no extra home directories" + '() + + ;; Make sure the home directories that are not supposed to be + ;; created are indeed not created. + (let ((nonexistent + '#$(filter-map (lambda (user) + (and (not + (user-account-create-home-directory? + user)) + (user-account-home-directory user))) + (operating-system-user-accounts os)))) + (marionette-eval + `(begin + (use-modules (srfi srfi-1)) + + ;; Note: Do not flag "/var/empty". + (filter file-exists? + ',(remove (cut string-prefix? "/var/" <>) + nonexistent))) + marionette))) + (test-equal "login on tty1" "root\n" (begin -- cgit v1.2.3