From patchwork Mon Mar 4 11:16:41 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 1284 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id A999F16CF8; Mon, 4 Mar 2019 11:17:10 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 188EB16CF5 for ; Mon, 4 Mar 2019 11:17:10 +0000 (GMT) Received: from localhost ([127.0.0.1]:52080 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h0lan-0002HP-NH for patchwork@mira.cbaines.net; Mon, 04 Mar 2019 06:17:09 -0500 Received: from eggs.gnu.org ([209.51.188.92]:36236) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h0lai-0002Gq-5E for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:05 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1h0lag-0000VR-NB for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:45486) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1h0lag-0000UL-GS for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1h0lag-0006HA-A8 for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#34730] [PATCH 1/4] system: Add (gnu system accounts). References: <20190304111213.8436-1-ludo@gnu.org> In-Reply-To: <20190304111213.8436-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 04 Mar 2019 11:17:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 34730 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 34730@debbugs.gnu.org Received: via spool by 34730-submit@debbugs.gnu.org id=B34730.155169821524077 (code B ref 34730); Mon, 04 Mar 2019 11:17:02 +0000 Received: (at 34730) by debbugs.gnu.org; 4 Mar 2019 11:16:55 +0000 Received: from localhost ([127.0.0.1]:59022 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h0laY-0006GE-Dy for submit@debbugs.gnu.org; Mon, 04 Mar 2019 06:16:54 -0500 Received: from hera.aquilenet.fr ([185.233.100.1]:34604) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h0laW-0006Fz-CQ for 34730@debbugs.gnu.org; Mon, 04 Mar 2019 06:16:53 -0500 Received: from localhost (localhost [127.0.0.1]) by hera.aquilenet.fr (Postfix) with ESMTP id C481D9B0B; Mon, 4 Mar 2019 12:16:51 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at aquilenet.fr Received: from hera.aquilenet.fr ([127.0.0.1]) by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id uqBlCuCrpN-T; Mon, 4 Mar 2019 12:16:50 +0100 (CET) Received: from gnu.org (unknown [IPv6:2001:660:6102:320:e120:2c8f:8909:cdfe]) by hera.aquilenet.fr (Postfix) with ESMTPSA id 025E59B02; Mon, 4 Mar 2019 12:16:49 +0100 (CET) From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 4 Mar 2019 12:16:41 +0100 Message-Id: <20190304111644.8573-1-ludo@gnu.org> X-Mailer: git-send-email 2.21.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches The (gnu system accounts) module is meant to be used both on the build- and on the host-side. * gnu/system/shadow.scm : Call 'default-shell'. (, ): Move to... * gnu/system/accounts.scm: ... here. New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add system/accounts.scm. --- gnu/local.mk | 1 + gnu/system/accounts.scm | 81 +++++++++++++++++++++++++++++++++++++++++ gnu/system/shadow.scm | 72 +++++++++++++----------------------- 3 files changed, 107 insertions(+), 47 deletions(-) create mode 100644 gnu/system/accounts.scm diff --git a/gnu/local.mk b/gnu/local.mk index 3d59e27e8f..a8915cf36b 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -527,6 +527,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/xorg.scm \ \ %D%/system.scm \ + %D%/system/accounts.scm \ %D%/system/file-systems.scm \ %D%/system/install.scm \ %D%/system/linux-container.scm \ diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm new file mode 100644 index 0000000000..36ee62e851 --- /dev/null +++ b/gnu/system/accounts.scm @@ -0,0 +1,81 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu system accounts) + #:use-module (guix records) + #:export (user-account + user-account? + user-account-name + user-account-password + user-account-uid + user-account-group + user-account-supplementary-groups + user-account-comment + user-account-home-directory + user-account-create-home-directory? + user-account-shell + user-account-system? + + user-group + user-group? + user-group-name + user-group-password + user-group-id + user-group-system? + + default-shell)) + + +;;; Commentary: +;;; +;;; Data structures representing user accounts and user groups. This is meant +;;; to be used both on the host side and at run time--e.g., in activation +;;; snippets. +;;; +;;; Code: + +(define default-shell + ;; Default shell for user accounts (a string or string-valued gexp). + (make-parameter "/bin/sh")) + +(define-record-type* + user-account make-user-account + user-account? + (name user-account-name) + (password user-account-password (default #f)) + (uid user-account-uid (default #f)) + (group user-account-group) ; number | string + (supplementary-groups user-account-supplementary-groups + (default '())) ; list of strings + (comment user-account-comment (default "")) + (home-directory user-account-home-directory) + (create-home-directory? user-account-create-home-directory? ;Boolean + (default #t)) + (shell user-account-shell ; gexp + (default (default-shell))) + (system? user-account-system? ; Boolean + (default #f))) + +(define-record-type* + user-group make-user-group + user-group? + (name user-group-name) + (password user-group-password (default #f)) + (id user-group-id (default #f)) + (system? user-group-system? ; Boolean + (default #f))) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 63f544cec9..a9a4afd414 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2016 Alex Griffin ;;; ;;; This file is part of GNU Guix. @@ -24,6 +24,7 @@ #:use-module (guix modules) #:use-module (guix sets) #:use-module (guix ui) + #:use-module (gnu system accounts) #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module ((gnu system file-systems) @@ -36,27 +37,29 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) - #:export (user-account - user-account? - user-account-name - user-account-password - user-account-uid - user-account-group - user-account-supplementary-groups - user-account-comment - user-account-home-directory - user-account-create-home-directory? - user-account-shell - user-account-system? - user-group - user-group? - user-group-name - user-group-password - user-group-id - user-group-system? + ;; Re-export these bindings for backward compatibility. + #:re-export (user-account + user-account? + user-account-name + user-account-password + user-account-uid + user-account-group + user-account-supplementary-groups + user-account-comment + user-account-home-directory + user-account-create-home-directory? + user-account-shell + user-account-system? - default-skeletons + user-group + user-group? + user-group-name + user-group-password + user-group-id + user-group-system?) + + #:export (default-skeletons skeleton-directory %base-groups %base-user-accounts @@ -70,33 +73,8 @@ ;;; ;;; Code: -(define-record-type* - user-account make-user-account - user-account? - (name user-account-name) - (password user-account-password (default #f)) - (uid user-account-uid (default #f)) - (group user-account-group) ; number | string - (supplementary-groups user-account-supplementary-groups - (default '())) ; list of strings - (comment user-account-comment (default "")) - (home-directory user-account-home-directory) - (create-home-directory? user-account-create-home-directory? ;Boolean - (default #t)) - (shell user-account-shell ; gexp - (default (file-append bash "/bin/bash"))) - (system? user-account-system? ; Boolean - (default #f))) - -(define-record-type* - user-group make-user-group - user-group? - (name user-group-name) - (password user-group-password (default #f)) - (id user-group-id (default #f)) - (system? user-group-system? ; Boolean - (default #f))) - +;; Change the default shell used by new records. +(default-shell (file-append bash "/bin/bash")) (define %base-groups ;; Default set of groups. From patchwork Mon Mar 4 11:16:42 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 1285 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id B61B416CF6; Mon, 4 Mar 2019 11:17:18 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 197FC16C43 for ; Mon, 4 Mar 2019 11:17:18 +0000 (GMT) Received: from localhost ([127.0.0.1]:52088 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h0lav-0002KJ-M9 for patchwork@mira.cbaines.net; Mon, 04 Mar 2019 06:17:17 -0500 Received: from eggs.gnu.org ([209.51.188.92]:36244) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h0lai-0002H0-Q5 for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1h0lah-0000X9-4j for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:45487) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1h0lag-0000WR-Vd for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1h0lag-0006HI-QK for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#34730] [PATCH 2/4] activation: Operate on and records. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 04 Mar 2019 11:17:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 34730 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 34730@debbugs.gnu.org Received: via spool by 34730-submit@debbugs.gnu.org id=B34730.155169821524090 (code B ref 34730); Mon, 04 Mar 2019 11:17:02 +0000 Received: (at 34730) by debbugs.gnu.org; 4 Mar 2019 11:16:55 +0000 Received: from localhost ([127.0.0.1]:59025 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h0laY-0006GI-Uu for submit@debbugs.gnu.org; Mon, 04 Mar 2019 06:16:55 -0500 Received: from hera.aquilenet.fr ([185.233.100.1]:34610) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h0laW-0006G0-L2 for 34730@debbugs.gnu.org; Mon, 04 Mar 2019 06:16:53 -0500 Received: from localhost (localhost [127.0.0.1]) by hera.aquilenet.fr (Postfix) with ESMTP id 1FC409B02; Mon, 4 Mar 2019 12:16:52 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at aquilenet.fr Received: from hera.aquilenet.fr ([127.0.0.1]) by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 9URXH4t5iLBb; Mon, 4 Mar 2019 12:16:50 +0100 (CET) Received: from gnu.org (unknown [IPv6:2001:660:6102:320:e120:2c8f:8909:cdfe]) by hera.aquilenet.fr (Postfix) with ESMTPSA id 427AF9B04; Mon, 4 Mar 2019 12:16:50 +0100 (CET) From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 4 Mar 2019 12:16:42 +0100 Message-Id: <20190304111644.8573-2-ludo@gnu.org> X-Mailer: git-send-email 2.21.0 In-Reply-To: <20190304111644.8573-1-ludo@gnu.org> References: <20190304111644.8573-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/system/accounts.scm (sexp->user-group, sexp->user-account): New procedures. * gnu/system/shadow.scm (account-activation): Call them in the arguments to 'activate-users+groups'. (account-shepherd-service): Likewise. * gnu/build/activation.scm (activate-users+groups): Expect a list of and a list of . Replace uses of 'match' on tuples with calls to record accessors. (activate-user-home): Likewise. --- gnu/build/activation.scm | 118 ++++++++++++++++++++------------------- gnu/system/accounts.scm | 28 ++++++++++ gnu/system/shadow.scm | 22 +++++--- 3 files changed, 103 insertions(+), 65 deletions(-) diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 0e77677de1..820e04d648 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -18,6 +18,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu build activation) + #:use-module (gnu system accounts) #:use-module (gnu build linux-boot) #:use-module (guix build utils) #:use-module (ice-9 ftw) @@ -212,37 +213,42 @@ logged in." (apply add-user name group rest))) (define (activate-users+groups users groups) - "Make sure the accounts listed in USERS and the user groups listed in GROUPS -are all available. - -Each item in USERS is a list of all the characteristics of a user account; -each item in GROUPS is a tuple with the group name, group password or #f, and -numeric gid or #f." + "Make sure USERS (a list of user account records) and GROUPS (a list of user +group records) are all available." (define (touch file) (close-port (open-file file "a0b"))) (define activate-user - (match-lambda - ((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 - #:uid uid - #:system? system? - #:supplementary-groups supplementary-groups - #:comment comment - #:home home - #:create-home? create-home? + (lambda (user) + (let ((name (user-account-name user)) + (uid (user-account-uid user)) + (group (user-account-group user)) + (supplementary-groups + (user-account-supplementary-groups user)) + (comment (user-account-comment user)) + (home (user-account-home-directory user)) + (create-home? (user-account-create-home-directory? user)) + (shell (user-account-shell user)) + (password (user-account-password user)) + (system? (user-account-system? user))) + (let ((profile-dir (string-append "/var/guix/profiles/per-user/" + name))) + (ensure-user name group + #:uid uid + #:system? system? + #:supplementary-groups supplementary-groups + #:comment comment + #:home home + #:create-home? create-home? - #:shell shell - #:password password) + #:shell shell + #:password password) - (unless system? - ;; Create the profile directory for the new account. - (let ((pw (getpwnam name))) - (mkdir-p profile-dir) - (chown profile-dir (passwd:uid pw) (passwd:gid pw)))))))) + (unless system? + ;; Create the profile directory for the new account. + (let ((pw (getpwnam name))) + (mkdir-p profile-dir) + (chown profile-dir (passwd:uid pw) (passwd:gid pw)))))))) ;; 'groupadd' aborts if the file doesn't already exist. (touch "/etc/group") @@ -251,18 +257,18 @@ numeric gid or #f." (mkdir-p "/var/lib") ;; Create the root account so we can use 'useradd' and 'groupadd'. - (activate-user (find (match-lambda - ((name (? zero?) _ ...) #t) - (_ #f)) - users)) + (activate-user (find (compose zero? user-account-uid) users)) ;; Then create the groups. - (for-each (match-lambda - ((name password gid system?) - (unless (false-if-exception (getgrnam name)) - (add-group name - #:gid gid #:password password - #:system? system?)))) + (for-each (lambda (group) + (let ((name (user-group-name group)) + (password (user-group-password group)) + (gid (user-group-id group)) + (system? (user-group-system? group))) + (unless (false-if-exception (getgrnam name)) + (add-group name + #:gid gid #:password password + #:system? system?)))) groups) ;; Create the other user accounts. @@ -272,35 +278,33 @@ numeric gid or #f." (for-each delete-user (lset-difference string=? (map passwd:name (current-users)) - (match users - (((names . _) ...) - names)))) + (map user-account-name users))) (for-each delete-group (lset-difference string=? (map group:name (current-groups)) - (match groups - (((names . _) ...) - names))))) + (map user-group-name groups)))) (define (activate-user-home users) "Create and populate the home directory of USERS, a list of tuples, unless they already exist." (define ensure-user-home - (match-lambda - ((name uid group supplementary-groups comment home create-home? - shell password system?) - ;; 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))) - (mkdir-p home) - (chown home uid gid) - (unless system? - (copy-account-skeletons home - #:uid uid #:gid gid))))))) + (lambda (user) + (let ((name (user-account-name user)) + (home (user-account-home-directory user)) + (create-home? (user-account-create-home-directory? user)) + (system? (user-account-system? user))) + ;; 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))) + (mkdir-p home) + (chown home uid gid) + (unless system? + (copy-account-skeletons home + #:uid uid #:gid gid))))))) (for-each ensure-user-home users)) diff --git a/gnu/system/accounts.scm b/gnu/system/accounts.scm index 36ee62e851..eb18fb5e43 100644 --- a/gnu/system/accounts.scm +++ b/gnu/system/accounts.scm @@ -18,6 +18,7 @@ (define-module (gnu system accounts) #:use-module (guix records) + #:use-module (ice-9 match) #:export (user-account user-account? user-account-name @@ -38,6 +39,9 @@ user-group-id user-group-system? + sexp->user-account + sexp->user-group + default-shell)) @@ -79,3 +83,27 @@ (id user-group-id (default #f)) (system? user-group-system? ; Boolean (default #f))) + +(define (sexp->user-group sexp) + "Take SEXP, a tuple as returned by 'user-group->gexp', and turn it into a +user-group record." + (match sexp + ((name password id system?) + (user-group (name name) + (password password) + (id id) + (system? system?))))) + +(define (sexp->user-account sexp) + "Take SEXP, a tuple as returned by 'user-account->gexp', and turn it into a +user-account record." + (match sexp + ((name uid group supplementary-groups comment home-directory + create-home-directory? shell password system?) + (user-account (name name) (uid uid) (group group) + (supplementary-groups supplementary-groups) + (comment comment) + (home-directory home-directory) + (create-home-directory? create-home-directory?) + (shell shell) (password password) + (system? system?))))) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index a9a4afd414..4e5b6ae5f2 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -298,11 +298,14 @@ group." (assert-valid-users/groups accounts groups) ;; Add users and user groups. - #~(begin - (setenv "PATH" - (string-append #$(@ (gnu packages admin) shadow) "/sbin")) - (activate-users+groups (list #$@user-specs) - (list #$@group-specs)))) + (with-imported-modules (source-module-closure '((gnu system accounts))) + #~(begin + (use-modules (gnu system accounts)) + + (setenv "PATH" + (string-append #$(@ (gnu packages admin) shadow) "/sbin")) + (activate-users+groups (map sexp->user-account (list #$@user-specs)) + (map sexp->user-group (list #$@group-specs)))))) (define (account-shepherd-service accounts+groups) "Return a Shepherd service that creates the home directories for the user @@ -322,12 +325,15 @@ accounts among ACCOUNTS+GROUPS." (list (shepherd-service (requirement '(file-systems)) (provision '(user-homes)) - (modules '((gnu build activation))) + (modules '((gnu build activation) + (gnu system accounts))) (start (with-imported-modules (source-module-closure - '((gnu build activation))) + '((gnu build activation) + (gnu system accounts))) #~(lambda () (activate-user-home - (list #$@(map user-account->gexp accounts))) + (map sexp->user-account + (list #$@(map user-account->gexp accounts)))) #f))) ;stop (stop #~(const #f)) (respawn? #f) From patchwork Mon Mar 4 11:16:43 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 1286 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 0756A16CF6; Mon, 4 Mar 2019 11:17:23 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 736CD16C43 for ; Mon, 4 Mar 2019 11:17:21 +0000 (GMT) Received: from localhost ([127.0.0.1]:52090 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h0laz-0002Kt-25 for patchwork@mira.cbaines.net; Mon, 04 Mar 2019 06:17:21 -0500 Received: from eggs.gnu.org ([209.51.188.92]:36266) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h0lal-0002I6-Gb for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:10 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1h0lai-0000bH-4Y for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:07 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:45489) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1h0lah-0000aN-Uq for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1h0lah-0006HX-Om for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#34730] [PATCH 3/4] Add (gnu build accounts). Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 04 Mar 2019 11:17:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 34730 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 34730@debbugs.gnu.org Received: via spool by 34730-submit@debbugs.gnu.org id=B34730.155169822124115 (code B ref 34730); Mon, 04 Mar 2019 11:17:03 +0000 Received: (at 34730) by debbugs.gnu.org; 4 Mar 2019 11:17:01 +0000 Received: from localhost ([127.0.0.1]:59030 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h0lae-0006Gs-DE for submit@debbugs.gnu.org; Mon, 04 Mar 2019 06:17:01 -0500 Received: from hera.aquilenet.fr ([185.233.100.1]:34624) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h0laY-0006GF-Vb for 34730@debbugs.gnu.org; Mon, 04 Mar 2019 06:16:56 -0500 Received: from localhost (localhost [127.0.0.1]) by hera.aquilenet.fr (Postfix) with ESMTP id 7088D9B05; Mon, 4 Mar 2019 12:16:54 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at aquilenet.fr Received: from hera.aquilenet.fr ([127.0.0.1]) by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id x8PkmoxmFwBu; Mon, 4 Mar 2019 12:16:51 +0100 (CET) Received: from gnu.org (unknown [IPv6:2001:660:6102:320:e120:2c8f:8909:cdfe]) by hera.aquilenet.fr (Postfix) with ESMTPSA id 81ED69AE6; Mon, 4 Mar 2019 12:16:50 +0100 (CET) From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 4 Mar 2019 12:16:43 +0100 Message-Id: <20190304111644.8573-3-ludo@gnu.org> X-Mailer: git-send-email 2.21.0 In-Reply-To: <20190304111644.8573-1-ludo@gnu.org> References: <20190304111644.8573-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/build/accounts.scm, tests/accounts.scm: New files. * Makefile.am (SCM_TESTS): Add tests/accounts.scm. * gnu/local.mk (GNU_SYSTEM_MODULES): Add build/accounts.scm. --- Makefile.am | 1 + gnu/build/accounts.scm | 561 +++++++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + tests/accounts.scm | 309 +++++++++++++++++++++++ 4 files changed, 872 insertions(+) create mode 100644 gnu/build/accounts.scm create mode 100644 tests/accounts.scm diff --git a/Makefile.am b/Makefile.am index fec9800ce7..b63737260f 100644 --- a/Makefile.am +++ b/Makefile.am @@ -390,6 +390,7 @@ SCM_TESTS = \ tests/file-systems.scm \ tests/uuid.scm \ tests/system.scm \ + tests/accounts.scm \ tests/services.scm \ tests/scripts-build.scm \ tests/containers.scm \ diff --git a/gnu/build/accounts.scm b/gnu/build/accounts.scm new file mode 100644 index 0000000000..6b44ab610b --- /dev/null +++ b/gnu/build/accounts.scm @@ -0,0 +1,561 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Ludovic Courtès +;;; +;;; 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 . + +(define-module (gnu build accounts) + #:use-module (guix records) + #:use-module (guix combinators) + #:use-module (gnu system accounts) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:use-module (ice-9 vlist) + #:use-module (ice-9 rdelim) + #:export (password-entry + password-entry? + password-entry-name + password-entry-uid + password-entry-gid + password-entry-real-name + password-entry-directory + password-entry-shell + + shadow-entry + shadow-entry? + shadow-entry-name + shadow-entry-minimum-change-period + shadow-entry-maximum-change-period + shadow-entry-change-warning-time + shadow-entry-maximum-inactivity + shadow-entry-expiration + + group-entry + group-entry? + group-entry-name + group-entry-gid + group-entry-members + + write-group + write-passwd + write-shadow + read-group + read-passwd + read-shadow + + %id-min + %id-max + %system-id-min + %system-id-max + + user+group-databases)) + +;;; Commentary: +;;; +;;; This modules provides functionality equivalent to the C library's +;;; , , and routines, as well as a subset of the +;;; functionality of the Shadow command-line tools. It can parse and write +;;; /etc/passwd, /etc/shadow, and /etc/group. It can also take care of UID +;;; and GID allocation in a way similar to what 'useradd' does. +;;; +;;; The benefit is twofold: less code is involved, and the ID allocation +;;; strategy and state preservation is made explicit. +;;; +;;; Code: + + +;;; +;;; Machinery to define user and group databases. +;;; + +(define-syntax serialize-field + (syntax-rules (serialization) + ((_ entry (field get (serialization ->string string->) _ ...)) + (->string (get entry))) + ((_ entry (field get _ ...)) + (get entry)))) + +(define-syntax deserialize-field + (syntax-rules (serialization) + ((_ str (field get (serialization ->string string->) _ ...)) + (string-> str)) + ((_ str (field get _ ...)) + str))) + +(define-syntax let/fields + (syntax-rules () + ((_ (((name get attributes ...) rest ...) lst) body ...) + (let ((l lst)) + (let ((name (deserialize-field (car l) + (name get attributes ...)))) + (let/fields ((rest ...) (cdr l)) body ...)))) + ((_ (() lst) body ...) + (begin body ...)))) + +(define-syntax define-database-entry + (syntax-rules (serialization) + "Define a record data type, as per 'define-record-type*', with additional +information on how to serialize and deserialize the whole database as well as +each field." + ((_ record make-record record? + (serialization separator entry->string string->entry) + fields ...) + (let-syntax ((field-name + (syntax-rules () + ((_ (name _ (... ...))) name)))) + (define-record-type* record make-record + record? + fields ...) + + (define (entry->string entry) + (string-join (list (serialize-field entry fields) ...) + (string separator))) + + (define (string->entry str) + (let/fields ((fields ...) (string-split str #\:)) + (make-record (field-name fields) ...))))))) + + +(define number->string* + (match-lambda + ((? number? number) (number->string number)) + (_ ""))) + +(define (false-if-string=? false-string) + (lambda (str) + (if (string=? str false-string) + #f + str))) + +(define (string-if-false str) + (lambda (obj) + (if (not obj) str obj))) + +(define (comma-separated->list str) + (string-tokenize str (char-set-complement (char-set #\,)))) + +(define (list->comma-separated lst) + (string-join lst ",")) + + +;;; +;;; Database definitions. +;;; + +(define-database-entry ; + password-entry make-password-entry + password-entry? + (serialization #\: password-entry->string string->password-entry) + + (name password-entry-name) + (password password-entry-password + (serialization (const "x") (const #f)) + (default "x")) + (uid password-entry-uid + (serialization number->string string->number)) + (gid password-entry-gid + (serialization number->string string->number)) + (real-name password-entry-real-name + (default "")) + (directory password-entry-directory) + (shell password-entry-shell + (default "/bin/sh"))) + +(define-database-entry ; + shadow-entry make-shadow-entry + shadow-entry? + (serialization #\: shadow-entry->string string->shadow-entry) + + (name shadow-entry-name) ;string + (password shadow-entry-password ;string | #f + (serialization (string-if-false "!") + (false-if-string=? "!")) + (default #f)) + (last-change shadow-entry-last-change ;days since 1970-01-01 + (serialization number->string* string->number) + (default 0)) + (minimum-change-period shadow-entry-minimum-change-period + (serialization number->string* string->number) + (default #f)) ;days | #f + (maximum-change-period shadow-entry-maximum-change-period + (serialization number->string* string->number) + (default #f)) ;days | #f + (change-warning-time shadow-entry-change-warning-time + (serialization number->string* string->number) + (default #f)) ;days | #f + (maximum-inactivity shadow-entry-maximum-inactivity + (serialization number->string* string->number) + (default #f)) ;days | #f + (expiration shadow-entry-expiration + (serialization number->string* string->number) + (default #f)) ;days since 1970-01-01 | #f + (flags shadow-entry-flags ;"reserved" + (serialization number->string* string->number) + (default #f))) + +(define-database-entry ; + group-entry make-group-entry + group-entry? + (serialization #\: group-entry->string string->group-entry) + + (name group-entry-name) + (password group-entry-password + (serialization (string-if-false "x") + (false-if-string=? "x")) + (default #f)) + (gid group-entry-gid + (serialization number->string string->number)) + (members group-entry-members + (serialization list->comma-separated comma-separated->list) + (default '()))) + +(define (database-writer file mode entry->string) + (lambda* (entries #:optional (file-or-port file)) + "Write ENTRIES to FILE-OR-PORT. When FILE-OR-PORT is a file name, write +to it atomically and set the appropriate permissions." + (define (write-entries port) + (for-each (lambda (entry) + (display (entry->string entry) port) + (newline port)) + entries)) + + (if (port? file-or-port) + (write-entries file-or-port) + (let* ((template (string-append file-or-port ".XXXXXX")) + (port (mkstemp! template))) + (dynamic-wind + (const #t) + (lambda () + (chmod port mode) + (write-entries port) + (rename-file template file-or-port)) + (lambda () + (close-port port) + (when (file-exists? template) + (delete-file template)))))))) + +(define write-passwd + (database-writer "/etc/passwd" #o644 password-entry->string)) +(define write-shadow + (database-writer "/etc/shadow" #o600 shadow-entry->string)) +(define write-group + (database-writer "/etc/group" #o644 group-entry->string)) + +(define (database-reader file string->entry) + (lambda* (#:optional (file-or-port file)) + (define (read-entries port) + (let loop ((entries '())) + (match (read-line port) + ((? eof-object?) + (reverse entries)) + (line + (loop (cons (string->entry line) entries)))))) + + (if (port? file-or-port) + (read-entries file-or-port) + (call-with-input-file file-or-port + read-entries)))) + +(define read-passwd + (database-reader "/etc/passwd" string->password-entry)) +(define read-shadow + (database-reader "/etc/shadow" string->shadow-entry)) +(define read-group + (database-reader "/etc/group" string->group-entry)) + + +;;; +;;; Building databases. +;;; + +(define-record-type* + allocation make-allocation + allocation? + (ids allocation-ids (default vlist-null)) + (next-id allocation-next-id (default %id-min)) + (next-system-id allocation-next-system-id (default %system-id-max))) + +;; Trick to avoid name clashes... +(define-syntax %allocation (identifier-syntax allocation)) + +;; Minimum and maximum UIDs and GIDs (from find_new_uid.c and find_new_gid.c +;; in Shadow.) +(define %id-min 1000) +(define %id-max 60000) + +(define %system-id-min 100) +(define %system-id-max 999) + +(define (system-id? id) + (and (> id %system-id-min) + (<= id %system-id-max))) + +(define (user-id? id) + (and (>= id %id-min) + (< id %id-max))) + +(define* (allocate-id assignment #:key system?) + "Return two values: a newly allocated ID, and an updated record +based on ASSIGNMENT. If SYSTEM? is true, return a system ID." + (define next + ;; Return the next available ID, looping if necessary. + (if system? + (lambda (id) + (let ((next-id (- id 1))) + (if (< next-id %system-id-min) + %system-id-max + next-id))) + (lambda (id) + (let ((next-id (+ id 1))) + (if (>= next-id %id-max) + %id-min + next-id))))) + + (let loop ((id (if system? + (allocation-next-system-id assignment) + (allocation-next-id assignment)))) + (if (vhash-assv id (allocation-ids assignment)) + (loop (next id)) + (let ((taken (vhash-consv id #t (allocation-ids assignment)))) + (values (if system? + (allocation (inherit assignment) + (next-system-id (next id)) + (ids taken)) + (allocation (inherit assignment) + (next-id (next id)) + (ids taken))) + id))))) + +(define* (reserve-ids allocation ids #:key (skip? #t)) + "Mark the numbers listed in IDS as reserved in ALLOCATION. When SKIP? is +true, start allocation after the highest (or lowest, depending on whether it's +a system ID allocation) number among IDS." + (%allocation + (inherit allocation) + (next-id (if skip? + (+ (reduce max + (- (allocation-next-id allocation) 1) + (filter user-id? ids)) + 1) + (allocation-next-id allocation))) + (next-system-id + (if skip? + (- (reduce min + (+ 1 (allocation-next-system-id allocation)) + (filter system-id? ids)) + 1) + (allocation-next-system-id allocation))) + (ids (fold (cut vhash-consv <> #t <>) + (allocation-ids allocation) + ids)))) + +(define (allocated? allocation id) + "Return true if ID is already allocated as part of ALLOCATION." + (->bool (vhash-assv id (allocation-ids allocation)))) + +(define (lookup-procedure lst key) + "Return a lookup procedure for the elements of LST, calling KEY to obtain +the key of each element." + (let ((table (fold (lambda (obj table) + (vhash-cons (key obj) obj table)) + vlist-null + lst))) + (lambda (key) + (match (vhash-assoc key table) + (#f #f) + ((_ . value) value))))) + +(define* (allocate-groups groups members + #:optional (current-groups '())) + "Return a list of group entries for GROUPS, a list of . Members +for each group are taken from MEMBERS, a vhash that maps group names to member +names. GIDs and passwords found in CURRENT-GROUPS, a list of group entries, +are reused." + (define gids + ;; Mark all the currently-used GIDs and the explicitly requested GIDs as + ;; reserved. + (reserve-ids (reserve-ids (allocation) + (map group-entry-gid current-groups)) + (filter-map user-group-id groups) + #:skip? #f)) + + (define previous-entry + (lookup-procedure current-groups group-entry-name)) + + (reverse + (fold2 (lambda (group result allocation) + (let ((name (user-group-name group)) + (password (user-group-password group)) + (requested-id (user-group-id group)) + (system? (user-group-system? group))) + (let*-values (((previous) + (previous-entry name)) + ((allocation id) + (cond + ((number? requested-id) + (values (reserve-ids allocation + (list requested-id)) + requested-id)) + (previous + (values allocation + (group-entry-gid previous))) + (else + (allocate-id allocation + #:system? system?))))) + (values (cons (group-entry + (name name) + (password + (if previous + (group-entry-password previous) + password)) + (gid id) + (members (vhash-fold* cons '() name members))) + result) + allocation)))) + '() + gids + groups))) + +(define* (allocate-passwd users groups #:optional (current-passwd '())) + "Return a list of password entries for USERS, a list of . +Take GIDs from GROUPS, a list of group entries. Reuse UIDs from +CURRENT-PASSWD, a list of password entries, when possible; otherwise allocate +new UIDs." + (define uids + (reserve-ids (reserve-ids (allocation) + (map password-entry-uid current-passwd)) + (filter-map user-account-uid users) + #:skip? #f)) + + (define previous-entry + (lookup-procedure current-passwd password-entry-name)) + + (define (group-id name) + (or (any (lambda (entry) + (and (string=? (group-entry-name entry) name) + (group-entry-gid entry))) + groups) + (error "group not found" name))) + + (reverse + (fold2 (lambda (user result allocation) + (let ((name (user-account-name user)) + (requested-id (user-account-uid user)) + (group (user-account-group user)) + (real-name (user-account-comment user)) + (directory (user-account-home-directory user)) + (shell (user-account-shell user)) + (system? (user-account-system? user))) + (let*-values (((previous) + (previous-entry name)) + ((allocation id) + (cond + ((number? requested-id) + (values (reserve-ids allocation + (list requested-id)) + requested-id)) + (previous + (values allocation + (password-entry-uid previous))) + (else + (allocate-id allocation + #:system? system?))))) + (values (cons (password-entry + (name name) + (uid id) + (directory directory) + (gid (if (number? group) group (group-id group))) + (real-name (if previous + (password-entry-real-name previous) + real-name)) + (shell (if previous + (password-entry-shell previous) + shell))) + result) + allocation)))) + '() + uids + users))) + +(define* (days-since-epoch #:optional (current-time current-time)) + "Return the number of days elapsed since the 1st of January, 1970." + (let* ((now (current-time time-utc)) + (epoch (make-time time-utc 0 0)) + (diff (time-difference now epoch))) + (quotient (time-second diff) (* 24 3600)))) + +(define* (passwd->shadow users passwd #:optional (current-shadow '()) + #:key (current-time current-time)) + "Return a list of shadow entries for the password entries listed in PASSWD. +Reuse shadow entries from CURRENT-SHADOW when they exist, and take the initial +password from USERS." + (define previous-entry + (lookup-procedure current-shadow shadow-entry-name)) + + (define now + (days-since-epoch current-time)) + + (map (lambda (user passwd) + (or (previous-entry (password-entry-name passwd)) + (shadow-entry (name (password-entry-name passwd)) + (password (user-account-password user)) + (last-change now)))) + users passwd)) + +(define (empty-if-not-found thunk) + "Call THUNK and return the empty list if that throws to ENOENT." + (catch 'system-error + thunk + (lambda args + (if (= ENOENT (system-error-errno args)) + '() + (apply throw args))))) + +(define* (user+group-databases users groups + #:key + (current-passwd + (empty-if-not-found read-passwd)) + (current-groups + (empty-if-not-found read-group)) + (current-shadow + (empty-if-not-found read-shadow)) + (current-time current-time)) + "Return three values: the list of group entries, the list of password +entries, and the list of shadow entries corresponding to USERS and GROUPS. +Preserve stateful bits from CURRENT-PASSWD, CURRENT-GROUPS, and +CURRENT-SHADOW: UIDs, GIDs, passwords, user shells, etc." + (define members + ;; Map group name to user names. + (fold (lambda (user members) + (fold (cute vhash-cons <> (user-account-name user) <>) + members + (user-account-supplementary-groups user))) + vlist-null + users)) + + (define group-entries + (allocate-groups groups members current-groups)) + + (define passwd-entries + (allocate-passwd users group-entries current-passwd)) + + (define shadow-entries + (passwd->shadow users passwd-entries current-shadow + #:current-time current-time)) + + (values group-entries passwd-entries shadow-entries)) diff --git a/gnu/local.mk b/gnu/local.mk index a8915cf36b..e0b0173828 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -540,6 +540,7 @@ GNU_SYSTEM_MODULES = \ %D%/system/uuid.scm \ %D%/system/vm.scm \ \ + %D%/build/accounts.scm \ %D%/build/activation.scm \ %D%/build/bootloader.scm \ %D%/build/cross-toolchain.scm \ diff --git a/tests/accounts.scm b/tests/accounts.scm new file mode 100644 index 0000000000..127861042d --- /dev/null +++ b/tests/accounts.scm @@ -0,0 +1,309 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Ludovic Courtès +;;; +;;; 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 . + +(define-module (test-accounts) + #:use-module (gnu build accounts) + #:use-module (gnu system accounts) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-64) + #:use-module (ice-9 vlist) + #:use-module (ice-9 match)) + +(define %passwd-sample + "\ +root:x:0:0:Admin:/root:/bin/sh +charlie:x:1000:998:Charlie:/home/charlie:/bin/sh\n") + +(define %group-sample + "\ +root:x:0: +wheel:x:999:alice,bob +hackers:x:65000:alice,charlie\n") + +(define %shadow-sample + (string-append "\ +root:" (crypt "secret" "$6$abc") ":17169:::::: +charlie:" (crypt "hey!" "$6$abc") ":17169:::::: +nobody:!:0::::::\n")) + + +(test-begin "accounts") + +(test-equal "write-passwd" + %passwd-sample + (call-with-output-string + (lambda (port) + (write-passwd (list (password-entry + (name "root") + (uid 0) (gid 0) + (real-name "Admin") + (directory "/root") + (shell "/bin/sh")) + (password-entry + (name "charlie") + (uid 1000) (gid 998) + (real-name "Charlie") + (directory "/home/charlie") + (shell "/bin/sh"))) + port)))) + +(test-equal "read-passwd + write-passwd" + %passwd-sample + (call-with-output-string + (lambda (port) + (write-passwd (call-with-input-string %passwd-sample + read-passwd) + port)))) + +(test-equal "write-group" + %group-sample + (call-with-output-string + (lambda (port) + (write-group (list (group-entry + (name "root") (gid 0)) + (group-entry + (name "wheel") (gid 999) + (members '("alice" "bob"))) + (group-entry + (name "hackers") (gid 65000) + (members '("alice" "charlie")))) + port)))) + +(test-equal "read-group + write-group" + %group-sample + (call-with-output-string + (lambda (port) + (write-group (call-with-input-string %group-sample + read-group) + port)))) + +(test-equal "write-shadow" + %shadow-sample + (call-with-output-string + (lambda (port) + (write-shadow (list (shadow-entry + (name "root") + (password (crypt "secret" "$6$abc")) + (last-change 17169)) + (shadow-entry + (name "charlie") + (password (crypt "hey!" "$6$abc")) + (last-change 17169)) + (shadow-entry + (name "nobody"))) + port)))) + +(test-equal "read-shadow + write-shadow" + %shadow-sample + (call-with-output-string + (lambda (port) + (write-shadow (call-with-input-string %shadow-sample + read-shadow) + port)))) + + +(define allocate-groups (@@ (gnu build accounts) allocate-groups)) +(define allocate-passwd (@@ (gnu build accounts) allocate-passwd)) + +(test-equal "allocate-groups" + ;; Allocate GIDs in a stateless fashion. + (list (group-entry (name "s") (gid %system-id-max)) + (group-entry (name "x") (gid 900)) + (group-entry (name "t") (gid 899)) + (group-entry (name "a") (gid %id-min) (password "foo") + (members '("alice" "bob"))) + (group-entry (name "b") (gid (+ %id-min 1)) + (members '("charlie")))) + (allocate-groups (list (user-group (name "s") (system? #t)) + (user-group (name "x") (id 900)) + (user-group (name "t") (system? #t)) + (user-group (name "a") (password "foo")) + (user-group (name "b"))) + (alist->vhash `(("a" . "bob") + ("a" . "alice") + ("b" . "charlie"))))) + +(test-equal "allocate-groups with requested GIDs" + ;; Make sure the requested GID for "b" is honored. + (list (group-entry (name "a") (gid (+ 1 %id-min))) + (group-entry (name "b") (gid %id-min)) + (group-entry (name "c") (gid (+ 2 %id-min)))) + (allocate-groups (list (user-group (name "a")) + (user-group (name "b") (id %id-min)) + (user-group (name "c"))) + vlist-null)) + +(test-equal "allocate-groups with previous state" + ;; Make sure bits of state are preserved: password, GID, no reuse of + ;; previously-used GIDs. + (list (group-entry (name "s") (gid (- %system-id-max 1))) + (group-entry (name "t") (gid (- %system-id-max 2))) + (group-entry (name "a") (gid 30000) (password #f) + (members '("alice" "bob"))) + (group-entry (name "b") (gid 30001) (password "bar") + (members '("charlie")))) + (allocate-groups (list (user-group (name "s") (system? #t)) + (user-group (name "t") (system? #t)) + (user-group (name "a") (password "foo")) + (user-group (name "b"))) + (alist->vhash `(("a" . "bob") + ("a" . "alice") + ("b" . "charlie"))) + (list (group-entry (name "a") (gid 30000)) + (group-entry (name "b") (gid 30001) + (password "bar")) + (group-entry (name "removed") + (gid %system-id-max))))) + +(test-equal "allocate-groups with previous state, looping" + ;; Check that allocation starts after the highest previously-used GID, and + ;; loops back to the lowest GID. + (list (group-entry (name "a") (gid (- %id-max 1))) + (group-entry (name "b") (gid %id-min)) + (group-entry (name "c") (gid (+ 1 %id-min)))) + (allocate-groups (list (user-group (name "a")) + (user-group (name "b")) + (user-group (name "c"))) + vlist-null + (list (group-entry (name "d") + (gid (- %id-max 2)))))) + +(test-equal "allocate-passwd" + ;; Allocate UIDs in a stateless fashion. + (list (password-entry (name "alice") (uid %id-min) (gid 1000) + (real-name "Alice") (shell "/bin/sh") + (directory "/home/alice")) + (password-entry (name "bob") (uid (+ 1 %id-min)) (gid 1001) + (real-name "Bob") (shell "/bin/gash") + (directory "/home/bob")) + (password-entry (name "sshd") (uid %system-id-max) (gid 500) + (real-name "sshd") (shell "/nologin") + (directory "/var/empty")) + (password-entry (name "guix") (uid 30000) (gid 499) + (real-name "Guix") (shell "/nologin") + (directory "/var/empty"))) + (allocate-passwd (list (user-account (name "alice") + (comment "Alice") + (home-directory "/home/alice") + (shell "/bin/sh") + (group "users")) + (user-account (name "bob") + (comment "Bob") + (home-directory "/home/bob") + (shell "/bin/gash") + (group "wheel")) + (user-account (name "sshd") (system? #t) + (comment "sshd") + (home-directory "/var/empty") + (shell "/nologin") + (group "sshd")) + (user-account (name "guix") (system? #t) + (comment "Guix") + (home-directory "/var/empty") + (shell "/nologin") + (group "guix") + (uid 30000))) + (list (group-entry (name "users") (gid 1000)) + (group-entry (name "wheel") (gid 1001)) + (group-entry (name "sshd") (gid 500)) + (group-entry (name "guix") (gid 499))))) + +(test-equal "allocate-passwd with previous state" + ;; Make sure bits of state are preserved: UID, no reuse of previously-used + ;; UIDs, and shell. + (list (password-entry (name "alice") (uid 1234) (gid 1000) + (real-name "Alice Smith") (shell "/gnu/.../bin/gash") + (directory "/home/alice")) + (password-entry (name "charlie") (uid 1236) (gid 1000) + (real-name "Charlie") (shell "/bin/sh") + (directory "/home/charlie"))) + (allocate-passwd (list (user-account (name "alice") + (comment "Alice") + (home-directory "/home/alice") + (shell "/bin/sh") ;ignored + (group "users")) + (user-account (name "charlie") + (comment "Charlie") + (home-directory "/home/charlie") + (shell "/bin/sh") + (group "users"))) + (list (group-entry (name "users") (gid 1000))) + (list (password-entry (name "alice") (uid 1234) (gid 9999) + (real-name "Alice Smith") + (shell "/gnu/.../bin/gash") + (directory "/home/alice")) + (password-entry (name "bob") (uid 1235) (gid 1001) + (real-name "Bob") (shell "/bin/sh") + (directory "/home/bob"))))) + +(test-equal "user+group-databases" + ;; The whole shebang. + (list (list (group-entry (name "a") (gid %id-min) + (members '("bob"))) + (group-entry (name "b") (gid (+ 1 %id-min)) + (members '("alice"))) + (group-entry (name "s") (gid %system-id-max))) + (list (password-entry (name "alice") (real-name "Alice") + (uid %id-min) (gid %id-min) + (directory "/a")) + (password-entry (name "bob") (real-name "Bob") + (uid (+ 1 %id-min)) (gid (+ 1 %id-min)) + (directory "/b")) + (password-entry (name "nobody") + (uid 65534) (gid %system-id-max) + (directory "/var/empty"))) + (list (shadow-entry (name "alice") (last-change 100) + (password (crypt "initial pass" "$6$"))) + (shadow-entry (name "bob") (last-change 50) + (password (crypt "foo" "$6$"))) + (shadow-entry (name "nobody") (last-change 100)))) + (call-with-values + (lambda () + (user+group-databases (list (user-account + (name "alice") + (comment "Alice") + (home-directory "/a") + (group "a") + (supplementary-groups '("b")) + (password (crypt "initial pass" "$6$"))) + (user-account + (name "bob") + (comment "Bob") + (home-directory "/b") + (group "b") + (supplementary-groups '("a"))) + (user-account + (name "nobody") + (group "s") + (uid 65534) + (home-directory "/var/empty"))) + (list (user-group (name "a")) + (user-group (name "b")) + (user-group (name "s") (system? #t))) + #:current-passwd '() + #:current-shadow + (list (shadow-entry (name "bob") + (password (crypt "foo" "$6$")) + (last-change 50))) + #:current-groups '() + #:current-time + (lambda (type) + (make-time type 0 (* 24 3600 100))))) + list)) + +(test-end "accounts") From patchwork Mon Mar 4 11:16:44 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 1287 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id DB5FA16CF6; Mon, 4 Mar 2019 11:17:27 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 3E6CB16C43 for ; Mon, 4 Mar 2019 11:17:27 +0000 (GMT) Received: from localhost ([127.0.0.1]:52096 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h0lb4-0002Pf-Ra for patchwork@mira.cbaines.net; Mon, 04 Mar 2019 06:17:26 -0500 Received: from eggs.gnu.org ([209.51.188.92]:36276) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1h0lao-0002Jh-99 for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:11 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1h0lah-0000Yn-Iy for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:10 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:45488) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1h0lah-0000Y7-ET for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1h0lah-0006HP-9J for guix-patches@gnu.org; Mon, 04 Mar 2019 06:17:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#34730] [PATCH 4/4] activation: Build account databases with (gnu build accounts). Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 04 Mar 2019 11:17:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 34730 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 34730@debbugs.gnu.org Received: via spool by 34730-submit@debbugs.gnu.org id=B34730.155169821924106 (code B ref 34730); Mon, 04 Mar 2019 11:17:03 +0000 Received: (at 34730) by debbugs.gnu.org; 4 Mar 2019 11:16:59 +0000 Received: from localhost ([127.0.0.1]:59028 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h0lac-0006Gj-Pd for submit@debbugs.gnu.org; Mon, 04 Mar 2019 06:16:59 -0500 Received: from hera.aquilenet.fr ([185.233.100.1]:34618) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1h0laY-0006GD-Fz for 34730@debbugs.gnu.org; Mon, 04 Mar 2019 06:16:55 -0500 Received: from localhost (localhost [127.0.0.1]) by hera.aquilenet.fr (Postfix) with ESMTP id E538A9B04; Mon, 4 Mar 2019 12:16:53 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at aquilenet.fr Received: from hera.aquilenet.fr ([127.0.0.1]) by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id SAkdgvaYT5b5; Mon, 4 Mar 2019 12:16:52 +0100 (CET) Received: from gnu.org (unknown [IPv6:2001:660:6102:320:e120:2c8f:8909:cdfe]) by hera.aquilenet.fr (Postfix) with ESMTPSA id CA86A9B05; Mon, 4 Mar 2019 12:16:50 +0100 (CET) From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 4 Mar 2019 12:16:44 +0100 Message-Id: <20190304111644.8573-4-ludo@gnu.org> X-Mailer: git-send-email 2.21.0 In-Reply-To: <20190304111644.8573-1-ludo@gnu.org> References: <20190304111644.8573-1-ludo@gnu.org> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * gnu/build/activation.scm (enumerate, current-users, current-groups) (add-group, add-user, modify-user, ensure-user): Remove. (activate-users+groups)[touch, activate-user]: Remove. [make-home-directory]: New procedure. Rewrite in terms of 'user+group-databases', 'write-group', etc. * gnu/build/install.scm (directives): Remove "/root". * gnu/system/shadow.scm (account-activation): Remove (setenv "PATH" ...) expression, which is now unneeded. --- gnu/build/activation.scm | 207 ++++----------------------------------- gnu/build/install.scm | 3 +- gnu/system/shadow.scm | 2 - 3 files changed, 21 insertions(+), 191 deletions(-) diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 820e04d648..aa5b7031f1 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -19,11 +19,13 @@ (define-module (gnu build activation) #:use-module (gnu system accounts) + #:use-module (gnu build accounts) #:use-module (gnu build linux-boot) #:use-module (guix build utils) #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:export (activate-users+groups activate-user-home @@ -43,35 +45,6 @@ ;;; ;;; Code: -(define (enumerate thunk) - "Return the list of values returned by THUNK until it returned #f." - (let loop ((entry (thunk)) - (result '())) - (if (not entry) - (reverse result) - (loop (thunk) (cons entry result))))) - -(define (current-users) - "Return the passwd entries for all the currently defined user accounts." - (setpw) - (enumerate getpwent)) - -(define (current-groups) - "Return the group entries for all the currently defined user groups." - (setgr) - (enumerate getgrent)) - -(define* (add-group name #:key gid password system? - (log-port (current-error-port))) - "Add NAME as a user group, with the given numeric GID if specified." - ;; Use 'groupadd' from the Shadow package. - (format log-port "adding group '~a'...~%" name) - (let ((args `(,@(if gid `("-g" ,(number->string gid)) '()) - ,@(if password `("-p" ,password) '()) - ,@(if system? `("--system") '()) - ,name))) - (zero? (apply system* "groupadd" args)))) - (define %skeleton-directory ;; Directory containing skeleton files for new accounts. ;; Note: keep the trailing '/' so that 'scandir' enters it. @@ -117,172 +90,32 @@ owner-writable in HOME." (make-file-writable target)))) files))) -(define* (add-user name group - #: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 -properties. Return #t on success." - (format log-port "adding user '~a'...~%" name) - - (if (and uid (zero? uid)) - - ;; 'useradd' fails with "Cannot determine your user name" if the root - ;; account doesn't exist. Thus, for bootstrapping purposes, create that - ;; one manually. - (let ((home (or home "/root"))) - (call-with-output-file "/etc/shadow" - (cut format <> "~a::::::::~%" name)) - (call-with-output-file "/etc/passwd" - (cut format <> "~a:x:~a:~a:~a:~a:~a~%" - name "0" "0" comment home shell)) - (chmod "/etc/shadow" #o600) - (copy-account-skeletons home) - (chmod home #o700) - #t) - - ;; Use 'useradd' from the Shadow package. - (let ((args `(,@(if uid `("-u" ,(number->string uid)) '()) - "-g" ,(if (number? group) (number->string group) group) - ,@(if (pair? supplementary-groups) - `("-G" ,(string-join supplementary-groups ",")) - '()) - ,@(if comment `("-c" ,comment) '()) - ,@(if home `("-d" ,home) '()) - - ;; Home directories of non-system accounts are created by - ;; 'activate-user-home'. - ,@(if (and home create-home? system? - (not (file-exists? home))) - '("--create-home") - '()) - - ,@(if shell `("-s" ,shell) '()) - ,@(if password `("-p" ,password) '()) - ,@(if system? '("--system") '()) - ,name))) - (and (zero? (apply system* "useradd" args)) - (begin - ;; Since /etc/skel is a link to a directory in the store where - ;; all files have the writable bit cleared, and since 'useradd' - ;; preserves permissions when it copies them, explicitly make - ;; them writable. - (make-skeletons-writable home) - #t))))) - -(define* (modify-user name group - #: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." - ;; Use 'usermod' from the Shadow package. - (let ((args `(,@(if uid `("-u" ,(number->string uid)) '()) - "-g" ,(if (number? group) (number->string group) group) - ,@(if (pair? supplementary-groups) - `("-G" ,(string-join supplementary-groups ",")) - '()) - ,@(if comment `("-c" ,comment) '()) - ;; Don't use '--move-home'. - ,@(if home `("-d" ,home) '()) - ,@(if shell `("-s" ,shell) '()) - ,name))) - (zero? (apply system* "usermod" args)))) - -(define* (delete-user name #:key (log-port (current-error-port))) - "Remove user account NAME. Return #t on success. This may fail if NAME is -logged in." - (format log-port "deleting user '~a'...~%" name) - (zero? (system* "userdel" name))) - -(define* (delete-group name #:key (log-port (current-error-port))) - "Remove group NAME. Return #t on success." - (format log-port "deleting group '~a'...~%" name) - (zero? (system* "groupdel" name))) - -(define* (ensure-user name group - #:key uid comment home create-home? - shell password system? - (supplementary-groups '()) - (log-port (current-error-port)) - #:rest rest) - "Make sure user NAME exists and has the relevant settings." - (if (false-if-exception (getpwnam name)) - (apply modify-user name group rest) - (apply add-user name group rest))) - (define (activate-users+groups users groups) "Make sure USERS (a list of user account records) and GROUPS (a list of user group records) are all available." - (define (touch file) - (close-port (open-file file "a0b"))) - - (define activate-user - (lambda (user) - (let ((name (user-account-name user)) - (uid (user-account-uid user)) - (group (user-account-group user)) - (supplementary-groups - (user-account-supplementary-groups user)) - (comment (user-account-comment user)) - (home (user-account-home-directory user)) - (create-home? (user-account-create-home-directory? user)) - (shell (user-account-shell user)) - (password (user-account-password user)) - (system? (user-account-system? user))) - (let ((profile-dir (string-append "/var/guix/profiles/per-user/" - name))) - (ensure-user name group - #:uid uid - #:system? system? - #:supplementary-groups supplementary-groups - #:comment comment - #:home home - #:create-home? create-home? - - #:shell shell - #:password password) - - (unless system? - ;; Create the profile directory for the new account. - (let ((pw (getpwnam name))) - (mkdir-p profile-dir) - (chown profile-dir (passwd:uid pw) (passwd:gid pw)))))))) - - ;; 'groupadd' aborts if the file doesn't already exist. - (touch "/etc/group") + (define (make-home-directory user) + (let ((home (user-account-home-directory user)) + (pwd (getpwnam (user-account-name user)))) + (mkdir-p home) + (chown home (passwd:uid pwd) (passwd:gid pwd)) + (chmod home #o700))) ;; Allow home directories to be created under /var/lib. (mkdir-p "/var/lib") - ;; Create the root account so we can use 'useradd' and 'groupadd'. - (activate-user (find (compose zero? user-account-uid) users)) + (let-values (((groups passwd shadow) + (user+group-databases users groups))) + (write-group groups) + (write-passwd passwd) + (write-shadow shadow) - ;; Then create the groups. - (for-each (lambda (group) - (let ((name (user-group-name group)) - (password (user-group-password group)) - (gid (user-group-id group)) - (system? (user-group-system? group))) - (unless (false-if-exception (getgrnam name)) - (add-group name - #:gid gid #:password password - #:system? system?)))) - groups) - - ;; Create the other user accounts. - (for-each activate-user users) - - ;; Finally, delete extra user accounts and groups. - (for-each delete-user - (lset-difference string=? - (map passwd:name (current-users)) - (map user-account-name users))) - (for-each delete-group - (lset-difference string=? - (map group:name (current-groups)) - (map user-group-name groups)))) + ;; Home directories of non-system accounts are created by + ;; 'activate-user-home'. + (for-each make-home-directory + (filter (lambda (user) + (and (user-account-system? user) + (user-account-create-home-directory? user))) + users)))) (define (activate-user-home users) "Create and populate the home directory of USERS, a list of tuples, unless diff --git a/gnu/build/install.scm b/gnu/build/install.scm index c9ebe124fe..c0d4d44091 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, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2016 Chris Marusich ;;; ;;; This file is part of GNU Guix. @@ -117,7 +117,6 @@ STORE." (directory "/var/tmp" 0 0 #o1777) (directory "/var/lock" 0 0 #o1777) - (directory "/root" 0 0) ; an exception (directory "/home" 0 0))) (define (populate-root-file-system system target) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 4e5b6ae5f2..7dc36f4a45 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -302,8 +302,6 @@ group." #~(begin (use-modules (gnu system accounts)) - (setenv "PATH" - (string-append #$(@ (gnu packages admin) shadow) "/sbin")) (activate-users+groups (map sexp->user-account (list #$@user-specs)) (map sexp->user-group (list #$@group-specs))))))