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