projects/guix·blob python-team · refs

458 lines · 17.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2013-2017, 2019-2021 Ludovic Courtès <[email protected]>
3;;; Copyright © 2023 Josselin Poiret <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20;;; Commentary:
21;;;
22;;; Configuration of the pluggable authentication modules (PAM).
23;;;
24;;; Code:
25
26(define-module (gnu system pam)
27 #:use-module (guix records)
28 #:use-module (guix derivations)
29 #:use-module (guix diagnostics)
30 #:use-module (guix gexp)
31 #:use-module (guix i18n)
32 #:use-module (gnu services)
33 #:use-module (gnu services shepherd)
34 #:use-module (gnu system setuid)
35 #:use-module (ice-9 match)
36 #:use-module (srfi srfi-1)
37 #:use-module (srfi srfi-9)
38 #:use-module (srfi srfi-11)
39 #:use-module (srfi srfi-26)
40 #:use-module ((guix utils) #:select (%current-system))
41 #:use-module (gnu packages linux)
42 #:export (pam-service
43 pam-service?
44 pam-service-name
45 pam-service-account
46 pam-service-auth
47 pam-service-password
48 pam-service-session
49
50 pam-entry
51 pam-entry?
52 pam-entry-control
53 pam-entry-module
54 pam-entry-arguments
55
56 pam-limits-entry
57 pam-limits-entry?
58 pam-limits-entry-domain
59 pam-limits-entry-type
60 pam-limits-entry-item
61 pam-limits-entry-value
62 pam-limits-entry->string
63
64 pam-services->directory
65 unix-pam-service
66 base-pam-services
67
68 session-environment-service
69 session-environment-service-type
70
71 pam-extension
72 pam-extension-transformer
73 pam-extension-shepherd-requirements
74
75 pam-root-service-type
76 pam-root-service))
77
78;; PAM services (see
79;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
80(define-record-type* <pam-service> pam-service
81 make-pam-service
82 pam-service?
83 (name pam-service-name) ; string
84
85 ;; The four "management groups".
86 (account pam-service-account ; list of <pam-entry>
87 (default '()))
88 (auth pam-service-auth
89 (default '()))
90 (password pam-service-password
91 (default '()))
92 (session pam-service-session
93 (default '())))
94
95(define-record-type* <pam-entry> pam-entry
96 make-pam-entry
97 pam-entry?
98 (control pam-entry-control) ; string
99 (module pam-entry-module) ; file name
100 (arguments pam-entry-arguments ; list of string-valued g-expressions
101 (default '())))
102
103;; PAM limits entries are used by the pam_limits PAM module to set or override
104;; limits on system resources for user sessions. The format is specified
105;; here: http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html
106(define-record-type <pam-limits-entry>
107 (make-pam-limits-entry domain type item value)
108 pam-limits-entry?
109 (domain pam-limits-entry-domain) ; string
110 (type pam-limits-entry-type) ; symbol
111 (item pam-limits-entry-item) ; symbol
112 (value pam-limits-entry-value)) ; symbol or number
113
114(define (pam-limits-entry domain type item value)
115 "Construct a pam-limits-entry ensuring that the provided values are valid."
116 (define (valid? value)
117 (case item
118 ((priority) (number? value))
119 ((nice) (and (number? value)
120 (>= value -20)
121 (<= value 19)))
122 (else (or (and (number? value)
123 (>= value -1))
124 (member value '(unlimited infinity))))))
125 (define items
126 (list 'core 'data 'fsize
127 'memlock 'nofile 'rss
128 'stack 'cpu 'nproc
129 'as 'maxlogins 'maxsyslogins
130 'priority 'locks 'sigpending
131 'msgqueue 'nice 'rtprio))
132 (when (not (member type '(hard soft both)))
133 (error "invalid limit type" type))
134 (when (not (member item items))
135 (error "invalid limit item" item))
136 (when (not (valid? value))
137 (error "invalid limit value" value))
138 (make-pam-limits-entry domain type item value))
139
140(define (pam-limits-entry->string entry)
141 "Convert a pam-limits-entry record to a string."
142 (match entry
143 (($ <pam-limits-entry> domain type item value)
144 (string-join (list domain
145 (if (eq? type 'both)
146 "-"
147 (symbol->string type))
148 (symbol->string item)
149 (cond
150 ((symbol? value)
151 (symbol->string value))
152 (else
153 (number->string value))))
154 " "))))
155
156(define (pam-service->configuration service)
157 "Return the derivation building the configuration file for SERVICE, to be
158dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
159 (define (entry->gexp type entry)
160 (match entry
161 (($ <pam-entry> control module (arguments ...))
162 #~(format #t "~a ~a ~a ~a~%"
163 #$type #$control #$module
164 (string-join (list #$@arguments))))))
165
166 (match service
167 (($ <pam-service> name account auth password session)
168 (define builder
169 #~(begin
170 (with-output-to-file #$output
171 (lambda ()
172 #$@(append (map (cut entry->gexp "account" <>) account)
173 (map (cut entry->gexp "auth" <>) auth)
174 (map (cut entry->gexp "password" <>) password)
175 (map (cut entry->gexp "session" <>) session))
176 #t))))
177
178 (computed-file name builder))))
179
180(define (pam-services->directory services)
181 "Return the derivation to build the configuration directory to be used as
182/etc/pam.d for SERVICES."
183 (let ((names (map pam-service-name services))
184 (files (map pam-service->configuration services)))
185 (define builder
186 #~(begin
187 (use-modules (ice-9 match)
188 (srfi srfi-1))
189
190 (mkdir #$output)
191 (for-each (match-lambda
192 ((name file)
193 (symlink file (string-append #$output "/" name))))
194
195 ;; Since <pam-service> objects cannot be compared with
196 ;; 'equal?' since they contain gexps, which contain
197 ;; closures, use 'delete-duplicates' on the build-side
198 ;; instead. See <http://bugs.gnu.org/20037>.
199 (delete-duplicates '#$(zip names files)))))
200
201 (computed-file "pam.d" builder)))
202
203(define %pam-other-services
204 ;; The "other" PAM configuration, which denies everything (see
205 ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
206 (let ((deny (pam-entry
207 (control "required")
208 (module "pam_deny.so"))))
209 (pam-service
210 (name "other")
211 (account (list deny))
212 (auth (list deny))
213 (password (list deny))
214 (session (list deny)))))
215
216(define unix-pam-service
217 (let ((unix (pam-entry
218 (control "required")
219 (module "pam_unix.so")))
220 (env (pam-entry ; to honor /etc/environment.
221 (control "required")
222 (module "pam_env.so"))))
223 (lambda* (name #:key allow-empty-passwords? allow-root? motd
224 login-uid? gnupg?)
225 "Return a standard Unix-style PAM service for NAME. When
226ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When ALLOW-ROOT? is
227true, allow root to run the command without authentication. When MOTD is
228true, it should be a file-like object used as the message-of-the-day.
229When LOGIN-UID? is true, require the 'pam_loginuid' module; that module sets
230/proc/self/loginuid, which the libc 'getlogin' function relies on. When
231GNUPG? is true, require the 'pam_gnupg.so' module; that module hands over
232the login password to 'gpg-agent'."
233 ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
234 (pam-service
235 (name name)
236 (account (list unix))
237 (auth (append (if allow-root?
238 (list (pam-entry
239 (control "sufficient")
240 (module "pam_rootok.so")))
241 '())
242 (list (if allow-empty-passwords?
243 (pam-entry
244 (control "required")
245 (module "pam_unix.so")
246 (arguments '("nullok")))
247 unix))
248 (if gnupg?
249 (list (pam-entry
250 (control "required")
251 (module (file-append pam-gnupg "/lib/security/pam_gnupg.so"))))
252 '())))
253 (password (list (pam-entry
254 (control "required")
255 (module "pam_unix.so")
256 ;; Store SHA-512 encrypted passwords in /etc/shadow.
257 (arguments '("sha512" "shadow")))))
258 (session `(,@(if motd
259 (list (pam-entry
260 (control "optional")
261 (module "pam_motd.so")
262 (arguments
263 (list #~(string-append "motd=" #$motd)))))
264 '())
265 ,@(if login-uid?
266 (list (pam-entry ;to fill in /proc/self/loginuid
267 (control "required")
268 (module "pam_loginuid.so")))
269 '())
270 ,@(if gnupg?
271 (list (pam-entry
272 (control "required")
273 (module (file-append pam-gnupg "/lib/security/pam_gnupg.so"))))
274 '())
275 ,env ,unix))))))
276
277(define (rootok-pam-service command)
278 "Return a PAM service for COMMAND such that 'root' does not need to
279authenticate to run COMMAND."
280 (let ((unix (pam-entry
281 (control "required")
282 (module "pam_unix.so"))))
283 (pam-service
284 (name command)
285 (account (list unix))
286 (auth (list (pam-entry
287 (control "sufficient")
288 (module "pam_rootok.so"))))
289 (password (list unix))
290 (session (list unix)))))
291
292(define* (base-pam-services #:key allow-empty-passwords?)
293 "Return the list of basic PAM services everyone would want."
294 ;; TODO: Add other Shadow programs?
295 (append (list %pam-other-services)
296
297 ;; These programs are setuid-root.
298 (map (cut unix-pam-service <>
299 #:allow-empty-passwords? allow-empty-passwords?)
300 '("passwd" "chfn" "sudo"))
301 ;; This is setuid-root, as well. Allow root to run "su" without
302 ;; authenticating.
303 (list (unix-pam-service "su"
304 #:allow-empty-passwords? allow-empty-passwords?
305 #:allow-root? #t))
306
307 ;; These programs are not setuid-root, and we want root to be able
308 ;; to run them without having to authenticate (notably because
309 ;; 'useradd' and 'groupadd' are run during system activation.)
310 (map rootok-pam-service
311 '("useradd" "userdel" "usermod"
312 "groupadd" "groupdel" "groupmod"))))
313
314
315;;;
316;;; System-wide environment variables.
317;;;
318
319(define (environment-variables->environment-file vars)
320 "Return a file for pam_env(8) that contains environment variables VARS."
321 (apply mixed-text-file "environment"
322 (append-map (match-lambda
323 ((key . value)
324 (list key "=" value "\n")))
325 vars)))
326
327(define session-environment-service-type
328 (service-type
329 (name 'session-environment)
330 (extensions
331 (list (service-extension
332 etc-service-type
333 (lambda (vars)
334 (list `("environment"
335 ,(environment-variables->environment-file vars)))))))
336 (compose concatenate)
337 (extend append)
338 (description
339 "Populate @file{/etc/environment}, which is honored by @code{pam_env},
340with the specified environment variables. The value of this service is a list
341of name/value pairs for environments variables, such as:
342
343@example
344'((\"TZ\" . \"Canada/Pacific\"))
345@end example\n")))
346
347(define (session-environment-service vars)
348 "Return a service that builds the @file{/etc/environment}, which can be read
349by PAM-aware applications to set environment variables for sessions.
350
351VARS should be an association list in which both the keys and the values are
352strings or string-valued gexps."
353 (service session-environment-service-type vars))
354
355
356
357;;;
358;;; PAM root service.
359;;;
360
361;; Extension of the PAM configuration. A PAM transformer consists of a
362;; procedure acting on each PAM entry; 'shepherd-requirements' lists services
363;; that the meta 'pam' Shepherd service will depend on.
364(define-record-type* <pam-extension>
365 pam-extension make-pam-extension pam-extension?
366 (transformer pam-extension-transformer)
367 (shepherd-requirements pam-extension-shepherd-requirements
368 (default '())))
369
370;; Overall PAM configuration: a list of services, plus a procedure that takes
371;; one <pam-service> and returns a <pam-service>. The procedure is used to
372;; implement cross-cutting concerns such as the use of the 'elogind.so'
373;; session module that keeps track of logged-in users.
374(define-record-type* <pam-configuration>
375 pam-configuration make-pam-configuration pam-configuration?
376 ;list of <pam-service>
377 (services pam-configuration-services)
378 ;list of procedures <pam-entry> -> <pam-entry>
379 (transformers pam-configuration-transformers)
380 ;list of symbols
381 (shepherd-requirements pam-configuration-shepherd-requirements))
382
383(define (/etc-entry config)
384 "Return the /etc/pam.d entry corresponding to CONFIG."
385 (match config
386 (($ <pam-configuration> services transformers shepherd-requirements)
387 (let ((services (map (apply compose identity transformers)
388 services)))
389 `(("pam.d" ,(pam-services->directory services)))))))
390
391(define (pam-shepherd-service config)
392 "Return the PAM synchronization shepherd service corresponding to CONFIG."
393 (match config
394 (($ <pam-configuration> services transformers shepherd-requirements)
395 (list (shepherd-service
396 (documentation "Synchronization point for services that need to be
397started for PAM to work.")
398 (provision '(pam))
399 (requirement shepherd-requirements)
400 (start #~(const #t))
401 (stop #~(const #f)))))))
402
403(define (extend-configuration initial extensions)
404 "Extend INITIAL with NEW."
405 ;; TODO: Remove deprecation shim.
406 (define cleaned-extensions
407 (map (lambda (ext)
408 (if (procedure? ext)
409 (begin
410 (warning (G_ "'pam-root-service-type' extensions should \
411now use the <pam-extension> record~%"))
412 (pam-extension (transformer ext)))
413 ext))
414 extensions))
415
416 (let-values (((services pam-extensions)
417 (partition pam-service? cleaned-extensions)))
418 (pam-configuration
419 (services (append (pam-configuration-services initial)
420 services))
421 (transformers (append (pam-configuration-transformers initial)
422 (map pam-extension-transformer pam-extensions)))
423 (shepherd-requirements
424 (append (pam-configuration-shepherd-requirements initial)
425 (append-map pam-extension-shepherd-requirements pam-extensions))))))
426
427(define pam-root-service-type
428 (service-type (name 'pam)
429 (extensions
430 (list (service-extension
431 privileged-program-service-type
432 (lambda (_)
433 (list (file-like->setuid-program
434 (file-append linux-pam "/sbin/unix_chkpwd")))))
435 (service-extension etc-service-type /etc-entry)
436 (service-extension shepherd-root-service-type
437 pam-shepherd-service)))
438
439 ;; Arguments include <pam-service> as well as procedures.
440 (compose concatenate)
441 (extend extend-configuration)
442 (description
443 "Configure the Pluggable Authentication Modules (PAM) for all
444the specified @dfn{PAM services}. Each PAM service corresponds to a program,
445such as @command{login} or @command{sshd}, and specifies for instance how the
446program may authenticate users or what it should do when opening a new
447session.")))
448
449(define* (pam-root-service base #:key (transformers '()) (shepherd-requirements '()))
450 "The \"root\" PAM service, which collects <pam-service> instance and turns
451them into a /etc/pam.d directory, including the <pam-service> listed in BASE.
452TRANSFORM is a procedure that takes a <pam-service> and returns a
453<pam-service>. It can be used to implement cross-cutting concerns that affect
454all the PAM services."
455 (service pam-root-service-type
456 (pam-configuration (services base)
457 (transformers transformers)
458 (shepherd-requirements shepherd-requirements))))