Commit | Line | Data |
---|---|---|
0ded70f3 | 1 | ;;; GNU Guix --- Functional package management for GNU |
ce8a6dfc | 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 linux) | |
0ded70f3 LC |
20 | #:use-module (guix records) |
21 | #:use-module (guix derivations) | |
b5f4e686 | 22 | #:use-module (guix gexp) |
0ded70f3 LC |
23 | #:use-module (ice-9 match) |
24 | #:use-module (srfi srfi-1) | |
25 | #:use-module (srfi srfi-26) | |
26 | #:use-module ((guix utils) #:select (%current-system)) | |
27 | #:export (pam-service | |
28 | pam-entry | |
29 | pam-services->directory | |
09e028f4 LC |
30 | unix-pam-service |
31 | base-pam-services)) | |
0ded70f3 LC |
32 | |
33 | ;;; Commentary: | |
34 | ;;; | |
35 | ;;; Configuration of Linux-related things, including pluggable authentication | |
36 | ;;; modules (PAM). | |
37 | ;;; | |
38 | ;;; Code: | |
39 | ||
40 | ;; PAM services (see | |
41 | ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.) | |
42 | (define-record-type* <pam-service> pam-service | |
43 | make-pam-service | |
44 | pam-service? | |
45 | (name pam-service-name) ; string | |
46 | ||
47 | ;; The four "management groups". | |
48 | (account pam-service-account ; list of <pam-entry> | |
49 | (default '())) | |
50 | (auth pam-service-auth | |
51 | (default '())) | |
52 | (password pam-service-password | |
53 | (default '())) | |
54 | (session pam-service-session | |
55 | (default '()))) | |
56 | ||
57 | (define-record-type* <pam-entry> pam-entry | |
58 | make-pam-entry | |
59 | pam-entry? | |
b5f4e686 LC |
60 | (control pam-entry-control) ; string |
61 | (module pam-entry-module) ; file name | |
62 | (arguments pam-entry-arguments ; list of string-valued g-expressions | |
0ded70f3 LC |
63 | (default '()))) |
64 | ||
65 | (define (pam-service->configuration service) | |
b5f4e686 LC |
66 | "Return the derivation building the configuration file for SERVICE, to be |
67 | dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." | |
68 | (define (entry->gexp type entry) | |
0ded70f3 LC |
69 | (match entry |
70 | (($ <pam-entry> control module (arguments ...)) | |
b5f4e686 LC |
71 | #~(format #t "~a ~a ~a ~a~%" |
72 | #$type #$control #$module | |
73 | (string-join (list #$@arguments)))))) | |
0ded70f3 LC |
74 | |
75 | (match service | |
76 | (($ <pam-service> name account auth password session) | |
b5f4e686 LC |
77 | (define builder |
78 | #~(begin | |
79 | (with-output-to-file #$output | |
80 | (lambda () | |
81 | #$@(append (map (cut entry->gexp "account" <>) account) | |
82 | (map (cut entry->gexp "auth" <>) auth) | |
83 | (map (cut entry->gexp "password" <>) password) | |
84 | (map (cut entry->gexp "session" <>) session)) | |
85 | #t)))) | |
86 | ||
23afe939 | 87 | (computed-file name builder)))) |
0ded70f3 | 88 | |
d9f0a237 | 89 | (define (pam-services->directory services) |
0ded70f3 LC |
90 | "Return the derivation to build the configuration directory to be used as |
91 | /etc/pam.d for SERVICES." | |
23afe939 LC |
92 | (let ((names (map pam-service-name services)) |
93 | (files (map pam-service->configuration services))) | |
0ded70f3 | 94 | (define builder |
b5f4e686 | 95 | #~(begin |
11dddd8a LC |
96 | (use-modules (ice-9 match) |
97 | (srfi srfi-1)) | |
0ded70f3 | 98 | |
b5f4e686 LC |
99 | (mkdir #$output) |
100 | (for-each (match-lambda | |
101 | ((name file) | |
102 | (symlink file (string-append #$output "/" name)))) | |
11dddd8a LC |
103 | |
104 | ;; Since <pam-service> objects cannot be compared with | |
105 | ;; 'equal?' since they contain gexps, which contain | |
106 | ;; closures, use 'delete-duplicates' on the build-side | |
107 | ;; instead. See <http://bugs.gnu.org/20037>. | |
108 | (delete-duplicates '#$(zip names files))))) | |
0ded70f3 | 109 | |
23afe939 | 110 | (computed-file "pam.d" builder))) |
0ded70f3 LC |
111 | |
112 | (define %pam-other-services | |
113 | ;; The "other" PAM configuration, which denies everything (see | |
114 | ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.) | |
115 | (let ((deny (pam-entry | |
116 | (control "required") | |
117 | (module "pam_deny.so")))) | |
118 | (pam-service | |
119 | (name "other") | |
120 | (account (list deny)) | |
121 | (auth (list deny)) | |
122 | (password (list deny)) | |
123 | (session (list deny))))) | |
124 | ||
125 | (define unix-pam-service | |
126 | (let ((unix (pam-entry | |
127 | (control "required") | |
128 | (module "pam_unix.so")))) | |
43a27798 | 129 | (lambda* (name #:key allow-empty-passwords? motd) |
0ded70f3 | 130 | "Return a standard Unix-style PAM service for NAME. When |
43a27798 | 131 | ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When MOTD is true, it |
ce8a6dfc | 132 | should be a file-like object used as the message-of-the-day." |
0ded70f3 LC |
133 | ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>. |
134 | (let ((name* name)) | |
135 | (pam-service | |
136 | (name name*) | |
137 | (account (list unix)) | |
138 | (auth (list (if allow-empty-passwords? | |
139 | (pam-entry | |
140 | (control "required") | |
141 | (module "pam_unix.so") | |
142 | (arguments '("nullok"))) | |
143 | unix))) | |
9297065a SB |
144 | (password (list (pam-entry |
145 | (control "required") | |
146 | (module "pam_unix.so") | |
147 | ;; Store SHA-512 encrypted passwords in /etc/shadow. | |
148 | (arguments '("sha512" "shadow"))))) | |
43a27798 LC |
149 | (session (if motd |
150 | (list unix | |
151 | (pam-entry | |
152 | (control "optional") | |
153 | (module "pam_motd.so") | |
b5f4e686 LC |
154 | (arguments |
155 | (list #~(string-append "motd=" #$motd))))) | |
43a27798 | 156 | (list unix)))))))) |
0ded70f3 | 157 | |
da417ffe LC |
158 | (define (rootok-pam-service command) |
159 | "Return a PAM service for COMMAND such that 'root' does not need to | |
160 | authenticate to run COMMAND." | |
161 | (let ((unix (pam-entry | |
162 | (control "required") | |
163 | (module "pam_unix.so")))) | |
164 | (pam-service | |
165 | (name command) | |
166 | (account (list unix)) | |
167 | (auth (list (pam-entry | |
168 | (control "sufficient") | |
169 | (module "pam_rootok.so")))) | |
170 | (password (list unix)) | |
171 | (session (list unix))))) | |
172 | ||
09e028f4 LC |
173 | (define* (base-pam-services #:key allow-empty-passwords?) |
174 | "Return the list of basic PAM services everyone would want." | |
da417ffe LC |
175 | ;; TODO: Add other Shadow programs? |
176 | (append (list %pam-other-services) | |
177 | ||
178 | ;; These programs are setuid-root. | |
179 | (map (cut unix-pam-service <> | |
180 | #:allow-empty-passwords? allow-empty-passwords?) | |
f9d53de1 LC |
181 | '("su" "passwd" "sudo" |
182 | "xlock" "xscreensaver")) | |
da417ffe LC |
183 | |
184 | ;; These programs are not setuid-root, and we want root to be able | |
185 | ;; to run them without having to authenticate (notably because | |
186 | ;; 'useradd' and 'groupadd' are run during system activation.) | |
187 | (map rootok-pam-service | |
188 | '("useradd" "userdel" "usermod" | |
189 | "groupadd" "groupdel" "groupmod")))) | |
09e028f4 | 190 | |
0ded70f3 | 191 | ;;; linux.scm ends here |