gnu/system/shadow.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
   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 system shadow)
  20   #:use-module (guix records)
  21   #:use-module (guix gexp)
  22   #:use-module (guix monads)
  23   #:use-module ((gnu system file-systems)
  24                 #:select (%tty-gid))
  25   #:use-module ((gnu packages admin)
  26                 #:select (shadow))
  27   #:use-module (gnu packages bash)
  28   #:use-module (gnu packages guile-wm)
  29   #:export (user-account
  30             user-account?
  31             user-account-name
  32             user-account-password
  33             user-account-uid
  34             user-account-group
  35             user-account-supplementary-groups
  36             user-account-comment
  37             user-account-home-directory
  38             user-account-shell
  39             user-account-system?
  40
  41             user-group
  42             user-group?
  43             user-group-name
  44             user-group-password
  45             user-group-id
  46             user-group-system?
  47
  48             default-skeletons
  49             skeleton-directory
  50             %base-groups))
  51
  52 ;;; Commentary:
  53 ;;;
  54 ;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.)
  55 ;;;
  56 ;;; Code:
  57
  58 (define-record-type* <user-account>
  59   user-account make-user-account
  60   user-account?
  61   (name           user-account-name)
  62   (password       user-account-password (default #f))
  63   (uid            user-account-uid (default #f))
  64   (group          user-account-group)             ; number | string
  65   (supplementary-groups user-account-supplementary-groups
  66                         (default '()))            ; list of strings
  67   (comment        user-account-comment (default ""))
  68   (home-directory user-account-home-directory)
  69   (shell          user-account-shell              ; gexp
  70                   (default #~(string-append #$bash "/bin/bash")))
  71   (system?        user-account-system?            ; Boolean
  72                   (default #f)))
  73
  74 (define-record-type* <user-group>
  75   user-group make-user-group
  76   user-group?
  77   (name           user-group-name)
  78   (password       user-group-password (default #f))
  79   (id             user-group-id (default #f))
  80   (system?        user-group-system?              ; Boolean
  81                   (default #f)))
  82
  83 (define %base-groups
  84   ;; Default set of groups.
  85   (let-syntax ((system-group (syntax-rules ()
  86                                ((_ args ...)
  87                                 (user-group (system? #t) args ...)))))
  88     (list (system-group (name "root") (id 0))
  89           (system-group (name "wheel"))              ; root-like users
  90           (system-group (name "users"))              ; normal users
  91           (system-group (name "nogroup"))            ; for daemons etc.
  92
  93           ;; The following groups are conventionally used by things like udev to
  94           ;; control access to hardware devices.
  95           (system-group (name "tty") (id %tty-gid))
  96           (system-group (name "dialout"))
  97           (system-group (name "kmem"))
  98           (system-group (name "input"))              ; input devices, from udev
  99           (system-group (name "video"))
 100           (system-group (name "audio"))
 101           (system-group (name "netdev"))             ; used in avahi-dbus.conf
 102           (system-group (name "lp"))
 103           (system-group (name "disk"))
 104           (system-group (name "floppy"))
 105           (system-group (name "cdrom"))
 106           (system-group (name "tape"))
 107           (system-group (name "kvm")))))             ; for /dev/kvm
 108
 109 (define (default-skeletons)
 110   "Return the default skeleton files for /etc/skel.  These files are copied by
 111 'useradd' in the home directory of newly created user accounts."
 112   (define copy-guile-wm
 113     #~(begin
 114         (use-modules (guix build utils))
 115         (copy-file (car (find-files #$guile-wm "wm-init-sample.scm"))
 116                    #$output)))
 117
 118   (mlet %store-monad ((profile (text-file "bash_profile" "\
 119 # Honor per-interactive-shell startup file
 120 if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n"))
 121                       (bashrc (text-file "bashrc" "\
 122 PS1='\\u@\\h \\w\\$ '
 123 alias ls='ls -p --color'
 124 alias ll='ls -l'\n"))
 125                       (guile-wm (gexp->derivation "guile-wm" copy-guile-wm
 126                                                   #:modules
 127                                                   '((guix build utils))))
 128                       (xdefaults (text-file "Xdefaults" "\
 129 XTerm*utf8: always
 130 XTerm*metaSendsEscape: true\n"))
 131                       (gdbinit   (text-file "gdbinit" "\
 132 # Tell GDB where to look for separate debugging files.
 133 set debug-file-directory ~/.guix-profile/lib/debug\n")))
 134     (return `((".bash_profile" ,profile)
 135               (".bashrc" ,bashrc)
 136               (".Xdefaults" ,xdefaults)
 137               (".guile-wm" ,guile-wm)
 138               (".gdbinit" ,gdbinit)))))
 139
 140 (define (skeleton-directory skeletons)
 141   "Return a directory containing SKELETONS, a list of name/derivation pairs."
 142   (gexp->derivation "skel"
 143                     #~(begin
 144                         (use-modules (ice-9 match))
 145
 146                         (mkdir #$output)
 147                         (chdir #$output)
 148
 149                         ;; Note: copy the skeletons instead of symlinking
 150                         ;; them like 'file-union' does, because 'useradd'
 151                         ;; would just copy the symlinks as is.
 152                         (for-each (match-lambda
 153                                    ((target source)
 154                                     (copy-file source target)))
 155                                   '#$skeletons)
 156                         #t)))
 157
 158 ;;; shadow.scm ends here