Commit | Line | Data |
---|---|---|
859e367d JD |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2016 John Darrington <jmd@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 services kerberos) | |
859e367d | 20 | #:use-module (gnu services) |
8e3f813f | 21 | #:use-module (gnu services configuration) |
859e367d JD |
22 | #:use-module (gnu system pam) |
23 | #:use-module (guix gexp) | |
24 | #:use-module (guix records) | |
8e3f813f JD |
25 | #:use-module (srfi srfi-1) |
26 | #:use-module (srfi srfi-34) | |
27 | #:use-module (srfi srfi-35) | |
28 | #:use-module (ice-9 match) | |
859e367d JD |
29 | #:export (pam-krb5-configuration |
30 | pam-krb5-configuration? | |
8e3f813f JD |
31 | pam-krb5-service-type |
32 | ||
33 | krb5-realm | |
34 | krb5-realm? | |
35 | ||
36 | krb5-configuration | |
37 | krb5-configuration? | |
38 | krb5-service-type)) | |
39 | ||
40 | \f | |
41 | ||
42 | (define unset-field (list 'unset-field)) | |
43 | ||
44 | (define (predicate/unset pred) | |
45 | (lambda (x) (or (eq? x unset-field) (pred x)))) | |
46 | ||
47 | (define string/unset? (predicate/unset string?)) | |
48 | (define boolean/unset? (predicate/unset boolean?)) | |
49 | (define integer/unset? (predicate/unset integer?)) | |
50 | ||
51 | (define (uglify-field-name field-name) | |
52 | "Return FIELD-NAME with all instances of '-' replaced by '_' and any | |
53 | trailing '?' removed." | |
54 | (let ((str (symbol->string field-name))) | |
55 | (string-join (string-split (if (string-suffix? "?" str) | |
56 | (substring str 0 (1- (string-length str))) | |
57 | str) | |
58 | #\-) | |
59 | "_"))) | |
60 | ||
61 | (define (serialize-field* field-name val) | |
62 | (format #t "~a = ~a\n" (uglify-field-name field-name) val)) | |
63 | ||
64 | (define (serialize-string/unset field-name val) | |
65 | (unless (eq? val unset-field) | |
66 | (serialize-field* field-name val))) | |
67 | ||
68 | (define (serialize-integer/unset field-name val) | |
69 | (unless (eq? val unset-field) | |
70 | (serialize-field* field-name val))) | |
71 | ||
72 | (define (serialize-boolean/unset field-name val) | |
73 | (unless (eq? val unset-field) | |
74 | (serialize-field* field-name | |
75 | (if val "true" "false")))) | |
76 | ||
77 | ||
78 | ;; An end-point is an address such as "192.168.0.1" | |
79 | ;; or an address port pair ("foobar.example.com" . 109) | |
80 | (define (end-point? val) | |
81 | (match val | |
82 | ((? string?) #t) | |
83 | (((? string?) . (? integer?)) #t) | |
84 | (_ #f))) | |
85 | ||
86 | (define (serialize-end-point field-name val) | |
87 | (serialize-field* field-name | |
88 | (match val | |
89 | ((host . port) | |
90 | ;; The [] are needed in the case of IPv6 addresses | |
91 | (format #f "[~a]:~a" host port)) | |
92 | (host | |
93 | (format #f "~a" host))))) | |
94 | ||
95 | (define (serialize-space-separated-string-list/unset field-name val) | |
96 | (unless (eq? val unset-field) | |
97 | (serialize-field* field-name (string-join val " ")))) | |
98 | ||
720cb10c CL |
99 | (define (space-separated-string-list? val) |
100 | (and (list? val) | |
101 | (and-map (lambda (x) | |
102 | (and (string? x) (not (string-index x #\space)))) | |
103 | val))) | |
104 | ||
8e3f813f JD |
105 | (define space-separated-string-list/unset? |
106 | (predicate/unset space-separated-string-list?)) | |
107 | ||
108 | (define comma-separated-integer-list/unset? | |
109 | (predicate/unset (lambda (val) | |
110 | (and (list? val) | |
111 | (and-map (lambda (x) (integer? x)) | |
112 | val))))) | |
113 | ||
114 | (define (serialize-comma-separated-integer-list/unset field-name val) | |
115 | (unless (eq? val unset-field) | |
116 | (serialize-field* field-name | |
117 | (string-drop ; Drop the leading comma | |
118 | (fold | |
119 | (lambda (i prev) | |
120 | (string-append prev "," (number->string i))) | |
121 | "" val) 1)))) | |
122 | ||
123 | (define file-name? (predicate/unset | |
124 | (lambda (val) | |
125 | (string-prefix? "/" val)))) | |
126 | ||
720cb10c CL |
127 | (define (serialize-field field-name val) |
128 | (format #t "~a ~a\n" (uglify-field-name field-name) val)) | |
129 | ||
130 | (define (serialize-string field-name val) | |
131 | (serialize-field field-name val)) | |
132 | ||
8e3f813f JD |
133 | (define (serialize-file-name field-name val) |
134 | (unless (eq? val unset-field) | |
135 | (serialize-string field-name val))) | |
136 | ||
720cb10c CL |
137 | (define (serialize-space-separated-string-list field-name val) |
138 | (serialize-field field-name (string-join val " "))) | |
139 | ||
8e3f813f JD |
140 | (define (non-negative-integer? val) |
141 | (and (exact-integer? val) (not (negative? val)))) | |
142 | ||
143 | (define (serialize-non-negative-integer/unset field-name val) | |
144 | (unless (eq? val unset-field) | |
145 | (serialize-field* field-name val))) | |
146 | ||
147 | (define (free-form-fields? val) | |
148 | (match val | |
149 | (() #t) | |
150 | ((((? symbol?) . (? string)) . val) (free-form-fields? val)) | |
151 | (_ #f))) | |
152 | ||
153 | (define (serialize-free-form-fields field-name val) | |
154 | (for-each (match-lambda ((k . v) (serialize-field* k v))) val)) | |
155 | ||
156 | (define non-negative-integer/unset? (predicate/unset non-negative-integer?)) | |
157 | ||
158 | (define (realm-list? val) | |
159 | (and (list? val) | |
160 | (and-map (lambda (x) (krb5-realm? x)) val))) | |
161 | ||
162 | (define (serialize-realm-list field-name val) | |
163 | (format #t "\n[~a]\n" field-name) | |
164 | (for-each (lambda (realm) | |
165 | (format #t "\n~a = {\n" (krb5-realm-name realm)) | |
166 | (for-each (lambda (field) | |
167 | (unless (eq? 'name (configuration-field-name field)) | |
168 | ((configuration-field-serializer field) | |
169 | (configuration-field-name field) | |
170 | ((configuration-field-getter field) | |
171 | realm)))) krb5-realm-fields) | |
172 | ||
173 | (format #t "}\n")) val)) | |
174 | ||
175 | \f | |
176 | ||
177 | ;; For a more detailed explanation of these fields see man 5 krb5.conf | |
178 | (define-configuration krb5-realm | |
179 | (name | |
180 | (string/unset unset-field) | |
181 | "The name of the realm.") | |
182 | ||
183 | (kdc | |
184 | (end-point unset-field) | |
185 | "The host and port on which the realm's Key Distribution Server listens.") | |
186 | ||
187 | (admin-server | |
188 | (string/unset unset-field) | |
189 | "The Host running the administration server for the realm.") | |
190 | ||
191 | (master-kdc | |
192 | (string/unset unset-field) | |
193 | "If an attempt to get credentials fails because of an invalid password, | |
194 | the client software will attempt to contact the master KDC.") | |
195 | ||
196 | (kpasswd-server | |
197 | (string/unset unset-field) | |
198 | "The server where password changes are performed.") | |
199 | ||
200 | (auth-to-local | |
201 | (free-form-fields '()) | |
202 | "Rules to map between principals and local users.") | |
203 | ||
204 | (auth-to-local-names | |
205 | (free-form-fields '()) | |
206 | "Explicit mappings between principal names and local user names.") | |
207 | ||
208 | (http-anchors | |
209 | (free-form-fields '()) | |
210 | "Useful only when http proxy is used to access KDC or KPASSWD.") | |
211 | ||
212 | ;; The following are useful only for working with V4 services | |
213 | (default-domain | |
214 | (string/unset unset-field) | |
215 | "The domain used to expand host names when translating Kerberos 4 service | |
216 | principals to Kerberos 5 principals") | |
217 | ||
218 | (v4-instance-convert | |
219 | (free-form-fields '()) | |
220 | "Exceptions to the default-domain mapping rule.") | |
221 | ||
222 | (v4-realm | |
223 | (string/unset unset-field) | |
224 | "Used when the V4 realm name and the V5 realm name are not the same, but | |
225 | still share the same principal names and passwords")) | |
226 | ||
227 | ||
228 | ||
229 | ;; For a more detailed explanation of these fields see man 5 krb5.conf | |
230 | (define-configuration krb5-configuration | |
231 | (allow-weak-crypto? | |
232 | (boolean/unset unset-field) | |
233 | "If true, permits access to services which only offer weak encryption.") | |
234 | ||
235 | (ap-req-checksum-type | |
236 | (non-negative-integer/unset unset-field) | |
237 | "The type of the AP-REQ checksum.") | |
238 | ||
239 | (canonicalize? | |
240 | (boolean/unset unset-field) | |
241 | "Should principals in initial ticket requests be canonicalized?") | |
242 | ||
243 | (ccache-type | |
244 | (non-negative-integer/unset unset-field) | |
245 | "The format of the credential cache type.") | |
246 | ||
247 | (clockskew | |
248 | (non-negative-integer/unset unset-field) | |
249 | "Maximum allowable clock skew in seconds (default 300).") | |
250 | ||
251 | (default-ccache-name | |
252 | (file-name unset-field) | |
253 | "The name of the default credential cache.") | |
254 | ||
255 | (default-client-keytab-name | |
256 | (file-name unset-field) | |
257 | "The name of the default keytab for client credentials.") | |
258 | ||
259 | (default-keytab-name | |
260 | (file-name unset-field) | |
261 | "The name of the default keytab file.") | |
262 | ||
263 | (default-realm | |
264 | (string/unset unset-field) | |
265 | "The realm to be accessed if not explicitly specified by clients.") | |
266 | ||
267 | (default-tgs-enctypes | |
268 | (free-form-fields '()) | |
269 | "Session key encryption types when making TGS-REQ requests.") | |
270 | ||
271 | (default-tkt-enctypes | |
272 | (free-form-fields '()) | |
273 | "Session key encryption types when making AS-REQ requests.") | |
274 | ||
275 | (dns-canonicalize-hostname? | |
276 | (boolean/unset unset-field) | |
277 | "Whether name lookups will be used to canonicalize host names for use in | |
278 | service principal names.") | |
279 | ||
280 | (dns-lookup-kdc? | |
281 | (boolean/unset unset-field) | |
282 | "Should DNS SRV records should be used to locate the KDCs and other servers | |
283 | not appearing in the realm specification") | |
284 | ||
285 | (err-fmt | |
286 | (string/unset unset-field) | |
287 | "Custom error message formatting. If not #f error messages will be formatted | |
288 | by substituting a normal error message for %M and an error code for %C in the | |
289 | value.") | |
290 | ||
291 | (forwardable? | |
292 | (boolean/unset unset-field) | |
293 | "Should initial tickets be forwardable by default?") | |
294 | ||
295 | (ignore-acceptor-hostname? | |
296 | (boolean/unset unset-field) | |
297 | "When accepting GSSAPI or krb5 security contexts for host-based service | |
298 | principals, ignore any hostname passed by the calling application, and allow | |
299 | clients to authenticate to any service principal in the keytab matching the | |
300 | service name and realm name.") | |
301 | ||
302 | (k5login-authoritative? | |
303 | (boolean/unset unset-field) | |
304 | "If this flag is true, principals must be listed in a local user's k5login | |
305 | file to be granted login access, if a ~/.k5login file exists.") | |
306 | ||
307 | (k5login-directory | |
308 | (string/unset unset-field) | |
309 | "If not #f, the library will look for a local user's @file{k5login} file | |
310 | within the named directory (instead of the user's home directory), with a | |
311 | file name corresponding to the local user name.") | |
312 | ||
313 | (kcm-mach-service | |
314 | (string/unset unset-field) | |
315 | "The name of the bootstrap service used to contact the KCM daemon for the | |
316 | KCM credential cache type.") | |
317 | ||
318 | (kcm-socket | |
319 | (file-name unset-field) | |
320 | "Path to the Unix domain socket used to access the KCM daemon for the KCM | |
321 | credential cache type.") | |
322 | ||
323 | (kdc-default-options | |
324 | (non-negative-integer/unset unset-field) | |
325 | "Default KDC options (logored for multiple values) when requesting initial | |
326 | tickets.") | |
327 | ||
328 | (kdc-timesync | |
329 | (non-negative-integer/unset unset-field) | |
330 | "Attempt to compensate for clock skew between the KDC and client.") | |
331 | ||
332 | (kdc-req-checksum-type | |
333 | (non-negative-integer/unset unset-field) | |
334 | "The type of checksum to use for the KDC requests. Relevant only for DES | |
335 | keys") | |
336 | ||
337 | (noaddresses? | |
338 | (boolean/unset unset-field) | |
339 | "If true, initial ticket requests will not be made with address restrictions. | |
340 | This enables their use across NATs.") | |
341 | ||
342 | (permitted-enctypes | |
343 | (space-separated-string-list/unset unset-field) | |
344 | "All encryption types that are permitted for use in session key encryption.") | |
345 | ||
346 | (plugin-base-dir | |
347 | (file-name unset-field) | |
348 | "The directory where krb5 plugins are located.") | |
349 | ||
350 | (preferred-preauth-types | |
351 | (comma-separated-integer-list/unset unset-field) | |
352 | "The preferred pre-authentication types which the client will attempt before | |
353 | others.") | |
354 | ||
355 | (proxiable? | |
356 | (boolean/unset unset-field) | |
357 | "Should initial tickets be proxiable by default?") | |
358 | ||
359 | (rdns? | |
360 | (boolean/unset unset-field) | |
361 | "Should reverse DNS lookup be used in addition to forward name lookup to | |
362 | canonicalize host names for use in service principal names.") | |
363 | ||
364 | (realm-try-domains | |
365 | (integer/unset unset-field) | |
366 | "Should a host's domain components should be used to determine the Kerberos | |
367 | realm of the host.") | |
368 | ||
369 | (renew-lifetime | |
370 | (non-negative-integer/unset unset-field) | |
371 | "The default renewable lifetime for initial ticket requests.") | |
372 | ||
373 | (safe-checksum-type | |
374 | (non-negative-integer/unset unset-field) | |
375 | "The type of checksum to use for the KRB-SAFE requests.") | |
376 | ||
377 | (ticket-lifetime | |
378 | (non-negative-integer/unset unset-field) | |
379 | "The default lifetime for initial ticket requests.") | |
380 | ||
381 | (udp-preference-limit | |
382 | (non-negative-integer/unset unset-field) | |
383 | "When sending messages to the KDC, the library will try using TCP | |
384 | before UDP if the size of the message greater than this limit.") | |
385 | ||
386 | (verify-ap-rereq-nofail? | |
387 | (boolean/unset unset-field) | |
388 | "If true, then attempts to verify initial credentials will fail if the client | |
389 | machine does not have a keytab.") | |
390 | ||
391 | (realms | |
392 | (realm-list '()) | |
393 | "The list of realms which clients may access.")) | |
394 | ||
395 | ||
396 | (define (krb5-configuration-file config) | |
397 | "Create a Kerberos 5 configuration file based on CONFIG" | |
398 | (mixed-text-file "krb5.conf" | |
399 | "[libdefaults]\n\n" | |
400 | (with-output-to-string | |
401 | (lambda () | |
402 | (serialize-configuration config | |
403 | krb5-configuration-fields))))) | |
404 | ||
405 | (define (krb5-etc-service config) | |
406 | (list `("krb5.conf" ,(krb5-configuration-file config)))) | |
407 | ||
408 | ||
409 | (define krb5-service-type | |
410 | (service-type (name 'krb5) | |
411 | (extensions | |
412 | (list (service-extension etc-service-type | |
413 | krb5-etc-service))))) | |
414 | ||
415 | ||
416 | \f | |
859e367d JD |
417 | |
418 | (define-record-type* <pam-krb5-configuration> | |
419 | pam-krb5-configuration make-pam-krb5-configuration | |
420 | pam-krb5-configuration? | |
421 | (pam-krb5 pam-krb5-configuration-pam-krb5 | |
422 | (default pam-krb5)) | |
423 | (minimum-uid pam-krb5-configuration-minimum-uid | |
424 | (default 1000))) | |
425 | ||
426 | (define (pam-krb5-pam-service config) | |
427 | "Return a PAM service for Kerberos authentication." | |
428 | (lambda (pam) | |
429 | (define pam-krb5-module | |
fc5dc4e8 JD |
430 | #~(string-append #$(pam-krb5-configuration-pam-krb5 config) |
431 | "/lib/security/pam_krb5.so")) | |
859e367d JD |
432 | |
433 | (let ((pam-krb5-sufficient | |
434 | (pam-entry | |
435 | (control "sufficient") | |
436 | (module pam-krb5-module) | |
fc5dc4e8 JD |
437 | (arguments |
438 | (list | |
439 | (format #f "minimum_uid=~a" | |
440 | (pam-krb5-configuration-minimum-uid config))))))) | |
859e367d JD |
441 | (pam-service |
442 | (inherit pam) | |
443 | (auth (cons* pam-krb5-sufficient | |
444 | (pam-service-auth pam))) | |
445 | (session (cons* pam-krb5-sufficient | |
446 | (pam-service-session pam))) | |
447 | (account (cons* pam-krb5-sufficient | |
448 | (pam-service-account pam))))))) | |
449 | ||
450 | (define (pam-krb5-pam-services config) | |
451 | (list (pam-krb5-pam-service config))) | |
452 | ||
453 | (define pam-krb5-service-type | |
454 | (service-type (name 'pam-krb5) | |
455 | (extensions | |
456 | (list | |
457 | (service-extension pam-root-service-type | |
458 | pam-krb5-pam-services))))) |