1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
19 (define-module (gnu system pam)
20 #:use-module (guix records)
21 #:use-module (guix derivations)
22 #:use-module (guix gexp)
23 #:use-module (gnu services)
24 #:use-module (ice-9 match)
25 #:use-module (srfi srfi-1)
26 #:use-module (srfi srfi-9)
27 #:use-module (srfi srfi-11)
28 #:use-module (srfi srfi-26)
29 #:use-module ((guix utils) #:select (%current-system))
43 pam-limits-entry-domain
46 pam-limits-entry-value
47 pam-limits-entry->string
49 pam-services->directory
53 session-environment-service
54 session-environment-service-type
61 ;;; Configuration of the pluggable authentication modules (PAM).
66 ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
67 (define-record-type* <pam-service> pam-service
70 (name pam-service-name) ; string
72 ;; The four "management groups".
73 (account pam-service-account ; list of <pam-entry>
75 (auth pam-service-auth
77 (password pam-service-password
79 (session pam-service-session
82 (define-record-type* <pam-entry> pam-entry
85 (control pam-entry-control) ; string
86 (module pam-entry-module) ; file name
87 (arguments pam-entry-arguments ; list of string-valued g-expressions
90 ;; PAM limits entries are used by the pam_limits PAM module to set or override
91 ;; limits on system resources for user sessions. The format is specified
92 ;; here: http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html
93 (define-record-type <pam-limits-entry>
94 (make-pam-limits-entry domain type item value)
96 (domain pam-limits-entry-domain) ; string
97 (type pam-limits-entry-type) ; symbol
98 (item pam-limits-entry-item) ; symbol
99 (value pam-limits-entry-value)) ; symbol or number
101 (define (pam-limits-entry domain type item value)
102 "Construct a pam-limits-entry ensuring that the provided values are valid."
103 (define (valid? value)
105 ((priority) (number? value))
106 ((nice) (and (number? value)
109 (else (or (and (number? value)
111 (member value '(unlimited infinity))))))
113 (list 'core 'data 'fsize
114 'memlock 'nofile 'rss
116 'as 'maxlogins 'maxsyslogins
117 'priority 'locks 'sigpending
118 'msgqueue 'nice 'rtprio))
119 (when (not (member type '(hard soft both)))
120 (error "invalid limit type" type))
121 (when (not (member item items))
122 (error "invalid limit item" item))
123 (when (not (valid? value))
124 (error "invalid limit value" value))
125 (make-pam-limits-entry domain type item value))
127 (define (pam-limits-entry->string entry)
128 "Convert a pam-limits-entry record to a string."
130 (($ <pam-limits-entry> domain type item value)
131 (string-join (list domain
134 (symbol->string type))
135 (symbol->string item)
138 (symbol->string value))
140 (number->string value))))
143 (define (pam-service->configuration service)
144 "Return the derivation building the configuration file for SERVICE, to be
145 dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
146 (define (entry->gexp type entry)
148 (($ <pam-entry> control module (arguments ...))
149 #~(format #t "~a ~a ~a ~a~%"
150 #$type #$control #$module
151 (string-join (list #$@arguments))))))
154 (($ <pam-service> name account auth password session)
157 (with-output-to-file #$output
159 #$@(append (map (cut entry->gexp "account" <>) account)
160 (map (cut entry->gexp "auth" <>) auth)
161 (map (cut entry->gexp "password" <>) password)
162 (map (cut entry->gexp "session" <>) session))
165 (computed-file name builder))))
167 (define (pam-services->directory services)
168 "Return the derivation to build the configuration directory to be used as
169 /etc/pam.d for SERVICES."
170 (let ((names (map pam-service-name services))
171 (files (map pam-service->configuration services)))
174 (use-modules (ice-9 match)
178 (for-each (match-lambda
180 (symlink file (string-append #$output "/" name))))
182 ;; Since <pam-service> objects cannot be compared with
183 ;; 'equal?' since they contain gexps, which contain
184 ;; closures, use 'delete-duplicates' on the build-side
185 ;; instead. See <http://bugs.gnu.org/20037>.
186 (delete-duplicates '#$(zip names files)))))
188 (computed-file "pam.d" builder)))
190 (define %pam-other-services
191 ;; The "other" PAM configuration, which denies everything (see
192 ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
193 (let ((deny (pam-entry
195 (module "pam_deny.so"))))
198 (account (list deny))
200 (password (list deny))
201 (session (list deny)))))
203 (define unix-pam-service
204 (let ((unix (pam-entry
206 (module "pam_unix.so")))
207 (env (pam-entry ; to honor /etc/environment.
209 (module "pam_env.so"))))
210 (lambda* (name #:key allow-empty-passwords? (allow-root? #f) motd)
211 "Return a standard Unix-style PAM service for NAME. When
212 ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When ALLOW-ROOT? is
213 true, allow root to run the command without authentication. When MOTD is
214 true, it should be a file-like object used as the message-of-the-day."
215 ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
219 (account (list unix))
220 (auth (append (if allow-root?
222 (control "sufficient")
223 (module "pam_rootok.so")))
225 (list (if allow-empty-passwords?
228 (module "pam_unix.so")
229 (arguments '("nullok")))
231 (password (list (pam-entry
233 (module "pam_unix.so")
234 ;; Store SHA-512 encrypted passwords in /etc/shadow.
235 (arguments '("sha512" "shadow")))))
240 (module "pam_motd.so")
242 (list #~(string-append "motd=" #$motd)))))
243 (list env unix))))))))
245 (define (rootok-pam-service command)
246 "Return a PAM service for COMMAND such that 'root' does not need to
247 authenticate to run COMMAND."
248 (let ((unix (pam-entry
250 (module "pam_unix.so"))))
253 (account (list unix))
254 (auth (list (pam-entry
255 (control "sufficient")
256 (module "pam_rootok.so"))))
257 (password (list unix))
258 (session (list unix)))))
260 (define* (base-pam-services #:key allow-empty-passwords?)
261 "Return the list of basic PAM services everyone would want."
262 ;; TODO: Add other Shadow programs?
263 (append (list %pam-other-services)
265 ;; These programs are setuid-root.
266 (map (cut unix-pam-service <>
267 #:allow-empty-passwords? allow-empty-passwords?)
269 ;; This is setuid-root, as well. Allow root to run "su" without
271 (list (unix-pam-service "su"
272 #:allow-empty-passwords? allow-empty-passwords?
275 ;; These programs are not setuid-root, and we want root to be able
276 ;; to run them without having to authenticate (notably because
277 ;; 'useradd' and 'groupadd' are run during system activation.)
278 (map rootok-pam-service
279 '("useradd" "userdel" "usermod"
280 "groupadd" "groupdel" "groupmod"))))
284 ;;; System-wide environment variables.
287 (define (environment-variables->environment-file vars)
288 "Return a file for pam_env(8) that contains environment variables VARS."
289 (apply mixed-text-file "environment"
290 (append-map (match-lambda
292 (list key "=" value "\n")))
295 (define session-environment-service-type
297 (name 'session-environment)
299 (list (service-extension
302 (list `("environment"
303 ,(environment-variables->environment-file vars)))))))
304 (compose concatenate)
307 "Populate @file{/etc/environment}, which is honored by @code{pam_env},
308 with the specified environment variables. The value of this service is a list
309 of name/value pairs for environments variables, such as:
312 '((\"TZ\" . \"Canada/Pacific\"))
315 (define (session-environment-service vars)
316 "Return a service that builds the @file{/etc/environment}, which can be read
317 by PAM-aware applications to set environment variables for sessions.
319 VARS should be an association list in which both the keys and the values are
320 strings or string-valued gexps."
321 (service session-environment-service-type vars))
326 ;;; PAM root service.
329 ;; Overall PAM configuration: a list of services, plus a procedure that takes
330 ;; one <pam-service> and returns a <pam-service>. The procedure is used to
331 ;; implement cross-cutting concerns such as the use of the 'elogind.so'
332 ;; session module that keeps track of logged-in users.
333 (define-record-type* <pam-configuration>
334 pam-configuration make-pam-configuration? pam-configuration?
335 (services pam-configuration-services) ;list of <pam-service>
336 (transform pam-configuration-transform)) ;procedure
338 (define (/etc-entry config)
339 "Return the /etc/pam.d entry corresponding to CONFIG."
341 (($ <pam-configuration> services transform)
342 (let ((services (map transform services)))
343 `(("pam.d" ,(pam-services->directory services)))))))
345 (define (extend-configuration initial extensions)
346 "Extend INITIAL with NEW."
347 (let-values (((services procs)
348 (partition pam-service? extensions)))
350 (services (append (pam-configuration-services initial)
352 (transform (apply compose
353 (pam-configuration-transform initial)
356 (define pam-root-service-type
357 (service-type (name 'pam)
358 (extensions (list (service-extension etc-service-type
361 ;; Arguments include <pam-service> as well as procedures.
362 (compose concatenate)
363 (extend extend-configuration)))
365 (define* (pam-root-service base #:key (transform identity))
366 "The \"root\" PAM service, which collects <pam-service> instance and turns
367 them into a /etc/pam.d directory, including the <pam-service> listed in BASE.
368 TRANSFORM is a procedure that takes a <pam-service> and returns a
369 <pam-service>. It can be used to implement cross-cutting concerns that affect
370 all the PAM services."
371 (service pam-root-service-type
372 (pam-configuration (services base)
373 (transform transform))))