Commit | Line | Data |
---|---|---|
0ded70f3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
e87f0591 | 2 | ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> |
0ded70f3 LC |
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) | |
bacadb02 | 20 | #:use-module (guix records) |
b5f4e686 | 21 | #:use-module (guix gexp) |
e87f0591 | 22 | #:use-module (guix store) |
d9f0a237 | 23 | #:use-module (guix monads) |
7f239fd3 LC |
24 | #:use-module ((gnu system file-systems) |
25 | #:select (%tty-gid)) | |
9de46ffb | 26 | #:use-module ((gnu packages admin) |
d0c66871 | 27 | #:select (shadow)) |
78ed0038 | 28 | #:use-module (gnu packages bash) |
838d9a9d | 29 | #:use-module (gnu packages guile-wm) |
bacadb02 LC |
30 | #:export (user-account |
31 | user-account? | |
32 | user-account-name | |
ab6a279a | 33 | user-account-password |
bacadb02 | 34 | user-account-uid |
ab6a279a LC |
35 | user-account-group |
36 | user-account-supplementary-groups | |
bacadb02 LC |
37 | user-account-comment |
38 | user-account-home-directory | |
39 | user-account-shell | |
459dd9ea | 40 | user-account-system? |
bacadb02 | 41 | |
16a0e9dc LC |
42 | user-group |
43 | user-group? | |
44 | user-group-name | |
45 | user-group-password | |
46 | user-group-id | |
c8fa3426 | 47 | user-group-system? |
838d9a9d LC |
48 | |
49 | default-skeletons | |
773e956d LC |
50 | skeleton-directory |
51 | %base-groups)) | |
0ded70f3 LC |
52 | |
53 | ;;; Commentary: | |
54 | ;;; | |
55 | ;;; Utilities for configuring the Shadow tool suite ('login', 'passwd', etc.) | |
56 | ;;; | |
57 | ;;; Code: | |
58 | ||
bacadb02 LC |
59 | (define-record-type* <user-account> |
60 | user-account make-user-account | |
61 | user-account? | |
62 | (name user-account-name) | |
ab6a279a LC |
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 | |
bacadb02 LC |
68 | (comment user-account-comment (default "")) |
69 | (home-directory user-account-home-directory) | |
b5f4e686 | 70 | (shell user-account-shell ; gexp |
459dd9ea LC |
71 | (default #~(string-append #$bash "/bin/bash"))) |
72 | (system? user-account-system? ; Boolean | |
73 | (default #f))) | |
bacadb02 | 74 | |
16a0e9dc LC |
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)) | |
c8fa3426 LC |
80 | (id user-group-id (default #f)) |
81 | (system? user-group-system? ; Boolean | |
82 | (default #f))) | |
16a0e9dc | 83 | |
773e956d LC |
84 | (define %base-groups |
85 | ;; Default set of groups. | |
c8fa3426 LC |
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. | |
773e956d | 93 | |
c8fa3426 LC |
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")) | |
e617a861 | 99 | (system-group (name "input")) ; input devices, from udev |
c8fa3426 LC |
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")) | |
7f28bf9a LC |
107 | (system-group (name "tape")) |
108 | (system-group (name "kvm"))))) ; for /dev/kvm | |
773e956d | 109 | |
838d9a9d LC |
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 | ||
4e2a21d3 SB |
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 | PS1='\\u@\\h \\w\\$ ' | |
124 | alias ls='ls -p --color' | |
125 | alias ll='ls -l'\n")) | |
02f707c5 SB |
126 | (zlogin (text-file "zlogin" "\ |
127 | # Honor system-wide environment variables | |
128 | source /etc/profile\n")) | |
838d9a9d LC |
129 | (guile-wm (gexp->derivation "guile-wm" copy-guile-wm |
130 | #:modules | |
131 | '((guix build utils)))) | |
132 | (xdefaults (text-file "Xdefaults" "\ | |
133 | XTerm*utf8: always | |
134 | XTerm*metaSendsEscape: true\n")) | |
135 | (gdbinit (text-file "gdbinit" "\ | |
136 | # Tell GDB where to look for separate debugging files. | |
137 | set debug-file-directory ~/.guix-profile/lib/debug\n"))) | |
4e2a21d3 SB |
138 | (return `((".bash_profile" ,profile) |
139 | (".bashrc" ,bashrc) | |
02f707c5 | 140 | (".zlogin" ,zlogin) |
838d9a9d LC |
141 | (".Xdefaults" ,xdefaults) |
142 | (".guile-wm" ,guile-wm) | |
143 | (".gdbinit" ,gdbinit))))) | |
144 | ||
145 | (define (skeleton-directory skeletons) | |
146 | "Return a directory containing SKELETONS, a list of name/derivation pairs." | |
147 | (gexp->derivation "skel" | |
148 | #~(begin | |
149 | (use-modules (ice-9 match)) | |
150 | ||
151 | (mkdir #$output) | |
152 | (chdir #$output) | |
153 | ||
154 | ;; Note: copy the skeletons instead of symlinking | |
155 | ;; them like 'file-union' does, because 'useradd' | |
156 | ;; would just copy the symlinks as is. | |
157 | (for-each (match-lambda | |
158 | ((target source) | |
159 | (copy-file source target))) | |
160 | '#$skeletons) | |
161 | #t))) | |
162 | ||
0ded70f3 | 163 | ;;; shadow.scm ends here |