Commit | Line | Data |
---|---|---|
f2ec23d1 AW |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2016 Andy Wingo <wingo@pobox.com> | |
e57bd0be | 3 | ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> |
86cd3f97 | 4 | ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> |
36273ebd | 5 | ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com> |
f9c1ebdb | 6 | ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr> |
520bac7e | 7 | ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> |
f2ec23d1 AW |
8 | ;;; |
9 | ;;; This file is part of GNU Guix. | |
10 | ;;; | |
11 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
12 | ;;; under the terms of the GNU General Public License as published by | |
13 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
14 | ;;; your option) any later version. | |
15 | ;;; | |
16 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
17 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;;; GNU General Public License for more details. | |
20 | ;;; | |
21 | ;;; You should have received a copy of the GNU General Public License | |
22 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
23 | ||
24 | (define-module (gnu services cups) | |
25 | #:use-module (gnu services) | |
26 | #:use-module (gnu services shepherd) | |
5305ed20 | 27 | #:use-module (gnu services configuration) |
f2ec23d1 AW |
28 | #:use-module (gnu system shadow) |
29 | #:use-module (gnu packages admin) | |
30 | #:use-module (gnu packages cups) | |
31 | #:use-module (gnu packages tls) | |
32 | #:use-module (guix packages) | |
33 | #:use-module (guix records) | |
34 | #:use-module (guix gexp) | |
520bac7e | 35 | #:use-module (guix modules) |
f2ec23d1 | 36 | #:use-module (ice-9 match) |
476b333f | 37 | #:use-module ((srfi srfi-1) #:select (append-map find)) |
5305ed20 | 38 | #:export (cups-service-type |
f2ec23d1 AW |
39 | cups-configuration |
40 | opaque-cups-configuration | |
41 | ||
42 | files-configuration | |
43 | policy-configuration | |
44 | location-access-control | |
45 | operation-access-control | |
46 | method-access-control)) | |
47 | ||
48 | ;;; Commentary: | |
49 | ;;; | |
50 | ;;; Service defininition for the CUPS printing system. | |
51 | ;;; | |
52 | ;;; Code: | |
53 | ||
f2ec23d1 | 54 | (define %cups-accounts |
476b333f LP |
55 | (list (or |
56 | ;; The "lp" group should already exist; try to reuse it. | |
57 | (find (lambda (group) | |
58 | (and (user-group? group) | |
59 | (string=? (user-group-name group) "lp"))) | |
60 | %base-groups) | |
61 | (user-group (name "lp") (system? #t))) | |
f2ec23d1 AW |
62 | (user-group (name "lpadmin") (system? #t)) |
63 | (user-account | |
64 | (name "lp") | |
65 | (group "lp") | |
66 | (system? #t) | |
67 | (comment "System user for invoking printing helper programs") | |
68 | (home-directory "/var/empty") | |
69 | (shell (file-append shadow "/sbin/nologin"))))) | |
70 | ||
720cb10c CL |
71 | (define (uglify-field-name field-name) |
72 | (let ((str (symbol->string field-name))) | |
73 | (string-concatenate | |
74 | (map string-titlecase | |
75 | (string-split (if (string-suffix? "?" str) | |
76 | (substring str 0 (1- (string-length str))) | |
77 | str) | |
78 | #\-))))) | |
79 | ||
80 | (define (serialize-field field-name val) | |
81 | (format #t "~a ~a\n" (uglify-field-name field-name) val)) | |
82 | ||
83 | (define (serialize-string field-name val) | |
84 | (serialize-field field-name val)) | |
85 | ||
f2ec23d1 AW |
86 | (define (multiline-string-list? val) |
87 | (and (list? val) | |
88 | (and-map (lambda (x) | |
89 | (and (string? x) (not (string-index x #\space)))) | |
90 | val))) | |
91 | (define (serialize-multiline-string-list field-name val) | |
92 | (for-each (lambda (str) (serialize-field field-name str)) val)) | |
93 | ||
ee0de994 TGR |
94 | (define (comma-separated-string-list? val) |
95 | (and (list? val) | |
96 | (and-map (lambda (x) | |
97 | (and (string? x) (not (string-index x #\,)))) | |
98 | val))) | |
99 | (define (serialize-comma-separated-string-list field-name val) | |
100 | (serialize-field field-name (string-join val ","))) | |
101 | ||
720cb10c CL |
102 | (define (space-separated-string-list? val) |
103 | (and (list? val) | |
104 | (and-map (lambda (x) | |
105 | (and (string? x) (not (string-index x #\space)))) | |
106 | val))) | |
107 | (define (serialize-space-separated-string-list field-name val) | |
108 | (serialize-field field-name (string-join val " "))) | |
109 | ||
f2ec23d1 AW |
110 | (define (space-separated-symbol-list? val) |
111 | (and (list? val) (and-map symbol? val))) | |
112 | (define (serialize-space-separated-symbol-list field-name val) | |
113 | (serialize-field field-name (string-join (map symbol->string val) " "))) | |
114 | ||
720cb10c CL |
115 | (define (file-name? val) |
116 | (and (string? val) | |
117 | (string-prefix? "/" val))) | |
118 | (define (serialize-file-name field-name val) | |
119 | (serialize-string field-name val)) | |
120 | ||
121 | (define (serialize-boolean field-name val) | |
122 | (serialize-string field-name (if val "yes" "no"))) | |
123 | ||
f2ec23d1 AW |
124 | (define (non-negative-integer? val) |
125 | (and (exact-integer? val) (not (negative? val)))) | |
126 | (define (serialize-non-negative-integer field-name val) | |
127 | (serialize-field field-name val)) | |
128 | ||
129 | (define-syntax define-enumerated-field-type | |
130 | (lambda (x) | |
131 | (define (id-append ctx . parts) | |
132 | (datum->syntax ctx (apply symbol-append (map syntax->datum parts)))) | |
133 | (syntax-case x () | |
134 | ((_ name (option ...)) | |
135 | #`(begin | |
136 | (define (#,(id-append #'name #'name #'?) x) | |
137 | (memq x '(option ...))) | |
138 | (define (#,(id-append #'name #'serialize- #'name) field-name val) | |
139 | (serialize-field field-name val))))))) | |
140 | ||
141 | (define-enumerated-field-type access-log-level | |
142 | (config actions all)) | |
143 | (define-enumerated-field-type browse-local-protocols | |
144 | (all dnssd none)) | |
145 | (define-enumerated-field-type default-auth-type | |
146 | (Basic Negotiate)) | |
147 | (define-enumerated-field-type default-encryption | |
148 | (Never IfRequested Required)) | |
149 | (define-enumerated-field-type error-policy | |
5a097cdd | 150 | (abort-job retry-job retry-current-job stop-printer)) |
f2ec23d1 AW |
151 | (define-enumerated-field-type log-level |
152 | (none emerg alert crit error warn notice info debug debug2)) | |
153 | (define-enumerated-field-type log-time-format | |
154 | (standard usecs)) | |
155 | (define-enumerated-field-type server-tokens | |
156 | (None ProductOnly Major Minor Minimal OS Full)) | |
157 | (define-enumerated-field-type method | |
158 | (DELETE GET HEAD OPTIONS POST PUT TRACE)) | |
159 | (define-enumerated-field-type sandboxing | |
160 | (relaxed strict)) | |
161 | ||
162 | (define (method-list? val) | |
163 | (and (list? val) (and-map method? val))) | |
164 | (define (serialize-method-list field-name val) | |
165 | (serialize-field field-name (string-join (map symbol->string val) " "))) | |
166 | ||
167 | (define (host-name-lookups? val) | |
168 | (memq val '(#f #t 'double))) | |
169 | (define (serialize-host-name-lookups field-name val) | |
170 | (serialize-field field-name | |
171 | (match val (#f "No") (#t "Yes") ('double "Double")))) | |
172 | ||
173 | (define (host-name-list-or-*? x) | |
174 | (or (eq? x '*) | |
175 | (and (list? x) (and-map string? x)))) | |
176 | (define (serialize-host-name-list-or-* field-name val) | |
177 | (serialize-field field-name (match val | |
178 | ('* '*) | |
179 | (names (string-join names " "))))) | |
180 | ||
181 | (define (boolean-or-non-negative-integer? x) | |
182 | (or (boolean? x) (non-negative-integer? x))) | |
183 | (define (serialize-boolean-or-non-negative-integer field-name x) | |
184 | (if (boolean? x) | |
185 | (serialize-boolean field-name x) | |
186 | (serialize-non-negative-integer field-name x))) | |
187 | ||
188 | (define (ssl-options? x) | |
189 | (and (list? x) | |
f9c1ebdb TGR |
190 | (and-map (lambda (elt) (memq elt '(AllowRC4 |
191 | AllowSSL3 | |
192 | DenyCBC | |
193 | DenyTLS1.0))) x))) | |
f2ec23d1 AW |
194 | (define (serialize-ssl-options field-name val) |
195 | (serialize-field field-name | |
196 | (match val | |
197 | (() "None") | |
198 | (opts (string-join (map symbol->string opts) " "))))) | |
199 | ||
200 | (define (serialize-access-control x) | |
201 | (display x) | |
202 | (newline)) | |
203 | (define (serialize-access-control-list field-name val) | |
204 | (for-each serialize-access-control val)) | |
205 | (define (access-control-list? val) | |
206 | (and (list? val) (and-map string? val))) | |
207 | ||
208 | (define-configuration operation-access-control | |
209 | (operations | |
210 | (space-separated-symbol-list '()) | |
211 | "IPP operations to which this access control applies.") | |
212 | (access-controls | |
213 | (access-control-list '()) | |
214 | "Access control directives, as a list of strings. Each string should be one directive, such as \"Order allow,deny\".")) | |
215 | ||
216 | (define-configuration method-access-control | |
217 | (reverse? | |
218 | (boolean #f) | |
219 | "If @code{#t}, apply access controls to all methods except the listed | |
220 | methods. Otherwise apply to only the listed methods.") | |
221 | (methods | |
222 | (method-list '()) | |
223 | "Methods to which this access control applies.") | |
224 | (access-controls | |
225 | (access-control-list '()) | |
226 | "Access control directives, as a list of strings. Each string should be one directive, such as \"Order allow,deny\".")) | |
227 | ||
228 | (define (serialize-operation-access-control x) | |
229 | (format #t "<Limit ~a>\n" | |
230 | (string-join (map symbol->string | |
231 | (operation-access-control-operations x)) " ")) | |
232 | (serialize-configuration | |
233 | x | |
234 | (filter (lambda (field) | |
235 | (not (eq? (configuration-field-name field) 'operations))) | |
236 | operation-access-control-fields)) | |
237 | (format #t "</Limit>\n")) | |
238 | ||
239 | (define (serialize-method-access-control x) | |
240 | (let ((limit (if (method-access-control-reverse? x) "LimitExcept" "Limit"))) | |
241 | (format #t "<~a ~a>\n" limit | |
242 | (string-join (map symbol->string | |
243 | (method-access-control-methods x)) " ")) | |
244 | (serialize-configuration | |
245 | x | |
246 | (filter (lambda (field) | |
247 | (case (configuration-field-name field) | |
248 | ((reverse? methods) #f) | |
249 | (else #t))) | |
250 | method-access-control-fields)) | |
251 | (format #t "</~a>\n" limit))) | |
252 | ||
253 | (define (operation-access-control-list? val) | |
254 | (and (list? val) (and-map operation-access-control? val))) | |
255 | (define (serialize-operation-access-control-list field-name val) | |
256 | (for-each serialize-operation-access-control val)) | |
257 | ||
258 | (define (method-access-control-list? val) | |
259 | (and (list? val) (and-map method-access-control? val))) | |
260 | (define (serialize-method-access-control-list field-name val) | |
261 | (for-each serialize-method-access-control val)) | |
262 | ||
263 | (define-configuration location-access-control | |
264 | (path | |
5305ed20 | 265 | (file-name (configuration-missing-field 'location-access-control 'path)) |
f2ec23d1 AW |
266 | "Specifies the URI path to which the access control applies.") |
267 | (access-controls | |
268 | (access-control-list '()) | |
269 | "Access controls for all access to this path, in the same format as the | |
270 | @code{access-controls} of @code{operation-access-control}.") | |
271 | (method-access-controls | |
272 | (method-access-control-list '()) | |
273 | "Access controls for method-specific access to this path.")) | |
274 | ||
275 | (define (serialize-location-access-control x) | |
276 | (format #t "<Location ~a>\n" (location-access-control-path x)) | |
277 | (serialize-configuration | |
278 | x | |
279 | (filter (lambda (field) | |
280 | (not (eq? (configuration-field-name field) 'path))) | |
281 | location-access-control-fields)) | |
282 | (format #t "</Location>\n")) | |
283 | ||
284 | (define (location-access-control-list? val) | |
285 | (and (list? val) (and-map location-access-control? val))) | |
286 | (define (serialize-location-access-control-list field-name val) | |
287 | (for-each serialize-location-access-control val)) | |
288 | ||
289 | (define-configuration policy-configuration | |
290 | (name | |
5305ed20 | 291 | (string (configuration-missing-field 'policy-configuration 'name)) |
f2ec23d1 AW |
292 | "Name of the policy.") |
293 | (job-private-access | |
294 | (string "@OWNER @SYSTEM") | |
e254287b TGR |
295 | "Specifies an access list for a job's private values. |
296 | @code{@@ACL} maps to the printer's requesting-user-name-allowed or | |
297 | requesting-user-name-denied values. @code{@@OWNER} maps to the job's owner. | |
298 | @code{@@SYSTEM} maps to the groups listed for the @code{system-group} field of | |
299 | the @code{files-configuration}, which is reified into the | |
300 | @code{cups-files.conf(5)} file. | |
f2ec23d1 AW |
301 | Other possible elements of the access list include specific user names, and |
302 | @code{@@@var{group}} to indicate members of a specific group. The access list | |
303 | may also be simply @code{all} or @code{default}.") | |
304 | (job-private-values | |
305 | (string (string-join '("job-name" "job-originating-host-name" | |
306 | "job-originating-user-name" "phone"))) | |
307 | "Specifies the list of job values to make private, or @code{all}, | |
308 | @code{default}, or @code{none}.") | |
309 | ||
310 | (subscription-private-access | |
311 | (string "@OWNER @SYSTEM") | |
312 | "Specifies an access list for a subscription's private values. | |
313 | @code{@@ACL} maps to the printer's requesting-user-name-allowed or | |
314 | requesting-user-name-denied values. @code{@@OWNER} maps to the job's owner. | |
315 | @code{@@SYSTEM} maps to the groups listed for the @code{system-group} field of | |
e254287b TGR |
316 | the @code{files-configuration}, which is reified into the |
317 | @code{cups-files.conf(5)} file. | |
318 | Other possible elements of the access list include specific user names, and | |
319 | @code{@@@var{group}} to indicate members of a specific group. The access list | |
320 | may also be simply @code{all} or @code{default}.") | |
f2ec23d1 AW |
321 | (subscription-private-values |
322 | (string (string-join '("notify-events" "notify-pull-method" | |
323 | "notify-recipient-uri" "notify-subscriber-user-name" | |
324 | "notify-user-data") | |
325 | " ")) | |
326 | "Specifies the list of job values to make private, or @code{all}, | |
327 | @code{default}, or @code{none}.") | |
328 | ||
329 | (access-controls | |
330 | (operation-access-control-list '()) | |
331 | "Access control by IPP operation.")) | |
332 | ||
333 | (define (serialize-policy-configuration x) | |
334 | (format #t "<Policy ~a>\n" (policy-configuration-name x)) | |
335 | (serialize-configuration | |
336 | x | |
337 | (filter (lambda (field) | |
338 | (not (eq? (configuration-field-name field) 'name))) | |
339 | policy-configuration-fields)) | |
340 | (format #t "</Policy>\n")) | |
341 | ||
342 | (define (policy-configuration-list? x) | |
343 | (and (list? x) (and-map policy-configuration? x))) | |
344 | (define (serialize-policy-configuration-list field-name x) | |
345 | (for-each serialize-policy-configuration x)) | |
346 | ||
347 | (define (log-location? x) | |
348 | (or (file-name? x) | |
349 | (eq? x 'stderr) | |
350 | (eq? x 'syslog))) | |
351 | (define (serialize-log-location field-name x) | |
352 | (if (string? x) | |
353 | (serialize-file-name field-name x) | |
354 | (serialize-field field-name x))) | |
355 | ||
356 | (define-configuration files-configuration | |
357 | (access-log | |
358 | (log-location "/var/log/cups/access_log") | |
359 | "Defines the access log filename. Specifying a blank filename disables | |
360 | access log generation. The value @code{stderr} causes log entries to be sent | |
361 | to the standard error file when the scheduler is running in the foreground, or | |
362 | to the system log daemon when run in the background. The value @code{syslog} | |
363 | causes log entries to be sent to the system log daemon. The server name may | |
364 | be included in filenames using the string @code{%s}, as in | |
365 | @code{/var/log/cups/%s-access_log}.") | |
366 | (cache-dir | |
367 | (file-name "/var/cache/cups") | |
368 | "Where CUPS should cache data.") | |
369 | (config-file-perm | |
370 | (string "0640") | |
371 | "Specifies the permissions for all configuration files that the scheduler | |
372 | writes. | |
373 | ||
374 | Note that the permissions for the printers.conf file are currently masked to | |
375 | only allow access from the scheduler user (typically root). This is done | |
376 | because printer device URIs sometimes contain sensitive authentication | |
377 | information that should not be generally known on the system. There is no way | |
378 | to disable this security feature.") | |
379 | ;; Not specifying data-dir and server-bin options as we handle these | |
380 | ;; manually. For document-root, the CUPS package has that path | |
381 | ;; preconfigured. | |
382 | (error-log | |
383 | (log-location "/var/log/cups/error_log") | |
384 | "Defines the error log filename. Specifying a blank filename disables | |
385 | access log generation. The value @code{stderr} causes log entries to be sent | |
386 | to the standard error file when the scheduler is running in the foreground, or | |
387 | to the system log daemon when run in the background. The value @code{syslog} | |
388 | causes log entries to be sent to the system log daemon. The server name may | |
389 | be included in filenames using the string @code{%s}, as in | |
390 | @code{/var/log/cups/%s-error_log}.") | |
391 | (fatal-errors | |
392 | (string "all -browse") | |
393 | "Specifies which errors are fatal, causing the scheduler to exit. The kind | |
394 | strings are: | |
395 | @table @code | |
396 | @item none | |
397 | No errors are fatal. | |
398 | @item all | |
399 | All of the errors below are fatal. | |
400 | @item browse | |
401 | Browsing initialization errors are fatal, for example failed connections to | |
402 | the DNS-SD daemon. | |
403 | @item config | |
404 | Configuration file syntax errors are fatal. | |
405 | @item listen | |
406 | Listen or Port errors are fatal, except for IPv6 failures on the loopback or | |
407 | @code{any} addresses. | |
408 | @item log | |
409 | Log file creation or write errors are fatal. | |
410 | @item permissions | |
411 | Bad startup file permissions are fatal, for example shared TLS certificate and | |
412 | key files with world-read permissions. | |
413 | @end table") | |
414 | (file-device? | |
415 | (boolean #f) | |
416 | "Specifies whether the file pseudo-device can be used for new printer | |
417 | queues. The URI @url{file:///dev/null} is always allowed.") | |
418 | (group | |
419 | (string "lp") | |
420 | "Specifies the group name or ID that will be used when executing external | |
421 | programs.") | |
c655bbb3 TGR |
422 | (log-file-group |
423 | (string "lpadmin") | |
424 | "Specifies the group name or ID that will be used for log files.") | |
f2ec23d1 AW |
425 | (log-file-perm |
426 | (string "0644") | |
427 | "Specifies the permissions for all log files that the scheduler writes.") | |
428 | (page-log | |
429 | (log-location "/var/log/cups/page_log") | |
430 | "Defines the page log filename. Specifying a blank filename disables | |
431 | access log generation. The value @code{stderr} causes log entries to be sent | |
432 | to the standard error file when the scheduler is running in the foreground, or | |
433 | to the system log daemon when run in the background. The value @code{syslog} | |
434 | causes log entries to be sent to the system log daemon. The server name may | |
435 | be included in filenames using the string @code{%s}, as in | |
436 | @code{/var/log/cups/%s-page_log}.") | |
437 | (remote-root | |
438 | (string "remroot") | |
439 | "Specifies the username that is associated with unauthenticated accesses by | |
440 | clients claiming to be the root user. The default is @code{remroot}.") | |
441 | (request-root | |
442 | (file-name "/var/spool/cups") | |
443 | "Specifies the directory that contains print jobs and other HTTP request | |
444 | data.") | |
445 | (sandboxing | |
446 | (sandboxing 'strict) | |
447 | "Specifies the level of security sandboxing that is applied to print | |
448 | filters, backends, and other child processes of the scheduler; either | |
449 | @code{relaxed} or @code{strict}. This directive is currently only | |
450 | used/supported on macOS.") | |
451 | (server-keychain | |
452 | (file-name "/etc/cups/ssl") | |
453 | "Specifies the location of TLS certificates and private keys. CUPS will | |
454 | look for public and private keys in this directory: a @code{.crt} files for | |
455 | PEM-encoded certificates and corresponding @code{.key} files for PEM-encoded | |
456 | private keys.") | |
457 | (server-root | |
458 | (file-name "/etc/cups") | |
459 | "Specifies the directory containing the server configuration files.") | |
460 | (sync-on-close? | |
461 | (boolean #f) | |
462 | "Specifies whether the scheduler calls fsync(2) after writing configuration | |
463 | or state files.") | |
464 | (system-group | |
465 | (space-separated-string-list '("lpadmin" "wheel" "root")) | |
466 | "Specifies the group(s) to use for @code{@@SYSTEM} group authentication.") | |
467 | (temp-dir | |
468 | (file-name "/var/spool/cups/tmp") | |
469 | "Specifies the directory where temporary files are stored.") | |
470 | (user | |
471 | (string "lp") | |
472 | "Specifies the user name or ID that is used when running external | |
70186c24 TGR |
473 | programs.") |
474 | (set-env | |
475 | (string "variable value") | |
476 | "Set the specified environment variable to be passed to child processes.")) | |
f2ec23d1 AW |
477 | |
478 | (define (serialize-files-configuration field-name val) | |
479 | #f) | |
480 | ||
481 | (define (environment-variables? vars) | |
482 | (space-separated-string-list? vars)) | |
483 | (define (serialize-environment-variables field-name vars) | |
484 | (unless (null? vars) | |
485 | (serialize-space-separated-string-list field-name vars))) | |
486 | ||
487 | (define (package-list? val) | |
892f1b72 | 488 | (and (list? val) (and-map file-like? val))) |
f2ec23d1 AW |
489 | (define (serialize-package-list field-name val) |
490 | #f) | |
491 | ||
492 | (define-configuration cups-configuration | |
493 | (cups | |
892f1b72 | 494 | (file-like cups) |
f2ec23d1 AW |
495 | "The CUPS package.") |
496 | (extensions | |
2a4fdb41 | 497 | (package-list (list brlaser cups-filters epson-inkjet-printer-escpr |
13180f6a | 498 | foomatic-filters hplip-minimal splix)) |
f2ec23d1 AW |
499 | "Drivers and other extensions to the CUPS package.") |
500 | (files-configuration | |
501 | (files-configuration (files-configuration)) | |
502 | "Configuration of where to write logs, what directories to use for print | |
503 | spools, and related privileged configuration parameters.") | |
504 | (access-log-level | |
505 | (access-log-level 'actions) | |
506 | "Specifies the logging level for the AccessLog file. The @code{config} | |
507 | level logs when printers and classes are added, deleted, or modified and when | |
508 | configuration files are accessed or updated. The @code{actions} level logs | |
509 | when print jobs are submitted, held, released, modified, or canceled, and any | |
510 | of the conditions for @code{config}. The @code{all} level logs all | |
511 | requests.") | |
512 | (auto-purge-jobs? | |
513 | (boolean #f) | |
514 | "Specifies whether to purge job history data automatically when it is no | |
515 | longer required for quotas.") | |
ee0de994 TGR |
516 | (browse-dns-sd-sub-types |
517 | (comma-separated-string-list (list "_cups")) | |
518 | "Specifies a list of DNS-SD sub-types to advertise for each shared printer. | |
519 | For example, @samp{\"_cups\" \"_print\"} will tell network clients that both | |
520 | CUPS sharing and IPP Everywhere are supported.") | |
f2ec23d1 AW |
521 | (browse-local-protocols |
522 | (browse-local-protocols 'dnssd) | |
523 | "Specifies which protocols to use for local printer sharing.") | |
524 | (browse-web-if? | |
525 | (boolean #f) | |
526 | "Specifies whether the CUPS web interface is advertised.") | |
527 | (browsing? | |
528 | (boolean #f) | |
529 | "Specifies whether shared printers are advertised.") | |
530 | (classification | |
531 | (string "") | |
532 | "Specifies the security classification of the server. | |
533 | Any valid banner name can be used, including \"classified\", \"confidential\", | |
534 | \"secret\", \"topsecret\", and \"unclassified\", or the banner can be omitted | |
535 | to disable secure printing functions.") | |
536 | (classify-override? | |
537 | (boolean #f) | |
538 | "Specifies whether users may override the classification (cover page) of | |
539 | individual print jobs using the @code{job-sheets} option.") | |
540 | (default-auth-type | |
541 | (default-auth-type 'Basic) | |
542 | "Specifies the default type of authentication to use.") | |
543 | (default-encryption | |
544 | (default-encryption 'Required) | |
545 | "Specifies whether encryption will be used for authenticated requests.") | |
546 | (default-language | |
547 | (string "en") | |
548 | "Specifies the default language to use for text and web content.") | |
549 | (default-paper-size | |
550 | (string "Auto") | |
551 | "Specifies the default paper size for new print queues. @samp{\"Auto\"} | |
552 | uses a locale-specific default, while @samp{\"None\"} specifies there is no | |
553 | default paper size. Specific size names are typically @samp{\"Letter\"} or | |
554 | @samp{\"A4\"}.") | |
555 | (default-policy | |
556 | (string "default") | |
557 | "Specifies the default access policy to use.") | |
558 | (default-shared? | |
559 | (boolean #t) | |
560 | "Specifies whether local printers are shared by default.") | |
561 | (dirty-clean-interval | |
562 | (non-negative-integer 30) | |
563 | "Specifies the delay for updating of configuration and state files, in | |
564 | seconds. A value of 0 causes the update to happen as soon as possible, | |
565 | typically within a few milliseconds.") | |
566 | (error-policy | |
567 | (error-policy 'stop-printer) | |
568 | "Specifies what to do when an error occurs. Possible values are | |
569 | @code{abort-job}, which will discard the failed print job; @code{retry-job}, | |
5a097cdd | 570 | which will retry the job at a later time; @code{retry-current-job}, which retries |
f2ec23d1 AW |
571 | the failed job immediately; and @code{stop-printer}, which stops the |
572 | printer.") | |
573 | (filter-limit | |
574 | (non-negative-integer 0) | |
575 | "Specifies the maximum cost of filters that are run concurrently, which can | |
576 | be used to minimize disk, memory, and CPU resource problems. A limit of 0 | |
577 | disables filter limiting. An average print to a non-PostScript printer needs | |
578 | a filter limit of about 200. A PostScript printer needs about half | |
579 | that (100). Setting the limit below these thresholds will effectively limit | |
580 | the scheduler to printing a single job at any time.") | |
581 | (filter-nice | |
582 | (non-negative-integer 0) | |
583 | "Specifies the scheduling priority of filters that are run to print a job. | |
584 | The nice value ranges from 0, the highest priority, to 19, the lowest | |
585 | priority.") | |
586 | ;; Add this option if the package is built with Kerberos support. | |
587 | ;; (gss-service-name | |
588 | ;; (string "http") | |
589 | ;; "Specifies the service name when using Kerberos authentication.") | |
590 | (host-name-lookups | |
591 | (host-name-lookups #f) | |
592 | "Specifies whether to do reverse lookups on connecting clients. | |
593 | The @code{double} setting causes @code{cupsd} to verify that the hostname | |
594 | resolved from the address matches one of the addresses returned for that | |
595 | hostname. Double lookups also prevent clients with unregistered addresses | |
596 | from connecting to your server. Only set this option to @code{#t} or | |
597 | @code{double} if absolutely required.") | |
598 | ;; Add this option if the package is built with launchd/systemd support. | |
599 | ;; (idle-exit-timeout | |
600 | ;; (non-negative-integer 60) | |
601 | ;; "Specifies the length of time to wait before shutting down due to | |
602 | ;; inactivity. Note: Only applicable when @code{cupsd} is run on-demand | |
603 | ;; (e.g., with @code{-l}).") | |
604 | (job-kill-delay | |
605 | (non-negative-integer 30) | |
606 | "Specifies the number of seconds to wait before killing the filters and | |
607 | backend associated with a canceled or held job.") | |
608 | (job-retry-interval | |
609 | (non-negative-integer 30) | |
610 | "Specifies the interval between retries of jobs in seconds. This is | |
611 | typically used for fax queues but can also be used with normal print queues | |
612 | whose error policy is @code{retry-job} or @code{retry-current-job}.") | |
613 | (job-retry-limit | |
614 | (non-negative-integer 5) | |
615 | "Specifies the number of retries that are done for jobs. This is typically | |
616 | used for fax queues but can also be used with normal print queues whose error | |
617 | policy is @code{retry-job} or @code{retry-current-job}.") | |
618 | (keep-alive? | |
619 | (boolean #t) | |
620 | "Specifies whether to support HTTP keep-alive connections.") | |
f2ec23d1 AW |
621 | (limit-request-body |
622 | (non-negative-integer 0) | |
623 | "Specifies the maximum size of print files, IPP requests, and HTML form | |
624 | data. A limit of 0 disables the limit check.") | |
625 | (listen | |
626 | (multiline-string-list '("localhost:631" "/var/run/cups/cups.sock")) | |
627 | "Listens on the specified interfaces for connections. Valid values are of | |
628 | the form @var{address}:@var{port}, where @var{address} is either an IPv6 | |
629 | address enclosed in brackets, an IPv4 address, or @code{*} to indicate all | |
630 | addresses. Values can also be file names of local UNIX domain sockets. The | |
631 | Listen directive is similar to the Port directive but allows you to restrict | |
632 | access to specific interfaces or networks.") | |
633 | (listen-back-log | |
634 | (non-negative-integer 128) | |
635 | "Specifies the number of pending connections that will be allowed. This | |
636 | normally only affects very busy servers that have reached the MaxClients | |
637 | limit, but can also be triggered by large numbers of simultaneous connections. | |
638 | When the limit is reached, the operating system will refuse additional | |
639 | connections until the scheduler can accept the pending ones.") | |
640 | (location-access-controls | |
641 | (location-access-control-list | |
642 | (list (location-access-control | |
643 | (path "/") | |
644 | (access-controls '("Order allow,deny" | |
645 | "Allow localhost"))) | |
646 | (location-access-control | |
647 | (path "/admin") | |
648 | (access-controls '("Order allow,deny" | |
649 | "Allow localhost"))) | |
650 | (location-access-control | |
651 | (path "/admin/conf") | |
652 | (access-controls '("Order allow,deny" | |
653 | "AuthType Basic" | |
654 | "Require user @SYSTEM" | |
655 | "Allow localhost"))))) | |
656 | "Specifies a set of additional access controls.") | |
657 | (log-debug-history | |
658 | (non-negative-integer 100) | |
659 | "Specifies the number of debugging messages that are retained for logging | |
660 | if an error occurs in a print job. Debug messages are logged regardless of | |
661 | the LogLevel setting.") | |
662 | (log-level | |
663 | (log-level 'info) | |
664 | "Specifies the level of logging for the ErrorLog file. The value | |
665 | @code{none} stops all logging while @code{debug2} logs everything.") | |
666 | (log-time-format | |
667 | (log-time-format 'standard) | |
668 | "Specifies the format of the date and time in the log files. The value | |
669 | @code{standard} logs whole seconds while @code{usecs} logs microseconds.") | |
670 | (max-clients | |
671 | (non-negative-integer 100) | |
672 | "Specifies the maximum number of simultaneous clients that are allowed by | |
673 | the scheduler.") | |
674 | (max-clients-per-host | |
675 | (non-negative-integer 100) | |
676 | "Specifies the maximum number of simultaneous clients that are allowed from | |
677 | a single address.") | |
678 | (max-copies | |
679 | (non-negative-integer 9999) | |
680 | "Specifies the maximum number of copies that a user can print of each | |
681 | job.") | |
682 | (max-hold-time | |
683 | (non-negative-integer 0) | |
684 | "Specifies the maximum time a job may remain in the @code{indefinite} hold | |
685 | state before it is canceled. A value of 0 disables cancellation of held | |
686 | jobs.") | |
687 | (max-jobs | |
688 | (non-negative-integer 500) | |
689 | "Specifies the maximum number of simultaneous jobs that are allowed. Set | |
690 | to 0 to allow an unlimited number of jobs.") | |
691 | (max-jobs-per-printer | |
692 | (non-negative-integer 0) | |
693 | "Specifies the maximum number of simultaneous jobs that are allowed per | |
694 | printer. A value of 0 allows up to MaxJobs jobs per printer.") | |
695 | (max-jobs-per-user | |
696 | (non-negative-integer 0) | |
697 | "Specifies the maximum number of simultaneous jobs that are allowed per | |
698 | user. A value of 0 allows up to MaxJobs jobs per user.") | |
699 | (max-job-time | |
700 | (non-negative-integer 10800) | |
701 | "Specifies the maximum time a job may take to print before it is canceled, | |
702 | in seconds. Set to 0 to disable cancellation of \"stuck\" jobs.") | |
703 | (max-log-size | |
704 | (non-negative-integer 1048576) | |
705 | "Specifies the maximum size of the log files before they are rotated, in | |
706 | bytes. The value 0 disables log rotation.") | |
707 | (multiple-operation-timeout | |
12239607 | 708 | (non-negative-integer 900) |
f2ec23d1 AW |
709 | "Specifies the maximum amount of time to allow between files in a multiple |
710 | file print job, in seconds.") | |
711 | (page-log-format | |
712 | (string "") | |
713 | "Specifies the format of PageLog lines. Sequences beginning with | |
714 | percent (@samp{%}) characters are replaced with the corresponding information, | |
715 | while all other characters are copied literally. The following percent | |
716 | sequences are recognized: | |
717 | ||
718 | @table @samp | |
719 | @item %% | |
720 | insert a single percent character | |
721 | @item %@{name@} | |
722 | insert the value of the specified IPP attribute | |
723 | @item %C | |
724 | insert the number of copies for the current page | |
725 | @item %P | |
726 | insert the current page number | |
727 | @item %T | |
728 | insert the current date and time in common log format | |
729 | @item %j | |
730 | insert the job ID | |
731 | @item %p | |
732 | insert the printer name | |
733 | @item %u | |
734 | insert the username | |
735 | @end table | |
736 | ||
737 | A value of the empty string disables page logging. The string @code{%p %u %j | |
738 | %T %P %C %@{job-billing@} %@{job-originating-host-name@} %@{job-name@} | |
739 | %@{media@} %@{sides@}} creates a page log with the standard items.") | |
740 | (environment-variables | |
741 | (environment-variables '()) | |
742 | "Passes the specified environment variable(s) to child processes; a list of | |
743 | strings.") | |
744 | (policies | |
745 | (policy-configuration-list | |
746 | (list (policy-configuration | |
747 | (name "default") | |
748 | (access-controls | |
749 | (list | |
750 | (operation-access-control | |
751 | (operations | |
752 | '(Send-Document | |
753 | Send-URI Hold-Job Release-Job Restart-Job Purge-Jobs | |
754 | Cancel-Job Close-Job Cancel-My-Jobs Set-Job-Attributes | |
755 | Create-Job-Subscription Renew-Subscription | |
756 | Cancel-Subscription Get-Notifications | |
757 | Reprocess-Job Cancel-Current-Job Suspend-Current-Job | |
758 | Resume-Job CUPS-Move-Job Validate-Job | |
759 | CUPS-Get-Document)) | |
760 | (access-controls '("Require user @OWNER @SYSTEM" | |
761 | "Order deny,allow"))) | |
762 | (operation-access-control | |
763 | (operations | |
764 | '(Pause-Printer | |
765 | Cancel-Jobs | |
766 | Resume-Printer Set-Printer-Attributes Enable-Printer | |
767 | Disable-Printer Pause-Printer-After-Current-Job | |
768 | Hold-New-Jobs Release-Held-New-Jobs Deactivate-Printer | |
769 | Activate-Printer Restart-Printer Shutdown-Printer | |
770 | Startup-Printer Promote-Job Schedule-Job-After | |
771 | CUPS-Authenticate-Job CUPS-Add-Printer | |
772 | CUPS-Delete-Printer CUPS-Add-Class CUPS-Delete-Class | |
773 | CUPS-Accept-Jobs CUPS-Reject-Jobs CUPS-Set-Default)) | |
774 | (access-controls '("AuthType Basic" | |
775 | "Require user @SYSTEM" | |
776 | "Order deny,allow"))) | |
777 | (operation-access-control | |
778 | (operations '(All)) | |
779 | (access-controls '("Order deny,allow")))))))) | |
780 | "Specifies named access control policies.") | |
781 | #; | |
782 | (port | |
783 | (non-negative-integer 631) | |
784 | "Listens to the specified port number for connections.") | |
785 | (preserve-job-files | |
786 | (boolean-or-non-negative-integer 86400) | |
787 | "Specifies whether job files (documents) are preserved after a job is | |
788 | printed. If a numeric value is specified, job files are preserved for the | |
789 | indicated number of seconds after printing. Otherwise a boolean value applies | |
790 | indefinitely.") | |
791 | (preserve-job-history | |
792 | (boolean-or-non-negative-integer #t) | |
793 | "Specifies whether the job history is preserved after a job is printed. | |
794 | If a numeric value is specified, the job history is preserved for the | |
795 | indicated number of seconds after printing. If @code{#t}, the job history is | |
796 | preserved until the MaxJobs limit is reached.") | |
797 | (reload-timeout | |
798 | (non-negative-integer 30) | |
799 | "Specifies the amount of time to wait for job completion before restarting | |
800 | the scheduler.") | |
801 | (rip-cache | |
802 | (string "128m") | |
803 | "Specifies the maximum amount of memory to use when converting documents into bitmaps for a printer.") | |
804 | (server-admin | |
805 | (string "root@localhost.localdomain") | |
806 | "Specifies the email address of the server administrator.") | |
807 | (server-alias | |
808 | (host-name-list-or-* '*) | |
809 | "The ServerAlias directive is used for HTTP Host header validation when | |
810 | clients connect to the scheduler from external interfaces. Using the special | |
811 | name @code{*} can expose your system to known browser-based DNS rebinding | |
812 | attacks, even when accessing sites through a firewall. If the auto-discovery | |
813 | of alternate names does not work, we recommend listing each alternate name | |
814 | with a ServerAlias directive instead of using @code{*}.") | |
815 | (server-name | |
816 | (string "localhost") | |
817 | "Specifies the fully-qualified host name of the server.") | |
818 | (server-tokens | |
819 | (server-tokens 'Minimal) | |
820 | "Specifies what information is included in the Server header of HTTP | |
821 | responses. @code{None} disables the Server header. @code{ProductOnly} | |
822 | reports @code{CUPS}. @code{Major} reports @code{CUPS 2}. @code{Minor} | |
823 | reports @code{CUPS 2.0}. @code{Minimal} reports @code{CUPS 2.0.0}. @code{OS} | |
824 | reports @code{CUPS 2.0.0 (@var{uname})} where @var{uname} is the output of the | |
825 | @code{uname} command. @code{Full} reports @code{CUPS 2.0.0 (@var{uname}) | |
826 | IPP/2.0}.") | |
f2ec23d1 AW |
827 | (ssl-listen |
828 | (multiline-string-list '()) | |
829 | "Listens on the specified interfaces for encrypted connections. Valid | |
830 | values are of the form @var{address}:@var{port}, where @var{address} is either | |
831 | an IPv6 address enclosed in brackets, an IPv4 address, or @code{*} to indicate | |
832 | all addresses.") | |
833 | (ssl-options | |
834 | (ssl-options '()) | |
9e3ef6f3 TGR |
835 | "Sets encryption options. By default, CUPS only supports encryption |
836 | using TLS v1.0 or higher using known secure cipher suites. Security is | |
837 | reduced when @code{Allow} options are used, and enhanced when @code{Deny} | |
838 | options are used. The @code{AllowRC4} option enables the 128-bit RC4 cipher | |
839 | suites, which are required for some older clients. The @code{AllowSSL3} option | |
840 | enables SSL v3.0, which is required for some older clients that do not support | |
841 | TLS v1.0. The @code{DenyCBC} option disables all CBC cipher suites. The | |
842 | @code{DenyTLS1.0} option disables TLS v1.0 support - this sets the minimum | |
843 | protocol version to TLS v1.1.") | |
f2ec23d1 AW |
844 | #; |
845 | (ssl-port | |
846 | (non-negative-integer 631) | |
847 | "Listens on the specified port for encrypted connections.") | |
848 | (strict-conformance? | |
849 | (boolean #f) | |
850 | "Specifies whether the scheduler requires clients to strictly adhere to the | |
851 | IPP specifications.") | |
852 | (timeout | |
12239607 | 853 | (non-negative-integer 900) |
f2ec23d1 AW |
854 | "Specifies the HTTP request timeout, in seconds.") |
855 | (web-interface? | |
856 | (boolean #f) | |
857 | "Specifies whether the web interface is enabled.")) | |
858 | ||
859 | (define-configuration opaque-cups-configuration | |
860 | (cups | |
861 | (package cups) | |
862 | "The CUPS package.") | |
863 | (extensions | |
864 | (package-list '()) | |
865 | "Drivers and other extensions to the CUPS package.") | |
866 | (cupsd.conf | |
5305ed20 JL |
867 | (string (configuration-missing-field 'opaque-cups-configuration |
868 | 'cupsd.conf)) | |
f2ec23d1 AW |
869 | "The contents of the @code{cupsd.conf} to use.") |
870 | (cups-files.conf | |
5305ed20 JL |
871 | (string (configuration-missing-field 'opaque-cups-configuration |
872 | 'cups-files.conf)) | |
f2ec23d1 AW |
873 | "The contents of the @code{cups-files.conf} to use.")) |
874 | ||
875 | (define %cups-activation | |
876 | ;; Activation gexp. | |
520bac7e MD |
877 | (with-imported-modules (source-module-closure '((gnu build activation) |
878 | (guix build utils))) | |
f2ec23d1 | 879 | #~(begin |
520bac7e MD |
880 | (use-modules (gnu build activation) |
881 | (guix build utils)) | |
f2ec23d1 AW |
882 | (define (build-subject parameters) |
883 | (string-concatenate | |
884 | (map (lambda (pair) | |
885 | (let ((k (car pair)) (v (cdr pair))) | |
886 | (define (escape-char str chr) | |
887 | (string-join (string-split str chr) (string #\\ chr))) | |
888 | (string-append "/" k "=" | |
889 | (escape-char (escape-char v #\=) #\/)))) | |
890 | (filter (lambda (pair) (cdr pair)) parameters)))) | |
891 | (define* (create-self-signed-certificate-if-absent | |
892 | #:key private-key public-key (owner (getpwnam "root")) | |
893 | (common-name (gethostname)) | |
59e80445 | 894 | (organization-name "Guix") |
f2ec23d1 AW |
895 | (organization-unit-name "Default Self-Signed Certificate") |
896 | (subject-parameters `(("CN" . ,common-name) | |
897 | ("O" . ,organization-name) | |
898 | ("OU" . ,organization-unit-name))) | |
899 | (subject (build-subject subject-parameters))) | |
900 | ;; Note that by default, OpenSSL outputs keys in PEM format. This | |
901 | ;; is what we want. | |
902 | (unless (file-exists? private-key) | |
903 | (cond | |
904 | ((zero? (system* (string-append #$openssl "/bin/openssl") | |
905 | "genrsa" "-out" private-key "2048")) | |
906 | (chown private-key (passwd:uid owner) (passwd:gid owner)) | |
907 | (chmod private-key #o400)) | |
908 | (else | |
909 | (format (current-error-port) | |
910 | "Failed to create private key at ~a.\n" private-key)))) | |
911 | (unless (file-exists? public-key) | |
912 | (cond | |
913 | ((zero? (system* (string-append #$openssl "/bin/openssl") | |
914 | "req" "-new" "-x509" "-key" private-key | |
915 | "-out" public-key "-days" "3650" | |
916 | "-batch" "-subj" subject)) | |
917 | (chown public-key (passwd:uid owner) (passwd:gid owner)) | |
918 | (chmod public-key #o444)) | |
919 | (else | |
920 | (format (current-error-port) | |
921 | "Failed to create public key at ~a.\n" public-key))))) | |
922 | (let ((user (getpwnam "lp"))) | |
923 | (mkdir-p/perms "/var/run/cups" user #o755) | |
924 | (mkdir-p/perms "/var/spool/cups" user #o755) | |
925 | (mkdir-p/perms "/var/spool/cups/tmp" user #o755) | |
926 | (mkdir-p/perms "/var/log/cups" user #o755) | |
36273ebd | 927 | (mkdir-p/perms "/var/cache/cups" user #o770) |
f2ec23d1 AW |
928 | (mkdir-p/perms "/etc/cups" user #o755) |
929 | (mkdir-p/perms "/etc/cups/ssl" user #o700) | |
930 | ;; This certificate is used for HTTPS connections to the CUPS web | |
931 | ;; interface. | |
932 | (create-self-signed-certificate-if-absent | |
933 | #:private-key "/etc/cups/ssl/localhost.key" | |
934 | #:public-key "/etc/cups/ssl/localhost.crt" | |
935 | #:owner (getpwnam "root") | |
936 | #:common-name (format #f "CUPS service on ~a" (gethostname))))))) | |
937 | ||
938 | (define (union-directory name packages paths) | |
939 | (computed-file | |
940 | name | |
941 | (with-imported-modules '((guix build utils)) | |
942 | #~(begin | |
943 | (use-modules (guix build utils) | |
944 | (srfi srfi-1)) | |
945 | (mkdir #$output) | |
946 | (for-each | |
947 | (lambda (package) | |
948 | (for-each | |
949 | (lambda (path) | |
950 | (for-each | |
951 | (lambda (src) | |
952 | (let* ((tail (substring src (string-length package))) | |
953 | (dst (string-append #$output tail))) | |
954 | (mkdir-p (dirname dst)) | |
955 | ;; CUPS currently symlinks in some data from cups-filters | |
956 | ;; to its output dir. Probably we should stop doing this | |
957 | ;; and instead rely only on the CUPS service to union the | |
958 | ;; relevant set of CUPS packages. | |
959 | (if (file-exists? dst) | |
960 | (format (current-error-port) "warning: ~a exists\n" dst) | |
961 | (symlink src dst)))) | |
4ce8860d | 962 | (find-files (string-append package path) #:stat stat))) |
f2ec23d1 AW |
963 | (list #$@paths))) |
964 | (list #$@packages)) | |
965 | #t)))) | |
966 | ||
967 | (define (cups-server-bin-directory extensions) | |
968 | "Return the CUPS ServerBin directory, containing binaries for CUPS and all | |
969 | extensions that it uses." | |
970 | (union-directory "cups-server-bin" extensions | |
971 | ;; /bin | |
972 | '("/lib/cups" "/share/ppd" "/share/cups"))) | |
973 | ||
974 | (define (cups-shepherd-service config) | |
975 | "Return a list of <shepherd-service> for CONFIG." | |
976 | (let* ((cupsd.conf-str | |
977 | (cond | |
978 | ((opaque-cups-configuration? config) | |
979 | (opaque-cups-configuration-cupsd.conf config)) | |
980 | (else | |
981 | (with-output-to-string | |
982 | (lambda () | |
983 | (serialize-configuration config | |
984 | cups-configuration-fields)))))) | |
985 | (cups-files.conf-str | |
986 | (cond | |
987 | ((opaque-cups-configuration? config) | |
988 | (opaque-cups-configuration-cups-files.conf config)) | |
989 | (else | |
990 | (with-output-to-string | |
991 | (lambda () | |
992 | (serialize-configuration | |
993 | (cups-configuration-files-configuration config) | |
994 | files-configuration-fields)))))) | |
995 | (cups (if (opaque-cups-configuration? config) | |
996 | (opaque-cups-configuration-cups config) | |
997 | (cups-configuration-cups config))) | |
998 | (server-bin | |
999 | (cups-server-bin-directory | |
1000 | (cons cups | |
1001 | (cond | |
1002 | ((opaque-cups-configuration? config) | |
1003 | (opaque-cups-configuration-extensions config)) | |
1004 | (else | |
1005 | (cups-configuration-extensions config)))))) | |
1006 | ;;"SetEnv PATH " server-bin "/bin" "\n" | |
1007 | (cupsd.conf | |
1008 | (plain-file "cupsd.conf" cupsd.conf-str)) | |
1009 | (cups-files.conf | |
1010 | (mixed-text-file | |
1011 | "cups-files.conf" | |
1012 | cups-files.conf-str | |
1013 | "CacheDir /var/cache/cups\n" | |
1014 | "StateDir /var/run/cups\n" | |
1015 | "DataDir " server-bin "/share/cups" "\n" | |
1016 | "ServerBin " server-bin "/lib/cups" "\n"))) | |
1017 | (list (shepherd-service | |
1018 | (documentation "Run the CUPS print server.") | |
1019 | (provision '(cups)) | |
1020 | (requirement '(networking)) | |
1021 | (start #~(make-forkexec-constructor | |
1022 | (list (string-append #$cups "/sbin/cupsd") | |
1023 | "-f" "-c" #$cupsd.conf "-s" #$cups-files.conf))) | |
1024 | (stop #~(make-kill-destructor)))))) | |
1025 | ||
1026 | (define cups-service-type | |
1027 | (service-type (name 'cups) | |
1028 | (extensions | |
1029 | (list (service-extension shepherd-root-service-type | |
1030 | cups-shepherd-service) | |
1031 | (service-extension activation-service-type | |
1032 | (const %cups-activation)) | |
1033 | (service-extension account-service-type | |
1034 | (const %cups-accounts)))) | |
1035 | ||
1036 | ;; Extensions consist of lists of packages (representing CUPS | |
1037 | ;; drivers, etc) that we just concatenate. | |
1038 | (compose append) | |
1039 | ||
1040 | ;; Add extension packages by augmenting the cups-configuration | |
1041 | ;; 'extensions' field. | |
1042 | (extend | |
1043 | (lambda (config extensions) | |
1044 | (cond | |
1045 | ((cups-configuration? config) | |
1046 | (cups-configuration | |
1047 | (inherit config) | |
1048 | (extensions | |
1049 | (append (cups-configuration-extensions config) | |
1050 | extensions)))) | |
1051 | (else | |
1052 | (opaque-cups-configuration | |
1053 | (inherit config) | |
1054 | (extensions | |
1055 | (append (opaque-cups-configuration-extensions config) | |
3d3c5650 LC |
1056 | extensions))))))) |
1057 | ||
86cd3f97 RW |
1058 | (default-value (cups-configuration)) |
1059 | (description | |
1060 | "Run the CUPS print server."))) | |
f2ec23d1 AW |
1061 | |
1062 | ;; A little helper to make it easier to document all those fields. | |
5305ed20 JL |
1063 | (define (generate-cups-documentation) |
1064 | (generate-documentation | |
f2ec23d1 AW |
1065 | `((cups-configuration |
1066 | ,cups-configuration-fields | |
1067 | (files-configuration files-configuration) | |
1068 | (policies policy-configuration) | |
1069 | (location-access-controls location-access-controls)) | |
1070 | (files-configuration ,files-configuration-fields) | |
1071 | (policy-configuration | |
1072 | ,policy-configuration-fields | |
1073 | (operation-access-controls operation-access-controls)) | |
1074 | (location-access-controls | |
1075 | ,location-access-control-fields | |
1076 | (method-access-controls method-access-controls)) | |
1077 | (operation-access-controls ,operation-access-control-fields) | |
5305ed20 JL |
1078 | (method-access-controls ,method-access-control-fields)) |
1079 | 'cups-configuration)) |