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 (gnu installer utils)
  21   #:use-module (guix records)
  22   #:use-module (guix read-print)
  23   #:use-module (srfi srfi-1)
  24   #:use-module (srfi srfi-9)
  25   #:use-module (srfi srfi-9 gnu)
  26   #:export (<user>
  27             user
  28             make-user
  29             user-name
  30             user-real-name
  31             user-group
  32             user-home-directory
  33             user-password
  34
  35             users->configuration))
  36
  37 (define-record-type* <user>
  38   user make-user
  39   user?
  40   (name            user-name)
  41   (real-name       user-real-name
  42                    (default ""))
  43   (group           user-group
  44                    (default "users"))
  45   (password        user-password)
  46   (home-directory  user-home-directory))
  47
  48 (define (users->configuration users)
  49   "Return the configuration field for USERS."
  50   (define (user->sexp user)
  51     `(user-account
  52       (name ,(user-name user))
  53       (comment ,(user-real-name user))
  54       (group ,(user-group user))
  55       (home-directory ,(user-home-directory user))
  56       (supplementary-groups '("wheel" "netdev"
  57                               "audio" "video"))))
  58
  59   (define-syntax-rule (G_ str) str)
  60
  61   `(,(vertical-space 1)
  62     ,(comment (G_ ";; The list of user accounts ('root' is implicit).\n"))
  63     (users (cons*
  64             ,@(filter-map (lambda (user)
  65                             ;; Do not emit a 'user-account' form for "root".
  66                             (and (not (string=? (user-name user) "root"))
  67                                  (user->sexp user)))
  68                           users)
  69             %base-user-accounts))))