cups.scm 44 KB

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