gnu/system/shadow.scm

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