[jackhill/guix/guix.git] / gnu / installer / user.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(define-module (gnu installer user)
  #:use-module (guix records)
  #:use-module (srfi srfi-1)
  #:export (<user>
            user
            make-user
            user-name
            user-group
            user-home-directory
            user-password

            users->configuration))

(define-record-type* <user>
  user make-user
  user?
  (name            user-name)
  (group           user-group
                   (default "users"))
  (password        user-password)
  (home-directory  user-home-directory))

(define (users->configuration users)
  "Return the configuration field for USERS."
  (define (user->sexp user)
    `(user-account
      (name ,(user-name user))
      (group ,(user-group user))
      (home-directory ,(user-home-directory user))
      (supplementary-groups '("wheel" "netdev"
                              "audio" "video"))))

  `((users (cons*
            ,@(filter-map (lambda (user)
                            ;; Do not emit a 'user-account' form for "root".
                            (and (not (string=? (user-name user) "root"))
                                 (user->sexp user)))
                          users)
            %base-user-accounts))))
Commit	Line	Data
47c94801 MO	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (gnu installer user)
	20	#:use-module (guix records)
91a7c499	21	#:use-module (srfi srfi-1)
47c94801 MO	22	#:export (<user>
	23	user
	24	make-user
	25	user-name
	26	user-group
	27	user-home-directory
898677ed	28	user-password
47c94801 MO	29
	30	users->configuration))
	31
	32	(define-record-type* <user>
	33	user make-user
	34	user?
	35	(name user-name)
	36	(group user-group
	37	(default "users"))
898677ed	38	(password user-password)
47c94801 MO	39	(home-directory user-home-directory))
	40
	41	(define (users->configuration users)
	42	"Return the configuration field for USERS."
91a7c499 LC	43	(define (user->sexp user)
	44	`(user-account
	45	(name ,(user-name user))
	46	(group ,(user-group user))
	47	(home-directory ,(user-home-directory user))
	48	(supplementary-groups '("wheel" "netdev"
	49	"audio" "video"))))
	50
47c94801	51	`((users (cons*
91a7c499 LC	52	,@(filter-map (lambda (user)
	53	;; Do not emit a 'user-account' form for "root".
	54	(and (not (string=? (user-name user) "root"))
	55	(user->sexp user)))
	56	users)
	57	%base-user-accounts))))