From eb56ee027b4c6b5682f69fa885d16e55c4495bd8 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 28 Aug 2016 12:53:20 +0200
Subject: system: Add 'create-home-directory?' field to <user-account>.

* gnu/system/shadow.scm (<user-account>)[create-home-directory?]: New
field.
(user-account->gexp): Serialize it.
* gnu/build/activation.scm (activate-users+groups)[activate-user]:
Update 'match-lambda' pattern accordingly.  Pass #:create-home? to
'ensure-user'.
(add-user, modify-user, ensure-user): Add #:create-home? parameter and
honor it.
* doc/guix.texi (User Accounts): Document it.
---
 gnu/build/activation.scm | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

(limited to 'gnu/build')

diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm
index 6666cb4856..10aa58d85c 100644
--- a/gnu/build/activation.scm
+++ b/gnu/build/activation.scm
@@ -110,7 +110,8 @@ owner-writable in HOME."
               files)))
 
 (define* (add-user name group
-                   #:key uid comment home shell password system?
+                   #:key uid comment home create-home?
+                   shell password system?
                    (supplementary-groups '())
                    (log-port (current-error-port)))
   "Create an account for user NAME part of GROUP, with the specified
@@ -139,7 +140,7 @@ properties.  Return #t on success."
                           `("-G" ,(string-join supplementary-groups ","))
                           '())
                     ,@(if comment `("-c" ,comment) '())
-                    ,@(if home
+                    ,@(if (and home create-home?)
                           (if (file-exists? home)
                               `("-d" ,home)     ; avoid warning from 'useradd'
                               `("-d" ,home "--create-home"))
@@ -158,7 +159,8 @@ properties.  Return #t on success."
                #t)))))
 
 (define* (modify-user name group
-                      #:key uid comment home shell password system?
+                      #:key uid comment home create-home?
+                      shell password system?
                       (supplementary-groups '())
                       (log-port (current-error-port)))
   "Modify user account NAME to have all the given settings."
@@ -186,7 +188,8 @@ logged in."
   (zero? (system* "groupdel" name)))
 
 (define* (ensure-user name group
-                      #:key uid comment home shell password system?
+                      #:key uid comment home create-home?
+                      shell password system?
                       (supplementary-groups '())
                       (log-port (current-error-port))
                       #:rest rest)
@@ -207,7 +210,8 @@ numeric gid or #f."
 
   (define activate-user
     (match-lambda
-     ((name uid group supplementary-groups comment home shell password system?)
+     ((name uid group supplementary-groups comment home create-home?
+       shell password system?)
       (let ((profile-dir (string-append "/var/guix/profiles/per-user/"
                                         name)))
         (ensure-user name group
@@ -216,6 +220,7 @@ numeric gid or #f."
                      #:supplementary-groups supplementary-groups
                      #:comment comment
                      #:home home
+                     #:create-home? create-home?
                      #:shell shell
                      #:password password)
 
-- 
cgit 1.4.1


From 334bda9a9e01b73b772b3f30b04abea35e5391f8 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 28 Aug 2016 23:48:14 +0200
Subject: tests: Make sure /var/guix/gcroots/profiles is a valid symlink.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Reported by csanchezdll@gmail.com (Carlos Sánchez de La Lama)
at <https://lists.gnu.org/archive/html/guix-devel/2016-08/msg01641.html>.

* gnu/build/install.scm (directives): Add /var/guix/gcroots/profiles
symlink.
* gnu/tests/base.scm (run-basic-test)["/var/guix/gcroots/profiles is a
valid symlink"]: New test.
---
 gnu/build/install.scm | 6 +++++-
 gnu/tests/base.scm    | 9 +++++++++
 2 files changed, 14 insertions(+), 1 deletion(-)

(limited to 'gnu/build')

diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index aebf38c066..7431a09021 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -118,6 +118,10 @@ STORE."
     ("/var/guix/gcroots/booted-system" -> "/run/booted-system")
     ("/var/guix/gcroots/current-system" -> "/run/current-system")
 
+    ;; XXX: 'guix-register' creates this symlink with a wrong target, so
+    ;; create it upfront to be sure.
+    ("/var/guix/gcroots/profiles" -> "/var/guix/profiles")
+
     (directory "/bin")
     (directory "/tmp" 0 0 #o1777)                 ; sticky bit
     (directory "/var/tmp" 0 0 #o1777)
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 0076566c27..ca6f76c0f8 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -217,6 +217,15 @@ info --version")
                                       #f))))
                              marionette))
 
+          ;; This symlink is currently unused, but better have it point to the
+          ;; right place.  See
+          ;; <https://lists.gnu.org/archive/html/guix-devel/2016-08/msg01641.html>.
+          (test-equal "/var/guix/gcroots/profiles is a valid symlink"
+            "/var/guix/profiles"
+            (marionette-eval '(readlink "/var/guix/gcroots/profiles")
+                             marionette))
+
+
           (test-assert "screendump"
             (begin
               (marionette-control (string-append "screendump " #$output
-- 
cgit 1.4.1