gnu/installer/user.scm

   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)
  21   #:use-module (srfi srfi-1)
  22   #:export (<user>
  23             user
  24             make-user
  25             user-name
  26             user-real-name
  27             user-group
  28             user-home-directory
  29             user-password
  30
  31             users->configuration))
  32
  33 (define-record-type* <user>
  34   user make-user
  35   user?
  36   (name            user-name)
  37   (real-name       user-real-name
  38                    (default ""))
  39   (group           user-group
  40                    (default "users"))
  41   (password        user-password)
  42   (home-directory  user-home-directory))
  43
  44 (define (users->configuration users)
  45   "Return the configuration field for USERS."
  46   (define (user->sexp user)
  47     `(user-account
  48       (name ,(user-name user))
  49       (comment ,(user-real-name user))
  50       (group ,(user-group user))
  51       (home-directory ,(user-home-directory user))
  52       (supplementary-groups '("wheel" "netdev"
  53                               "audio" "video"))))
  54
  55   `((users (cons*
  56             ,@(filter-map (lambda (user)
  57                             ;; Do not emit a 'user-account' form for "root".
  58                             (and (not (string=? (user-name user) "root"))
  59                                  (user->sexp user)))
  60                           users)
  61             %base-user-accounts))))