* [PATCH 3/3] gnu: Add CUPS service.
2016-10-10 13:29 [PATCH 1/3] gnu: cups-filters: Look for test page in own output dir Andy Wingo
2016-10-10 13:30 ` [PATCH 2/3] gnu: cups-filters: Use ghostscript with CUPS driver Andy Wingo
@ 2016-10-10 13:30 ` Andy Wingo
2016-10-10 21:50 ` [PATCH 1/3] gnu: cups-filters: Look for test page in own output dir Ludovic Courtès
2 siblings, 0 replies; 7+ messages in thread
From: Andy Wingo @ 2016-10-10 13:30 UTC (permalink / raw)
To: guix-devel
* gnu/services/cups.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add gnu/services/cups.scm.
* doc/guix.texi (Printing Services): New section.
---
doc/guix.texi | 831 +++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
gnu/services/cups.scm | 1165 +++++++++++++++++++++++++++++++++++++++++++++++++
3 files changed, 1997 insertions(+)
create mode 100644 gnu/services/cups.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 9bd8b43..a689182 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -7586,6 +7586,7 @@ declaration.
* Log Rotation:: The rottlog service.
* Networking Services:: Network setup, SSH daemon, etc.
* X Window:: Graphical display.
+* Printing Services:: Local and remote printer support.
* Desktop Services:: D-Bus and desktop services.
* Database Services:: SQL databases.
* Mail Services:: IMAP, POP3, SMTP, and all that.
@@ -8629,6 +8630,836 @@ makes the good ol' XlockMore usable.
@end deffn
+@node Printing Services
+@subsubsection Printing Services
+
+The @code{(gnu services cups)} module provides a Guix service definition
+for the CUPS printing service. To add printer support to a GuixSD
+system, add a @code{cups-service} to the operating system definition:
+
+@deffn {Scheme Variable} cups-service-type
+The service type for the CUPS print server. Its value should be a valid
+CUPS configuration (see below). For example:
+@example
+(service cups-service-type (cups-configuration))
+@end example
+@end deffn
+
+The CUPS configuration controls the basic things about your CUPS
+installation: what interfaces it listens on, what to do if a print job
+fails, how much logging to do, and so on. To actually add a printer,
+you have to visit the @url{http://localhost:631} URL, or use a tool such
+as GNOME's printer configuration services. By default, configuring a
+CUPS service will generate a self-signed certificate if needed, for
+secure connections to the print server.
+
+One way you might want to customize CUPS is to enable or disable the web
+interface. You can do that directly, like this:
+
+@example
+(service cups-service-type
+ (cups-configuration
+ (web-interface? #f)))
+@end example
+
+The available configuration parameters follow. Each parameter
+definition is preceded by its type; for example, @samp{string-list foo}
+indicates that the @code{foo} parameter should be specified as a list of
+strings. There is also a way to specify the configuration as a string,
+if you have an old @code{cupsd.conf} file that you want to port over
+from some other system; see the end for more details.
+
+@c The following documentation was initially generated by
+@c (generate-documentation) in (gnu services cups). Manually maintained
+@c documentation is better, so we shouldn't hesitate to edit below as
+@c needed. However if the change you want to make to this documentation
+@c can be done in an automated way, it's probably easier to change
+@c (generate-documentation) than to make it below and have to deal with
+@c the churn as CUPS updates.
+
+
+Available @code{cups-configuration} fields are:
+
+@deftypevr {@code{cups-configuration} parameter} package cups
+The CUPS package.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} package-list extensions
+Drivers and other extensions to the CUPS package.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} files-configuration files-configuration
+Configuration of where to write logs, what directories to use for print
+spools, and related privileged configuration parameters.
+
+Available @code{files-configuration} fields are:
+
+@deftypevr {@code{files-configuration} parameter} log-location access-log
+Defines the access log filename. Specifying a blank filename disables
+access log generation. The value @code{stderr} causes log entries to be
+sent to the standard error file when the scheduler is running in the
+foreground, or to the system log daemon when run in the background. The
+value @code{syslog} causes log entries to be sent to the system log
+daemon. The server name may be included in filenames using the string
+@code{%s}, as in @code{/var/log/cups/%s-access_log}.
+
+Defaults to @samp{"/var/log/cups/access_log"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} file-name cache-dir
+Where CUPS should cache data.
+
+Defaults to @samp{"/var/cache/cups"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} string config-file-perm
+Specifies the permissions for all configuration files that the scheduler
+writes.
+
+Note that the permissions for the printers.conf file are currently
+masked to only allow access from the scheduler user (typically root).
+This is done because printer device URIs sometimes contain sensitive
+authentication information that should not be generally known on the
+system. There is no way to disable this security feature.
+
+Defaults to @samp{"0640"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} log-location error-log
+Defines the error log filename. Specifying a blank filename disables
+access log generation. The value @code{stderr} causes log entries to be
+sent to the standard error file when the scheduler is running in the
+foreground, or to the system log daemon when run in the background. The
+value @code{syslog} causes log entries to be sent to the system log
+daemon. The server name may be included in filenames using the string
+@code{%s}, as in @code{/var/log/cups/%s-error_log}.
+
+Defaults to @samp{"/var/log/cups/error_log"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} string fatal-errors
+Specifies which errors are fatal, causing the scheduler to exit. The
+kind strings are:
+
+@table @code
+@item none
+No errors are fatal.
+
+@item all
+All of the errors below are fatal.
+
+@item browse
+Browsing initialization errors are fatal, for example failed connections
+to the DNS-SD daemon.
+
+@item config
+Configuration file syntax errors are fatal.
+
+@item listen
+Listen or Port errors are fatal, except for IPv6 failures on the
+loopback or @code{any} addresses.
+
+@item log
+Log file creation or write errors are fatal.
+
+@item permissions
+Bad startup file permissions are fatal, for example shared TLS
+certificate and key files with world-read permissions.
+@end table
+
+Defaults to @samp{"all -browse"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} boolean file-device?
+Specifies whether the file pseudo-device can be used for new printer
+queues. The URI @uref{file:///dev/null} is always allowed.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} string group
+Specifies the group name or ID that will be used when executing external
+programs.
+
+Defaults to @samp{"lp"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} string log-file-perm
+Specifies the permissions for all log files that the scheduler writes.
+
+Defaults to @samp{"0644"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} log-location page-log
+Defines the page log filename. Specifying a blank filename disables
+access log generation. The value @code{stderr} causes log entries to be
+sent to the standard error file when the scheduler is running in the
+foreground, or to the system log daemon when run in the background. The
+value @code{syslog} causes log entries to be sent to the system log
+daemon. The server name may be included in filenames using the string
+@code{%s}, as in @code{/var/log/cups/%s-page_log}.
+
+Defaults to @samp{"/var/log/cups/page_log"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} string remote-root
+Specifies the username that is associated with unauthenticated accesses
+by clients claiming to be the root user. The default is @code{remroot}.
+
+Defaults to @samp{"remroot"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} file-name request-root
+Specifies the directory that contains print jobs and other HTTP request
+data.
+
+Defaults to @samp{"/var/spool/cups"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} sandboxing sandboxing
+Specifies the level of security sandboxing that is applied to print
+filters, backends, and other child processes of the scheduler; either
+@code{relaxed} or @code{strict}. This directive is currently only
+used/supported on macOS.
+
+Defaults to @samp{strict}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} file-name server-keychain
+Specifies the location of TLS certificates and private keys. CUPS will
+look for public and private keys in this directory: a @code{.crt} files
+for PEM-encoded certificates and corresponding @code{.key} files for
+PEM-encoded private keys.
+
+Defaults to @samp{"/etc/cups/ssl"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} file-name server-root
+Specifies the directory containing the server configuration files.
+
+Defaults to @samp{"/etc/cups"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} boolean sync-on-close?
+Specifies whether the scheduler calls fsync(2) after writing
+configuration or state files.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} space-separated-string-list system-group
+Specifies the group(s) to use for @code{@@SYSTEM} group authentication.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} file-name temp-dir
+Specifies the directory where temporary files are stored.
+
+Defaults to @samp{"/var/spool/cups/tmp"}.
+@end deftypevr
+
+@deftypevr {@code{files-configuration} parameter} string user
+Specifies the user name or ID that is used when running external
+programs.
+
+Defaults to @samp{"lp"}.
+@end deftypevr
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} access-log-level access-log-level
+Specifies the logging level for the AccessLog file. The @code{config}
+level logs when printers and classes are added, deleted, or modified and
+when configuration files are accessed or updated. The @code{actions}
+level logs when print jobs are submitted, held, released, modified, or
+canceled, and any of the conditions for @code{config}. The @code{all}
+level logs all requests.
+
+Defaults to @samp{actions}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean auto-purge-jobs?
+Specifies whether to purge job history data automatically when it is no
+longer required for quotas.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} browse-local-protocols browse-local-protocols
+Specifies which protocols to use for local printer sharing.
+
+Defaults to @samp{dnssd}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean browse-web-if?
+Specifies whether the CUPS web interface is advertised.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean browsing?
+Specifies whether shared printers are advertised.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string classification
+Specifies the security classification of the server. Any valid banner
+name can be used, including "classified", "confidential", "secret",
+"topsecret", and "unclassified", or the banner can be omitted to disable
+secure printing functions.
+
+Defaults to @samp{""}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean classify-override?
+Specifies whether users may override the classification (cover page) of
+individual print jobs using the @code{job-sheets} option.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} default-auth-type default-auth-type
+Specifies the default type of authentication to use.
+
+Defaults to @samp{Basic}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} default-encryption default-encryption
+Specifies whether encryption will be used for authenticated requests.
+
+Defaults to @samp{Required}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string default-language
+Specifies the default language to use for text and web content.
+
+Defaults to @samp{"en"}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string default-paper-size
+Specifies the default paper size for new print queues. "Auto" uses a
+locale-specific default, while "None" specifies there is no default
+paper size. Specific size names are typically "Letter" or "A4".
+
+Defaults to @samp{"Auto"}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string default-policy
+Specifies the default access policy to use.
+
+Defaults to @samp{"default"}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean default-shared?
+Specifies whether local printers are shared by default.
+
+Defaults to @samp{#t}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer dirty-clean-interval
+Specifies the delay for updating of configuration and state files, in
+seconds. A value of 0 causes the update to happen as soon as possible,
+typically within a few milliseconds.
+
+Defaults to @samp{30}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} error-policy error-policy
+Specifies what to do when an error occurs. Possible values are
+@code{abort-job}, which will discard the failed print job;
+@code{retry-job}, which will retry the job at a later time;
+@code{retry-this-job}, which retries the failed job immediately; and
+@code{stop-printer}, which stops the printer.
+
+Defaults to @samp{stop-printer}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer filter-limit
+Specifies the maximum cost of filters that are run concurrently, which
+can be used to minimize disk, memory, and CPU resource problems. A
+limit of 0 disables filter limiting. An average print to a
+non-PostScript printer needs a filter limit of about 200. A PostScript
+printer needs about half that (100). Setting the limit below these
+thresholds will effectively limit the scheduler to printing a single job
+at any time.
+
+Defaults to @samp{0}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer filter-nice
+Specifies the scheduling priority of filters that are run to print a
+job. The nice value ranges from 0, the highest priority, to 19, the
+lowest priority.
+
+Defaults to @samp{0}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} host-name-lookups host-name-lookups
+Specifies whether to do reverse lookups on connecting clients. The
+@code{double} setting causes @code{cupsd} to verify that the hostname
+resolved from the address matches one of the addresses returned for that
+hostname. Double lookups also prevent clients with unregistered
+addresses from connecting to your server. Only set this option to
+@code{#t} or @code{double} if absolutely required.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer job-kill-delay
+Specifies the number of seconds to wait before killing the filters and
+backend associated with a canceled or held job.
+
+Defaults to @samp{30}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer job-retry-interval
+Specifies the interval between retries of jobs in seconds. This is
+typically used for fax queues but can also be used with normal print
+queues whose error policy is @code{retry-job} or
+@code{retry-current-job}.
+
+Defaults to @samp{30}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer job-retry-limit
+Specifies the number of retries that are done for jobs. This is
+typically used for fax queues but can also be used with normal print
+queues whose error policy is @code{retry-job} or
+@code{retry-current-job}.
+
+Defaults to @samp{5}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean keep-alive?
+Specifies whether to support HTTP keep-alive connections.
+
+Defaults to @samp{#t}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer keep-alive-timeout
+Specifies how long an idle client connection remains open, in seconds.
+
+Defaults to @samp{30}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer limit-request-body
+Specifies the maximum size of print files, IPP requests, and HTML form
+data. A limit of 0 disables the limit check.
+
+Defaults to @samp{0}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} multiline-string-list listen
+Listens on the specified interfaces for connections. Valid values are
+of the form @var{address}:@var{port}, where @var{address} is either an
+IPv6 address enclosed in brackets, an IPv4 address, or @code{*} to
+indicate all addresses. Values can also be file names of local UNIX
+domain sockets. The Listen directive is similar to the Port directive
+but allows you to restrict access to specific interfaces or networks.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer listen-back-log
+Specifies the number of pending connections that will be allowed. This
+normally only affects very busy servers that have reached the MaxClients
+limit, but can also be triggered by large numbers of simultaneous
+connections. When the limit is reached, the operating system will
+refuse additional connections until the scheduler can accept the pending
+ones.
+
+Defaults to @samp{128}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} location-access-control-list location-access-controls
+Specifies a set of additional access controls.
+
+Available @code{location-access-controls} fields are:
+
+@deftypevr {@code{location-access-controls} parameter} file-name path
+Specifies the URI path to which the access control applies.
+@end deftypevr
+
+@deftypevr {@code{location-access-controls} parameter} access-control-list access-controls
+Access controls for all access to this path, in the same format as the
+@code{access-controls} of @code{operation-access-control}.
+
+Defaults to @samp{()}.
+@end deftypevr
+
+@deftypevr {@code{location-access-controls} parameter} method-access-control-list method-access-controls
+Access controls for method-specific access to this path.
+
+Defaults to @samp{()}.
+
+Available @code{method-access-controls} fields are:
+
+@deftypevr {@code{method-access-controls} parameter} boolean reverse?
+If @code{#t}, apply access controls to all methods except the listed
+methods. Otherwise apply to only the listed methods.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{method-access-controls} parameter} method-list methods
+Methods to which this access control applies.
+
+Defaults to @samp{()}.
+@end deftypevr
+
+@deftypevr {@code{method-access-controls} parameter} access-control-list access-controls
+Access control directives, as a list of strings. Each string should be
+one directive, such as "Order allow,deny".
+
+Defaults to @samp{()}.
+@end deftypevr
+@end deftypevr
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer log-debug-history
+Specifies the number of debugging messages that are retained for logging
+if an error occurs in a print job. Debug messages are logged regardless
+of the LogLevel setting.
+
+Defaults to @samp{100}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} log-level log-level
+Specifies the level of logging for the ErrorLog file. The value
+@code{none} stops all logging while @code{debug2} logs everything.
+
+Defaults to @samp{info}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} log-time-format log-time-format
+Specifies the format of the date and time in the log files. The value
+@code{standard} logs whole seconds while @code{usecs} logs microseconds.
+
+Defaults to @samp{standard}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-clients
+Specifies the maximum number of simultaneous clients that are allowed by
+the scheduler.
+
+Defaults to @samp{100}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-clients-per-host
+Specifies the maximum number of simultaneous clients that are allowed
+from a single address.
+
+Defaults to @samp{100}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-copies
+Specifies the maximum number of copies that a user can print of each
+job.
+
+Defaults to @samp{9999}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-hold-time
+Specifies the maximum time a job may remain in the @code{indefinite}
+hold state before it is canceled. A value of 0 disables cancellation of
+held jobs.
+
+Defaults to @samp{0}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-jobs
+Specifies the maximum number of simultaneous jobs that are allowed. Set
+to 0 to allow an unlimited number of jobs.
+
+Defaults to @samp{500}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-jobs-per-printer
+Specifies the maximum number of simultaneous jobs that are allowed per
+printer. A value of 0 allows up to MaxJobs jobs per printer.
+
+Defaults to @samp{0}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-jobs-per-user
+Specifies the maximum number of simultaneous jobs that are allowed per
+user. A value of 0 allows up to MaxJobs jobs per user.
+
+Defaults to @samp{0}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-job-time
+Specifies the maximum time a job may take to print before it is
+canceled, in seconds. Set to 0 to disable cancellation of "stuck" jobs.
+
+Defaults to @samp{10800}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer max-log-size
+Specifies the maximum size of the log files before they are rotated, in
+bytes. The value 0 disables log rotation.
+
+Defaults to @samp{1048576}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer multiple-operation-timeout
+Specifies the maximum amount of time to allow between files in a
+multiple file print job, in seconds.
+
+Defaults to @samp{300}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string page-log-format
+Specifies the format of PageLog lines. Sequences beginning with percent
+(@samp{%}) characters are replaced with the corresponding information,
+while all other characters are copied literally. The following percent
+sequences are recognized:
+
+@table @samp
+@item %%
+insert a single percent character
+
+@item %@{name@}
+insert the value of the specified IPP attribute
+
+@item %C
+insert the number of copies for the current page
+
+@item %P
+insert the current page number
+
+@item %T
+insert the current date and time in common log format
+
+@item %j
+insert the job ID
+
+@item %p
+insert the printer name
+
+@item %u
+insert the username
+@end table
+
+A value of the empty string disables page logging. The string @code{%p
+%u %j %T %P %C %@{job-billing@} %@{job-originating-host-name@}
+%@{job-name@} %@{media@} %@{sides@}} creates a page log with the
+standard items.
+
+Defaults to @samp{""}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} environment-variables environment-variables
+Passes the specified environment variable(s) to child processes; a list
+of strings.
+
+Defaults to @samp{()}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} policy-configuration-list policies
+Specifies named access control policies.
+
+Available @code{policy-configuration} fields are:
+
+@deftypevr {@code{policy-configuration} parameter} string name
+Name of the policy.
+@end deftypevr
+
+@deftypevr {@code{policy-configuration} parameter} string job-private-access
+Specifies an access list for a job's private values. @code{@@ACL} maps
+to the printer's requesting-user-name-allowed or
+requesting-user-name-denied values. @code{@@OWNER} maps to the job's
+owner. @code{@@SYSTEM} maps to the groups listed for the
+@code{system-group} field of the @code{files-config} configuration,
+which is reified into the @code{cups-files.conf(5)} file. Other
+possible elements of the access list include specific user names, and
+@code{@@@var{group}} to indicate members of a specific group. The
+access list may also be simply @code{all} or @code{default}.
+
+Defaults to @samp{"@@OWNER @@SYSTEM"}.
+@end deftypevr
+
+@deftypevr {@code{policy-configuration} parameter} string job-private-values
+Specifies the list of job values to make private, or @code{all},
+@code{default}, or @code{none}.
+
+Defaults to @samp{"job-name job-originating-host-name
+job-originating-user-name phone"}.
+@end deftypevr
+
+@deftypevr {@code{policy-configuration} parameter} string subscription-private-access
+Specifies an access list for a subscription's private values.
+@code{@@ACL} maps to the printer's requesting-user-name-allowed or
+requesting-user-name-denied values. @code{@@OWNER} maps to the job's
+owner. @code{@@SYSTEM} maps to the groups listed for the
+@code{system-group} field of the @code{files-config} configuration,
+which is reified into the @code{cups-files.conf(5)} file. Other
+possible elements of the access list include specific user names, and
+@code{@@@var{group}} to indicate members of a specific group. The
+access list may also be simply @code{all} or @code{default}.
+
+Defaults to @samp{"@@OWNER @@SYSTEM"}.
+@end deftypevr
+
+@deftypevr {@code{policy-configuration} parameter} string subscription-private-values
+Specifies the list of job values to make private, or @code{all},
+@code{default}, or @code{none}.
+
+Defaults to @samp{"notify-events notify-pull-method notify-recipient-uri
+notify-subscriber-user-name notify-user-data"}.
+@end deftypevr
+
+@deftypevr {@code{policy-configuration} parameter} operation-access-control-list access-controls
+Access control by IPP operation.
+
+Defaults to @samp{()}.
+@end deftypevr
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean-or-non-negative-integer preserve-job-files
+Specifies whether job files (documents) are preserved after a job is
+printed. If a numeric value is specified, job files are preserved for
+the indicated number of seconds after printing. Otherwise a boolean
+value applies indefinitely.
+
+Defaults to @samp{86400}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean-or-non-negative-integer preserve-job-history
+Specifies whether the job history is preserved after a job is printed.
+If a numeric value is specified, the job history is preserved for the
+indicated number of seconds after printing. If @code{#t}, the job
+history is preserved until the MaxJobs limit is reached.
+
+Defaults to @samp{#t}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer reload-timeout
+Specifies the amount of time to wait for job completion before
+restarting the scheduler.
+
+Defaults to @samp{30}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string rip-cache
+Specifies the maximum amount of memory to use when converting documents
+into bitmaps for a printer.
+
+Defaults to @samp{"128m"}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string server-admin
+Specifies the email address of the server administrator.
+
+Defaults to @samp{"root@@localhost.localdomain"}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} host-name-list-or-* server-alias
+The ServerAlias directive is used for HTTP Host header validation when
+clients connect to the scheduler from external interfaces. Using the
+special name @code{*} can expose your system to known browser-based DNS
+rebinding attacks, even when accessing sites through a firewall. If the
+auto-discovery of alternate names does not work, we recommend listing
+each alternate name with a ServerAlias directive instead of using
+@code{*}.
+
+Defaults to @samp{*}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string server-name
+Specifies the fully-qualified host name of the server.
+
+Defaults to @samp{"localhost"}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} server-tokens server-tokens
+Specifies what information is included in the Server header of HTTP
+responses. @code{None} disables the Server header. @code{ProductOnly}
+reports @code{CUPS}. @code{Major} reports @code{CUPS 2}. @code{Minor}
+reports @code{CUPS 2.0}. @code{Minimal} reports @code{CUPS 2.0.0}.
+@code{OS} reports @code{CUPS 2.0.0 (@var{uname})} where @var{uname} is
+the output of the @code{uname} command. @code{Full} reports @code{CUPS
+2.0.0 (@var{uname}) IPP/2.0}.
+
+Defaults to @samp{Minimal}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} string set-env
+Set the specified environment variable to be passed to child processes.
+
+Defaults to @samp{"variable value"}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} multiline-string-list ssl-listen
+Listens on the specified interfaces for encrypted connections. Valid
+values are of the form @var{address}:@var{port}, where @var{address} is
+either an IPv6 address enclosed in brackets, an IPv4 address, or
+@code{*} to indicate all addresses.
+
+Defaults to @samp{()}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} ssl-options ssl-options
+Sets encryption options. By default, CUPS only supports encryption
+using TLS v1.0 or higher using known secure cipher suites. The
+@code{AllowRC4} option enables the 128-bit RC4 cipher suites, which are
+required for some older clients that do not implement newer ones. The
+@code{AllowSSL3} option enables SSL v3.0, which is required for some
+older clients that do not support TLS v1.0.
+
+Defaults to @samp{()}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean strict-conformance?
+Specifies whether the scheduler requires clients to strictly adhere to
+the IPP specifications.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} non-negative-integer timeout
+Specifies the HTTP request timeout, in seconds.
+
+Defaults to @samp{300}.
+
+@end deftypevr
+
+@deftypevr {@code{cups-configuration} parameter} boolean web-interface?
+Specifies whether the web interface is enabled.
+
+Defaults to @samp{#f}.
+@end deftypevr
+
+At this point you're probably thinking ``oh dear, Guix manual, I like
+you but you can stop already with the configuration options''. Indeed.
+However, one more point: it could be that you have an existing
+@code{cupsd.conf} that you want to use. In that case, you can pass an
+@code{opaque-cups-configuration} as the configuration of a
+@code{cups-service-type}.
+
+Available @code{opaque-cups-configuration} fields are:
+
+@deftypevr {@code{opaque-cups-configuration} parameter} package cups
+The CUPS package.
+@end deftypevr
+
+@deftypevr {@code{opaque-cups-configuration} parameter} string cupsd.conf
+The contents of the @code{cupsd.conf}, as a string.
+@end deftypevr
+
+@deftypevr {@code{opaque-cups-configuration} parameter} string cups-files.conf
+The contents of the @code{cups-files.conf} file, as a string.
+@end deftypevr
+
+For example, if your @code{cupsd.conf} and @code{cups-files.conf} are in
+strings of the same name, you could instantiate a CUPS service like
+this:
+
+@example
+(service cups-service-type
+ (opaque-cups-configuration
+ (cupsd.conf cupsd.conf)
+ (cups-files.conf cups-files.conf)))
+@end example
+
+
@node Desktop Services
@subsubsection Desktop Services
diff --git a/gnu/local.mk b/gnu/local.mk
index a609bf6..0e35e8a 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -388,6 +388,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/admin.scm \
%D%/services/avahi.scm \
%D%/services/base.scm \
+ %D%/services/cups.scm \
%D%/services/databases.scm \
%D%/services/dbus.scm \
%D%/services/desktop.scm \
diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
new file mode 100644
index 0000000..aa82d5c
--- /dev/null
+++ b/gnu/services/cups.scm
@@ -0,0 +1,1165 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Andy Wingo <wingo@pobox.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services cups)
+ #:use-module (gnu services)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu packages admin)
+ #:use-module (gnu packages cups)
+ #:use-module (gnu packages tls)
+ #:use-module (guix packages)
+ #:use-module (guix records)
+ #:use-module (guix gexp)
+ #:use-module (texinfo)
+ #:use-module (texinfo serialize)
+ #:use-module (ice-9 match)
+ #:use-module ((srfi srfi-1) #:select (append-map))
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:export (&cups-configuation-error
+ cups-configuration-error?
+
+ cups-service-type
+ cups-configuration
+ opaque-cups-configuration
+
+ files-configuration
+ policy-configuration
+ location-access-control
+ operation-access-control
+ method-access-control))
+
+;;; Commentary:
+;;;
+;;; Service defininition for the CUPS printing system.
+;;;
+;;; Code:
+
+(define-condition-type &cups-configuration-error &error
+ cups-configuration-error?)
+
+(define (cups-error message)
+ (raise (condition (&message (message message))
+ (&cups-configuration-error))))
+(define (cups-configuration-field-error field val)
+ (cups-error
+ (format #f "Invalid value for field ~a: ~s" field val)))
+(define (cups-configuration-missing-field kind field)
+ (cups-error
+ (format #f "~a configuration missing required field ~a" kind field)))
+
+(define-record-type* <configuration-field>
+ configuration-field make-configuration-field configuration-field?
+ (name configuration-field-name)
+ (type configuration-field-type)
+ (getter configuration-field-getter)
+ (predicate configuration-field-predicate)
+ (serializer configuration-field-serializer)
+ (default-value-thunk configuration-field-default-value-thunk)
+ (documentation configuration-field-documentation))
+
+(define (serialize-configuration config fields)
+ (for-each (lambda (field)
+ ((configuration-field-serializer field)
+ (configuration-field-name field)
+ ((configuration-field-getter field) config)))
+ fields))
+
+(define (validate-configuration config fields)
+ (for-each (lambda (field)
+ (let ((val ((configuration-field-getter field) config)))
+ (unless ((configuration-field-predicate field) val)
+ (cups-configuration-field-error
+ (configuration-field-name field) val))))
+ fields))
+
+(define-syntax define-configuration
+ (lambda (stx)
+ (define (id ctx part . parts)
+ (let ((part (syntax->datum part)))
+ (datum->syntax
+ ctx
+ (match parts
+ (() part)
+ (parts (symbol-append part
+ (syntax->datum (apply id ctx parts))))))))
+ (syntax-case stx ()
+ ((_ stem (field (field-type def) doc) ...)
+ (with-syntax (((field-getter ...)
+ (map (lambda (field)
+ (id #'stem #'stem #'- field))
+ #'(field ...)))
+ ((field-predicate ...)
+ (map (lambda (type)
+ (id #'stem type #'?))
+ #'(field-type ...)))
+ ((field-serializer ...)
+ (map (lambda (type)
+ (id #'stem #'serialize- type))
+ #'(field-type ...))))
+ #`(begin
+ (define-record-type* #,(id #'stem #'< #'stem #'>)
+ #,(id #'stem #'% #'stem)
+ #,(id #'stem #'make- #'stem)
+ #,(id #'stem #'stem #'?)
+ (field field-getter (default def))
+ ...)
+ (define #,(id #'stem #'stem #'-fields)
+ (list (configuration-field
+ (name 'field)
+ (type 'field-type)
+ (getter field-getter)
+ (predicate field-predicate)
+ (serializer field-serializer)
+ (default-value-thunk (lambda () def))
+ (documentation doc))
+ ...))
+ (define-syntax-rule (stem arg (... ...))
+ (let ((conf (#,(id #'stem #'% #'stem) arg (... ...))))
+ (validate-configuration conf
+ #,(id #'stem #'stem #'-fields))
+ conf))))))))
+
+(define %cups-accounts
+ (list (user-group (name "lp") (system? #t))
+ (user-group (name "lpadmin") (system? #t))
+ (user-account
+ (name "lp")
+ (group "lp")
+ (system? #t)
+ (comment "System user for invoking printing helper programs")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define (uglify-field-name field-name)
+ (let ((str (symbol->string field-name)))
+ (string-concatenate
+ (map string-titlecase
+ (string-split (if (string-suffix? "?" str)
+ (substring str 0 (1- (string-length str)))
+ str)
+ #\-)))))
+
+(define (serialize-field field-name val)
+ (format #t "~a ~a\n" (uglify-field-name field-name) val))
+
+(define (serialize-package field-name val)
+ #f)
+
+(define (serialize-string field-name val)
+ (serialize-field field-name val))
+
+(define (multiline-string-list? val)
+ (and (list? val)
+ (and-map (lambda (x)
+ (and (string? x) (not (string-index x #\space))))
+ val)))
+(define (serialize-multiline-string-list field-name val)
+ (for-each (lambda (str) (serialize-field field-name str)) val))
+
+(define (space-separated-string-list? val)
+ (and (list? val)
+ (and-map (lambda (x)
+ (and (string? x) (not (string-index x #\space))))
+ val)))
+(define (serialize-space-separated-string-list field-name val)
+ (serialize-field field-name (string-join val " ")))
+
+(define (space-separated-symbol-list? val)
+ (and (list? val) (and-map symbol? val)))
+(define (serialize-space-separated-symbol-list field-name val)
+ (serialize-field field-name (string-join (map symbol->string val) " ")))
+
+(define (file-name? val)
+ (and (string? val)
+ (string-prefix? "/" val)))
+(define (serialize-file-name field-name val)
+ (serialize-string field-name val))
+
+(define (serialize-boolean field-name val)
+ (serialize-string field-name (if val "yes" "no")))
+
+(define (non-negative-integer? val)
+ (and (exact-integer? val) (not (negative? val))))
+(define (serialize-non-negative-integer field-name val)
+ (serialize-field field-name val))
+
+(define-syntax define-enumerated-field-type
+ (lambda (x)
+ (define (id-append ctx . parts)
+ (datum->syntax ctx (apply symbol-append (map syntax->datum parts))))
+ (syntax-case x ()
+ ((_ name (option ...))
+ #`(begin
+ (define (#,(id-append #'name #'name #'?) x)
+ (memq x '(option ...)))
+ (define (#,(id-append #'name #'serialize- #'name) field-name val)
+ (serialize-field field-name val)))))))
+
+(define-enumerated-field-type access-log-level
+ (config actions all))
+(define-enumerated-field-type browse-local-protocols
+ (all dnssd none))
+(define-enumerated-field-type default-auth-type
+ (Basic Negotiate))
+(define-enumerated-field-type default-encryption
+ (Never IfRequested Required))
+(define-enumerated-field-type error-policy
+ (abort-job retry-job retry-this-job stop-printer))
+(define-enumerated-field-type log-level
+ (none emerg alert crit error warn notice info debug debug2))
+(define-enumerated-field-type log-time-format
+ (standard usecs))
+(define-enumerated-field-type server-tokens
+ (None ProductOnly Major Minor Minimal OS Full))
+(define-enumerated-field-type method
+ (DELETE GET HEAD OPTIONS POST PUT TRACE))
+(define-enumerated-field-type sandboxing
+ (relaxed strict))
+
+(define (method-list? val)
+ (and (list? val) (and-map method? val)))
+(define (serialize-method-list field-name val)
+ (serialize-field field-name (string-join (map symbol->string val) " ")))
+
+(define (host-name-lookups? val)
+ (memq val '(#f #t 'double)))
+(define (serialize-host-name-lookups field-name val)
+ (serialize-field field-name
+ (match val (#f "No") (#t "Yes") ('double "Double"))))
+
+(define (host-name-list-or-*? x)
+ (or (eq? x '*)
+ (and (list? x) (and-map string? x))))
+(define (serialize-host-name-list-or-* field-name val)
+ (serialize-field field-name (match val
+ ('* '*)
+ (names (string-join names " ")))))
+
+(define (boolean-or-non-negative-integer? x)
+ (or (boolean? x) (non-negative-integer? x)))
+(define (serialize-boolean-or-non-negative-integer field-name x)
+ (if (boolean? x)
+ (serialize-boolean field-name x)
+ (serialize-non-negative-integer field-name x)))
+
+(define (ssl-options? x)
+ (and (list? x)
+ (and-map (lambda (elt) (memq elt '(AllowRC4 AllowSSL3))) x)))
+(define (serialize-ssl-options field-name val)
+ (serialize-field field-name
+ (match val
+ (() "None")
+ (opts (string-join (map symbol->string opts) " ")))))
+
+(define (serialize-access-control x)
+ (display x)
+ (newline))
+(define (serialize-access-control-list field-name val)
+ (for-each serialize-access-control val))
+(define (access-control-list? val)
+ (and (list? val) (and-map string? val)))
+
+(define-configuration operation-access-control
+ (operations
+ (space-separated-symbol-list '())
+ "IPP operations to which this access control applies.")
+ (access-controls
+ (access-control-list '())
+ "Access control directives, as a list of strings. Each string should be one directive, such as \"Order allow,deny\"."))
+
+(define-configuration method-access-control
+ (reverse?
+ (boolean #f)
+ "If @code{#t}, apply access controls to all methods except the listed
+methods. Otherwise apply to only the listed methods.")
+ (methods
+ (method-list '())
+ "Methods to which this access control applies.")
+ (access-controls
+ (access-control-list '())
+ "Access control directives, as a list of strings. Each string should be one directive, such as \"Order allow,deny\"."))
+
+(define (serialize-operation-access-control x)
+ (format #t "<Limit ~a>\n"
+ (string-join (map symbol->string
+ (operation-access-control-operations x)) " "))
+ (serialize-configuration
+ x
+ (filter (lambda (field)
+ (not (eq? (configuration-field-name field) 'operations)))
+ operation-access-control-fields))
+ (format #t "</Limit>\n"))
+
+(define (serialize-method-access-control x)
+ (let ((limit (if (method-access-control-reverse? x) "LimitExcept" "Limit")))
+ (format #t "<~a ~a>\n" limit
+ (string-join (map symbol->string
+ (method-access-control-methods x)) " "))
+ (serialize-configuration
+ x
+ (filter (lambda (field)
+ (case (configuration-field-name field)
+ ((reverse? methods) #f)
+ (else #t)))
+ method-access-control-fields))
+ (format #t "</~a>\n" limit)))
+
+(define (operation-access-control-list? val)
+ (and (list? val) (and-map operation-access-control? val)))
+(define (serialize-operation-access-control-list field-name val)
+ (for-each serialize-operation-access-control val))
+
+(define (method-access-control-list? val)
+ (and (list? val) (and-map method-access-control? val)))
+(define (serialize-method-access-control-list field-name val)
+ (for-each serialize-method-access-control val))
+
+(define-configuration location-access-control
+ (path
+ (file-name (cups-configuration-missing-field 'location-access-control 'path))
+ "Specifies the URI path to which the access control applies.")
+ (access-controls
+ (access-control-list '())
+ "Access controls for all access to this path, in the same format as the
+@code{access-controls} of @code{operation-access-control}.")
+ (method-access-controls
+ (method-access-control-list '())
+ "Access controls for method-specific access to this path."))
+
+(define (serialize-location-access-control x)
+ (format #t "<Location ~a>\n" (location-access-control-path x))
+ (serialize-configuration
+ x
+ (filter (lambda (field)
+ (not (eq? (configuration-field-name field) 'path)))
+ location-access-control-fields))
+ (format #t "</Location>\n"))
+
+(define (location-access-control-list? val)
+ (and (list? val) (and-map location-access-control? val)))
+(define (serialize-location-access-control-list field-name val)
+ (for-each serialize-location-access-control val))
+
+(define-configuration policy-configuration
+ (name
+ (string (cups-configuration-missing-field 'policy-configuration 'name))
+ "Name of the policy.")
+ (job-private-access
+ (string "@OWNER @SYSTEM")
+ "Specifies an access list for a job's private values. @code{@@ACL} maps to
+the printer's requesting-user-name-allowed or requesting-user-name-denied
+values. @code{@@OWNER} maps to the job's owner. @code{@@SYSTEM} maps to the
+groups listed for the @code{system-group} field of the @code{files-config}
+configuration, which is reified into the @code{cups-files.conf(5)} file.
+Other possible elements of the access list include specific user names, and
+@code{@@@var{group}} to indicate members of a specific group. The access list
+may also be simply @code{all} or @code{default}.")
+ (job-private-values
+ (string (string-join '("job-name" "job-originating-host-name"
+ "job-originating-user-name" "phone")))
+ "Specifies the list of job values to make private, or @code{all},
+@code{default}, or @code{none}.")
+
+ (subscription-private-access
+ (string "@OWNER @SYSTEM")
+ "Specifies an access list for a subscription's private values.
+@code{@@ACL} maps to the printer's requesting-user-name-allowed or
+requesting-user-name-denied values. @code{@@OWNER} maps to the job's owner.
+@code{@@SYSTEM} maps to the groups listed for the @code{system-group} field of
+the @code{files-config} configuration, which is reified into the
+@code{cups-files.conf(5)} file. Other possible elements of the access list
+include specific user names, and @code{@@@var{group}} to indicate members of a
+specific group. The access list may also be simply @code{all} or
+@code{default}.")
+ (subscription-private-values
+ (string (string-join '("notify-events" "notify-pull-method"
+ "notify-recipient-uri" "notify-subscriber-user-name"
+ "notify-user-data")
+ " "))
+ "Specifies the list of job values to make private, or @code{all},
+@code{default}, or @code{none}.")
+
+ (access-controls
+ (operation-access-control-list '())
+ "Access control by IPP operation."))
+
+(define (serialize-policy-configuration x)
+ (format #t "<Policy ~a>\n" (policy-configuration-name x))
+ (serialize-configuration
+ x
+ (filter (lambda (field)
+ (not (eq? (configuration-field-name field) 'name)))
+ policy-configuration-fields))
+ (format #t "</Policy>\n"))
+
+(define (policy-configuration-list? x)
+ (and (list? x) (and-map policy-configuration? x)))
+(define (serialize-policy-configuration-list field-name x)
+ (for-each serialize-policy-configuration x))
+
+(define (log-location? x)
+ (or (file-name? x)
+ (eq? x 'stderr)
+ (eq? x 'syslog)))
+(define (serialize-log-location field-name x)
+ (if (string? x)
+ (serialize-file-name field-name x)
+ (serialize-field field-name x)))
+
+(define-configuration files-configuration
+ (access-log
+ (log-location "/var/log/cups/access_log")
+ "Defines the access log filename. Specifying a blank filename disables
+access log generation. The value @code{stderr} causes log entries to be sent
+to the standard error file when the scheduler is running in the foreground, or
+to the system log daemon when run in the background. The value @code{syslog}
+causes log entries to be sent to the system log daemon. The server name may
+be included in filenames using the string @code{%s}, as in
+@code{/var/log/cups/%s-access_log}.")
+ (cache-dir
+ (file-name "/var/cache/cups")
+ "Where CUPS should cache data.")
+ (config-file-perm
+ (string "0640")
+ "Specifies the permissions for all configuration files that the scheduler
+writes.
+
+Note that the permissions for the printers.conf file are currently masked to
+only allow access from the scheduler user (typically root). This is done
+because printer device URIs sometimes contain sensitive authentication
+information that should not be generally known on the system. There is no way
+to disable this security feature.")
+ ;; Not specifying data-dir and server-bin options as we handle these
+ ;; manually. For document-root, the CUPS package has that path
+ ;; preconfigured.
+ (error-log
+ (log-location "/var/log/cups/error_log")
+ "Defines the error log filename. Specifying a blank filename disables
+access log generation. The value @code{stderr} causes log entries to be sent
+to the standard error file when the scheduler is running in the foreground, or
+to the system log daemon when run in the background. The value @code{syslog}
+causes log entries to be sent to the system log daemon. The server name may
+be included in filenames using the string @code{%s}, as in
+@code{/var/log/cups/%s-error_log}.")
+ (fatal-errors
+ (string "all -browse")
+ "Specifies which errors are fatal, causing the scheduler to exit. The kind
+strings are:
+@table @code
+@item none
+No errors are fatal.
+@item all
+All of the errors below are fatal.
+@item browse
+Browsing initialization errors are fatal, for example failed connections to
+the DNS-SD daemon.
+@item config
+Configuration file syntax errors are fatal.
+@item listen
+Listen or Port errors are fatal, except for IPv6 failures on the loopback or
+@code{any} addresses.
+@item log
+Log file creation or write errors are fatal.
+@item permissions
+Bad startup file permissions are fatal, for example shared TLS certificate and
+key files with world-read permissions.
+@end table")
+ (file-device?
+ (boolean #f)
+ "Specifies whether the file pseudo-device can be used for new printer
+queues. The URI @url{file:///dev/null} is always allowed.")
+ (group
+ (string "lp")
+ "Specifies the group name or ID that will be used when executing external
+programs.")
+ (log-file-perm
+ (string "0644")
+ "Specifies the permissions for all log files that the scheduler writes.")
+ (page-log
+ (log-location "/var/log/cups/page_log")
+ "Defines the page log filename. Specifying a blank filename disables
+access log generation. The value @code{stderr} causes log entries to be sent
+to the standard error file when the scheduler is running in the foreground, or
+to the system log daemon when run in the background. The value @code{syslog}
+causes log entries to be sent to the system log daemon. The server name may
+be included in filenames using the string @code{%s}, as in
+@code{/var/log/cups/%s-page_log}.")
+ (remote-root
+ (string "remroot")
+ "Specifies the username that is associated with unauthenticated accesses by
+clients claiming to be the root user. The default is @code{remroot}.")
+ (request-root
+ (file-name "/var/spool/cups")
+ "Specifies the directory that contains print jobs and other HTTP request
+data.")
+ (sandboxing
+ (sandboxing 'strict)
+ "Specifies the level of security sandboxing that is applied to print
+filters, backends, and other child processes of the scheduler; either
+@code{relaxed} or @code{strict}. This directive is currently only
+used/supported on macOS.")
+ (server-keychain
+ (file-name "/etc/cups/ssl")
+ "Specifies the location of TLS certificates and private keys. CUPS will
+look for public and private keys in this directory: a @code{.crt} files for
+PEM-encoded certificates and corresponding @code{.key} files for PEM-encoded
+private keys.")
+ (server-root
+ (file-name "/etc/cups")
+ "Specifies the directory containing the server configuration files.")
+ (sync-on-close?
+ (boolean #f)
+ "Specifies whether the scheduler calls fsync(2) after writing configuration
+or state files.")
+ (system-group
+ (space-separated-string-list '("lpadmin" "wheel" "root"))
+ "Specifies the group(s) to use for @code{@@SYSTEM} group authentication.")
+ (temp-dir
+ (file-name "/var/spool/cups/tmp")
+ "Specifies the directory where temporary files are stored.")
+ (user
+ (string "lp")
+ "Specifies the user name or ID that is used when running external
+programs."))
+
+(define (serialize-files-configuration field-name val)
+ #f)
+
+(define (environment-variables? vars)
+ (space-separated-string-list? vars))
+(define (serialize-environment-variables field-name vars)
+ (unless (null? vars)
+ (serialize-space-separated-string-list field-name vars)))
+
+(define (package-list? val)
+ (and (list? val) (and-map package? val)))
+(define (serialize-package-list field-name val)
+ #f)
+
+(define-configuration cups-configuration
+ (cups
+ (package cups)
+ "The CUPS package.")
+ (extensions
+ (package-list (list cups-filters))
+ "Drivers and other extensions to the CUPS package.")
+ (files-configuration
+ (files-configuration (files-configuration))
+ "Configuration of where to write logs, what directories to use for print
+spools, and related privileged configuration parameters.")
+ (access-log-level
+ (access-log-level 'actions)
+ "Specifies the logging level for the AccessLog file. The @code{config}
+level logs when printers and classes are added, deleted, or modified and when
+configuration files are accessed or updated. The @code{actions} level logs
+when print jobs are submitted, held, released, modified, or canceled, and any
+of the conditions for @code{config}. The @code{all} level logs all
+requests.")
+ (auto-purge-jobs?
+ (boolean #f)
+ "Specifies whether to purge job history data automatically when it is no
+longer required for quotas.")
+ (browse-local-protocols
+ (browse-local-protocols 'dnssd)
+ "Specifies which protocols to use for local printer sharing.")
+ (browse-web-if?
+ (boolean #f)
+ "Specifies whether the CUPS web interface is advertised.")
+ (browsing?
+ (boolean #f)
+ "Specifies whether shared printers are advertised.")
+ (classification
+ (string "")
+ "Specifies the security classification of the server.
+Any valid banner name can be used, including \"classified\", \"confidential\",
+\"secret\", \"topsecret\", and \"unclassified\", or the banner can be omitted
+to disable secure printing functions.")
+ (classify-override?
+ (boolean #f)
+ "Specifies whether users may override the classification (cover page) of
+individual print jobs using the @code{job-sheets} option.")
+ (default-auth-type
+ (default-auth-type 'Basic)
+ "Specifies the default type of authentication to use.")
+ (default-encryption
+ (default-encryption 'Required)
+ "Specifies whether encryption will be used for authenticated requests.")
+ (default-language
+ (string "en")
+ "Specifies the default language to use for text and web content.")
+ (default-paper-size
+ (string "Auto")
+ "Specifies the default paper size for new print queues. \"Auto\" uses a
+locale-specific default, while \"None\" specifies there is no default paper
+size. Specific size names are typically \"Letter\" or \"A4\".")
+ (default-policy
+ (string "default")
+ "Specifies the default access policy to use.")
+ (default-shared?
+ (boolean #t)
+ "Specifies whether local printers are shared by default.")
+ (dirty-clean-interval
+ (non-negative-integer 30)
+ "Specifies the delay for updating of configuration and state files, in
+seconds. A value of 0 causes the update to happen as soon as possible,
+typically within a few milliseconds.")
+ (error-policy
+ (error-policy 'stop-printer)
+ "Specifies what to do when an error occurs. Possible values are
+@code{abort-job}, which will discard the failed print job; @code{retry-job},
+which will retry the job at a later time; @code{retry-this-job}, which retries
+the failed job immediately; and @code{stop-printer}, which stops the
+printer.")
+ (filter-limit
+ (non-negative-integer 0)
+ "Specifies the maximum cost of filters that are run concurrently, which can
+be used to minimize disk, memory, and CPU resource problems. A limit of 0
+disables filter limiting. An average print to a non-PostScript printer needs
+a filter limit of about 200. A PostScript printer needs about half
+that (100). Setting the limit below these thresholds will effectively limit
+the scheduler to printing a single job at any time.")
+ (filter-nice
+ (non-negative-integer 0)
+ "Specifies the scheduling priority of filters that are run to print a job.
+The nice value ranges from 0, the highest priority, to 19, the lowest
+priority.")
+ ;; Add this option if the package is built with Kerberos support.
+ ;; (gss-service-name
+ ;; (string "http")
+ ;; "Specifies the service name when using Kerberos authentication.")
+ (host-name-lookups
+ (host-name-lookups #f)
+ "Specifies whether to do reverse lookups on connecting clients.
+The @code{double} setting causes @code{cupsd} to verify that the hostname
+resolved from the address matches one of the addresses returned for that
+hostname. Double lookups also prevent clients with unregistered addresses
+from connecting to your server. Only set this option to @code{#t} or
+@code{double} if absolutely required.")
+ ;; Add this option if the package is built with launchd/systemd support.
+ ;; (idle-exit-timeout
+ ;; (non-negative-integer 60)
+ ;; "Specifies the length of time to wait before shutting down due to
+ ;; inactivity. Note: Only applicable when @code{cupsd} is run on-demand
+ ;; (e.g., with @code{-l}).")
+ (job-kill-delay
+ (non-negative-integer 30)
+ "Specifies the number of seconds to wait before killing the filters and
+backend associated with a canceled or held job.")
+ (job-retry-interval
+ (non-negative-integer 30)
+ "Specifies the interval between retries of jobs in seconds. This is
+typically used for fax queues but can also be used with normal print queues
+whose error policy is @code{retry-job} or @code{retry-current-job}.")
+ (job-retry-limit
+ (non-negative-integer 5)
+ "Specifies the number of retries that are done for jobs. This is typically
+used for fax queues but can also be used with normal print queues whose error
+policy is @code{retry-job} or @code{retry-current-job}.")
+ (keep-alive?
+ (boolean #t)
+ "Specifies whether to support HTTP keep-alive connections.")
+ (keep-alive-timeout
+ (non-negative-integer 30)
+ "Specifies how long an idle client connection remains open, in seconds.")
+ (limit-request-body
+ (non-negative-integer 0)
+ "Specifies the maximum size of print files, IPP requests, and HTML form
+data. A limit of 0 disables the limit check.")
+ (listen
+ (multiline-string-list '("localhost:631" "/var/run/cups/cups.sock"))
+ "Listens on the specified interfaces for connections. Valid values are of
+the form @var{address}:@var{port}, where @var{address} is either an IPv6
+address enclosed in brackets, an IPv4 address, or @code{*} to indicate all
+addresses. Values can also be file names of local UNIX domain sockets. The
+Listen directive is similar to the Port directive but allows you to restrict
+access to specific interfaces or networks.")
+ (listen-back-log
+ (non-negative-integer 128)
+ "Specifies the number of pending connections that will be allowed. This
+normally only affects very busy servers that have reached the MaxClients
+limit, but can also be triggered by large numbers of simultaneous connections.
+When the limit is reached, the operating system will refuse additional
+connections until the scheduler can accept the pending ones.")
+ (location-access-controls
+ (location-access-control-list
+ (list (location-access-control
+ (path "/")
+ (access-controls '("Order allow,deny"
+ "Allow localhost")))
+ (location-access-control
+ (path "/admin")
+ (access-controls '("Order allow,deny"
+ "Allow localhost")))
+ (location-access-control
+ (path "/admin/conf")
+ (access-controls '("Order allow,deny"
+ "AuthType Basic"
+ "Require user @SYSTEM"
+ "Allow localhost")))))
+ "Specifies a set of additional access controls.")
+ (log-debug-history
+ (non-negative-integer 100)
+ "Specifies the number of debugging messages that are retained for logging
+if an error occurs in a print job. Debug messages are logged regardless of
+the LogLevel setting.")
+ (log-level
+ (log-level 'info)
+ "Specifies the level of logging for the ErrorLog file. The value
+@code{none} stops all logging while @code{debug2} logs everything.")
+ (log-time-format
+ (log-time-format 'standard)
+ "Specifies the format of the date and time in the log files. The value
+@code{standard} logs whole seconds while @code{usecs} logs microseconds.")
+ (max-clients
+ (non-negative-integer 100)
+ "Specifies the maximum number of simultaneous clients that are allowed by
+the scheduler.")
+ (max-clients-per-host
+ (non-negative-integer 100)
+ "Specifies the maximum number of simultaneous clients that are allowed from
+a single address.")
+ (max-copies
+ (non-negative-integer 9999)
+ "Specifies the maximum number of copies that a user can print of each
+job.")
+ (max-hold-time
+ (non-negative-integer 0)
+ "Specifies the maximum time a job may remain in the @code{indefinite} hold
+state before it is canceled. A value of 0 disables cancellation of held
+jobs.")
+ (max-jobs
+ (non-negative-integer 500)
+ "Specifies the maximum number of simultaneous jobs that are allowed. Set
+to 0 to allow an unlimited number of jobs.")
+ (max-jobs-per-printer
+ (non-negative-integer 0)
+ "Specifies the maximum number of simultaneous jobs that are allowed per
+printer. A value of 0 allows up to MaxJobs jobs per printer.")
+ (max-jobs-per-user
+ (non-negative-integer 0)
+ "Specifies the maximum number of simultaneous jobs that are allowed per
+user. A value of 0 allows up to MaxJobs jobs per user.")
+ (max-job-time
+ (non-negative-integer 10800)
+ "Specifies the maximum time a job may take to print before it is canceled,
+in seconds. Set to 0 to disable cancellation of \"stuck\" jobs.")
+ (max-log-size
+ (non-negative-integer 1048576)
+ "Specifies the maximum size of the log files before they are rotated, in
+bytes. The value 0 disables log rotation.")
+ (multiple-operation-timeout
+ (non-negative-integer 300)
+ "Specifies the maximum amount of time to allow between files in a multiple
+file print job, in seconds.")
+ (page-log-format
+ (string "")
+ "Specifies the format of PageLog lines. Sequences beginning with
+percent (@samp{%}) characters are replaced with the corresponding information,
+while all other characters are copied literally. The following percent
+sequences are recognized:
+
+@table @samp
+@item %%
+insert a single percent character
+@item %@{name@}
+insert the value of the specified IPP attribute
+@item %C
+insert the number of copies for the current page
+@item %P
+insert the current page number
+@item %T
+insert the current date and time in common log format
+@item %j
+insert the job ID
+@item %p
+insert the printer name
+@item %u
+insert the username
+@end table
+
+A value of the empty string disables page logging. The string @code{%p %u %j
+%T %P %C %@{job-billing@} %@{job-originating-host-name@} %@{job-name@}
+%@{media@} %@{sides@}} creates a page log with the standard items.")
+ (environment-variables
+ (environment-variables '())
+ "Passes the specified environment variable(s) to child processes; a list of
+strings.")
+ (policies
+ (policy-configuration-list
+ (list (policy-configuration
+ (name "default")
+ (access-controls
+ (list
+ (operation-access-control
+ (operations
+ '(Send-Document
+ Send-URI Hold-Job Release-Job Restart-Job Purge-Jobs
+ Cancel-Job Close-Job Cancel-My-Jobs Set-Job-Attributes
+ Create-Job-Subscription Renew-Subscription
+ Cancel-Subscription Get-Notifications
+ Reprocess-Job Cancel-Current-Job Suspend-Current-Job
+ Resume-Job CUPS-Move-Job Validate-Job
+ CUPS-Get-Document))
+ (access-controls '("Require user @OWNER @SYSTEM"
+ "Order deny,allow")))
+ (operation-access-control
+ (operations
+ '(Pause-Printer
+ Cancel-Jobs
+ Resume-Printer Set-Printer-Attributes Enable-Printer
+ Disable-Printer Pause-Printer-After-Current-Job
+ Hold-New-Jobs Release-Held-New-Jobs Deactivate-Printer
+ Activate-Printer Restart-Printer Shutdown-Printer
+ Startup-Printer Promote-Job Schedule-Job-After
+ CUPS-Authenticate-Job CUPS-Add-Printer
+ CUPS-Delete-Printer CUPS-Add-Class CUPS-Delete-Class
+ CUPS-Accept-Jobs CUPS-Reject-Jobs CUPS-Set-Default))
+ (access-controls '("AuthType Basic"
+ "Require user @SYSTEM"
+ "Order deny,allow")))
+ (operation-access-control
+ (operations '(All))
+ (access-controls '("Order deny,allow"))))))))
+ "Specifies named access control policies.")
+ #;
+ (port
+ (non-negative-integer 631)
+ "Listens to the specified port number for connections.")
+ (preserve-job-files
+ (boolean-or-non-negative-integer 86400)
+ "Specifies whether job files (documents) are preserved after a job is
+printed. If a numeric value is specified, job files are preserved for the
+indicated number of seconds after printing. Otherwise a boolean value applies
+indefinitely.")
+ (preserve-job-history
+ (boolean-or-non-negative-integer #t)
+ "Specifies whether the job history is preserved after a job is printed.
+If a numeric value is specified, the job history is preserved for the
+indicated number of seconds after printing. If @code{#t}, the job history is
+preserved until the MaxJobs limit is reached.")
+ (reload-timeout
+ (non-negative-integer 30)
+ "Specifies the amount of time to wait for job completion before restarting
+the scheduler.")
+ (rip-cache
+ (string "128m")
+ "Specifies the maximum amount of memory to use when converting documents into bitmaps for a printer.")
+ (server-admin
+ (string "root@localhost.localdomain")
+ "Specifies the email address of the server administrator.")
+ (server-alias
+ (host-name-list-or-* '*)
+ "The ServerAlias directive is used for HTTP Host header validation when
+clients connect to the scheduler from external interfaces. Using the special
+name @code{*} can expose your system to known browser-based DNS rebinding
+attacks, even when accessing sites through a firewall. If the auto-discovery
+of alternate names does not work, we recommend listing each alternate name
+with a ServerAlias directive instead of using @code{*}.")
+ (server-name
+ (string "localhost")
+ "Specifies the fully-qualified host name of the server.")
+ (server-tokens
+ (server-tokens 'Minimal)
+ "Specifies what information is included in the Server header of HTTP
+responses. @code{None} disables the Server header. @code{ProductOnly}
+reports @code{CUPS}. @code{Major} reports @code{CUPS 2}. @code{Minor}
+reports @code{CUPS 2.0}. @code{Minimal} reports @code{CUPS 2.0.0}. @code{OS}
+reports @code{CUPS 2.0.0 (@var{uname})} where @var{uname} is the output of the
+@code{uname} command. @code{Full} reports @code{CUPS 2.0.0 (@var{uname})
+IPP/2.0}.")
+ (set-env
+ (string "variable value")
+ "Set the specified environment variable to be passed to child processes.")
+ (ssl-listen
+ (multiline-string-list '())
+ "Listens on the specified interfaces for encrypted connections. Valid
+values are of the form @var{address}:@var{port}, where @var{address} is either
+an IPv6 address enclosed in brackets, an IPv4 address, or @code{*} to indicate
+all addresses.")
+ (ssl-options
+ (ssl-options '())
+ "Sets encryption options.
+By default, CUPS only supports encryption using TLS v1.0 or higher using known
+secure cipher suites. The @code{AllowRC4} option enables the 128-bit RC4
+cipher suites, which are required for some older clients that do not implement
+newer ones. The @code{AllowSSL3} option enables SSL v3.0, which is required
+for some older clients that do not support TLS v1.0.")
+ #;
+ (ssl-port
+ (non-negative-integer 631)
+ "Listens on the specified port for encrypted connections.")
+ (strict-conformance?
+ (boolean #f)
+ "Specifies whether the scheduler requires clients to strictly adhere to the
+IPP specifications.")
+ (timeout
+ (non-negative-integer 300)
+ "Specifies the HTTP request timeout, in seconds.")
+ (web-interface?
+ (boolean #f)
+ "Specifies whether the web interface is enabled."))
+
+(define-configuration opaque-cups-configuration
+ (cups
+ (package cups)
+ "The CUPS package.")
+ (extensions
+ (package-list '())
+ "Drivers and other extensions to the CUPS package.")
+ (cupsd.conf
+ (string (cups-configuration-missing-field 'opaque-cups-configuration
+ 'cupsd.conf))
+ "The contents of the @code{cupsd.conf} to use.")
+ (cups-files.conf
+ (string (cups-configuration-missing-field 'opaque-cups-configuration
+ 'cups-files.conf))
+ "The contents of the @code{cups-files.conf} to use."))
+
+(define %cups-activation
+ ;; Activation gexp.
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (define (mkdir-p/perms directory owner perms)
+ (mkdir-p directory)
+ (chown "/var/run/cups" (passwd:uid owner) (passwd:gid owner))
+ (chmod directory perms))
+ (define (build-subject parameters)
+ (string-concatenate
+ (map (lambda (pair)
+ (let ((k (car pair)) (v (cdr pair)))
+ (define (escape-char str chr)
+ (string-join (string-split str chr) (string #\\ chr)))
+ (string-append "/" k "="
+ (escape-char (escape-char v #\=) #\/))))
+ (filter (lambda (pair) (cdr pair)) parameters))))
+ (define* (create-self-signed-certificate-if-absent
+ #:key private-key public-key (owner (getpwnam "root"))
+ (common-name (gethostname))
+ (organization-name "GuixSD")
+ (organization-unit-name "Default Self-Signed Certificate")
+ (subject-parameters `(("CN" . ,common-name)
+ ("O" . ,organization-name)
+ ("OU" . ,organization-unit-name)))
+ (subject (build-subject subject-parameters)))
+ ;; Note that by default, OpenSSL outputs keys in PEM format. This
+ ;; is what we want.
+ (unless (file-exists? private-key)
+ (cond
+ ((zero? (system* (string-append #$openssl "/bin/openssl")
+ "genrsa" "-out" private-key "2048"))
+ (chown private-key (passwd:uid owner) (passwd:gid owner))
+ (chmod private-key #o400))
+ (else
+ (format (current-error-port)
+ "Failed to create private key at ~a.\n" private-key))))
+ (unless (file-exists? public-key)
+ (cond
+ ((zero? (system* (string-append #$openssl "/bin/openssl")
+ "req" "-new" "-x509" "-key" private-key
+ "-out" public-key "-days" "3650"
+ "-batch" "-subj" subject))
+ (chown public-key (passwd:uid owner) (passwd:gid owner))
+ (chmod public-key #o444))
+ (else
+ (format (current-error-port)
+ "Failed to create public key at ~a.\n" public-key)))))
+ (let ((user (getpwnam "lp")))
+ (mkdir-p/perms "/var/run/cups" user #o755)
+ (mkdir-p/perms "/var/spool/cups" user #o755)
+ (mkdir-p/perms "/var/spool/cups/tmp" user #o755)
+ (mkdir-p/perms "/var/log/cups" user #o755)
+ (mkdir-p/perms "/etc/cups" user #o755)
+ (mkdir-p/perms "/etc/cups/ssl" user #o700)
+ ;; This certificate is used for HTTPS connections to the CUPS web
+ ;; interface.
+ (create-self-signed-certificate-if-absent
+ #:private-key "/etc/cups/ssl/localhost.key"
+ #:public-key "/etc/cups/ssl/localhost.crt"
+ #:owner (getpwnam "root")
+ #:common-name (format #f "CUPS service on ~a" (gethostname)))))))
+
+(define (union-directory name packages paths)
+ (computed-file
+ name
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-1))
+ (mkdir #$output)
+ (for-each
+ (lambda (package)
+ (for-each
+ (lambda (path)
+ (for-each
+ (lambda (src)
+ (let* ((tail (substring src (string-length package)))
+ (dst (string-append #$output tail)))
+ (mkdir-p (dirname dst))
+ ;; CUPS currently symlinks in some data from cups-filters
+ ;; to its output dir. Probably we should stop doing this
+ ;; and instead rely only on the CUPS service to union the
+ ;; relevant set of CUPS packages.
+ (if (file-exists? dst)
+ (format (current-error-port) "warning: ~a exists\n" dst)
+ (symlink src dst))))
+ (find-files (string-append package path))))
+ (list #$@paths)))
+ (list #$@packages))
+ #t))))
+
+(define (cups-server-bin-directory extensions)
+ "Return the CUPS ServerBin directory, containing binaries for CUPS and all
+extensions that it uses."
+ (union-directory "cups-server-bin" extensions
+ ;; /bin
+ '("/lib/cups" "/share/ppd" "/share/cups")))
+
+(define (cups-shepherd-service config)
+ "Return a list of <shepherd-service> for CONFIG."
+ (let* ((cupsd.conf-str
+ (cond
+ ((opaque-cups-configuration? config)
+ (opaque-cups-configuration-cupsd.conf config))
+ (else
+ (with-output-to-string
+ (lambda ()
+ (serialize-configuration config
+ cups-configuration-fields))))))
+ (cups-files.conf-str
+ (cond
+ ((opaque-cups-configuration? config)
+ (opaque-cups-configuration-cups-files.conf config))
+ (else
+ (with-output-to-string
+ (lambda ()
+ (serialize-configuration
+ (cups-configuration-files-configuration config)
+ files-configuration-fields))))))
+ (cups (if (opaque-cups-configuration? config)
+ (opaque-cups-configuration-cups config)
+ (cups-configuration-cups config)))
+ (server-bin
+ (cups-server-bin-directory
+ (cons cups
+ (cond
+ ((opaque-cups-configuration? config)
+ (opaque-cups-configuration-extensions config))
+ (else
+ (cups-configuration-extensions config))))))
+ ;;"SetEnv PATH " server-bin "/bin" "\n"
+ (cupsd.conf
+ (plain-file "cupsd.conf" cupsd.conf-str))
+ (cups-files.conf
+ (mixed-text-file
+ "cups-files.conf"
+ cups-files.conf-str
+ "CacheDir /var/cache/cups\n"
+ "StateDir /var/run/cups\n"
+ "DataDir " server-bin "/share/cups" "\n"
+ "ServerBin " server-bin "/lib/cups" "\n")))
+ (list (shepherd-service
+ (documentation "Run the CUPS print server.")
+ (provision '(cups))
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$cups "/sbin/cupsd")
+ "-f" "-c" #$cupsd.conf "-s" #$cups-files.conf)))
+ (stop #~(make-kill-destructor))))))
+
+(define cups-service-type
+ (service-type (name 'cups)
+ (extensions
+ (list (service-extension shepherd-root-service-type
+ cups-shepherd-service)
+ (service-extension activation-service-type
+ (const %cups-activation))
+ (service-extension account-service-type
+ (const %cups-accounts))))
+
+ ;; Extensions consist of lists of packages (representing CUPS
+ ;; drivers, etc) that we just concatenate.
+ (compose append)
+
+ ;; Add extension packages by augmenting the cups-configuration
+ ;; 'extensions' field.
+ (extend
+ (lambda (config extensions)
+ (cond
+ ((cups-configuration? config)
+ (cups-configuration
+ (inherit config)
+ (extensions
+ (append (cups-configuration-extensions config)
+ extensions))))
+ (else
+ (opaque-cups-configuration
+ (inherit config)
+ (extensions
+ (append (opaque-cups-configuration-extensions config)
+ extensions)))))))))
+
+;; A little helper to make it easier to document all those fields.
+(define (generate-documentation)
+ (define documentation
+ `((cups-configuration
+ ,cups-configuration-fields
+ (files-configuration files-configuration)
+ (policies policy-configuration)
+ (location-access-controls location-access-controls))
+ (files-configuration ,files-configuration-fields)
+ (policy-configuration
+ ,policy-configuration-fields
+ (operation-access-controls operation-access-controls))
+ (location-access-controls
+ ,location-access-control-fields
+ (method-access-controls method-access-controls))
+ (operation-access-controls ,operation-access-control-fields)
+ (method-access-controls ,method-access-control-fields)))
+ (define (str x) (object->string x))
+ (define (generate configuration-name)
+ (match (assq-ref documentation configuration-name)
+ ((fields . sub-documentation)
+ `((para "Available " (code ,(str configuration-name)) " fields are:")
+ ,@(map
+ (lambda (f)
+ (let ((field-name (configuration-field-name f))
+ (field-type (configuration-field-type f))
+ (field-docs (cdr (texi-fragment->stexi
+ (configuration-field-documentation f))))
+ (default (catch #t
+ (configuration-field-default-value-thunk f)
+ (lambda _ '%invalid))))
+ (define (show-default? val)
+ (or (string? default) (number? default) (boolean? default)
+ (and (symbol? val) (not (eq? val '%invalid)))
+ (and (list? val) (and-map show-default? val))))
+ `(deftypevr (% (category
+ (code ,(str configuration-name)) " parameter")
+ (data-type ,(str field-type))
+ (name ,(str field-name)))
+ ,@field-docs
+ ,@(if (show-default? default)
+ `((para "Defaults to " (samp ,(str default)) "."))
+ '())
+ ,@(append-map
+ generate
+ (or (assq-ref sub-documentation field-name) '())))))
+ fields)))))
+ (stexi->texi `(*fragment* . ,(generate 'cups-configuration))))
--
2.10.1
^ permalink raw reply related [flat|nested] 7+ messages in thread