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