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