;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Andy Wingo <wingo@pobox.com>
+;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
+;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
(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-string field-name val)
+ (serialize-field field-name val))
+
(define (multiline-string-list? val)
(and (list? val)
(and-map (lambda (x)
(define (serialize-multiline-string-list field-name val)
(for-each (lambda (str) (serialize-field field-name str)) val))
+(define (comma-separated-string-list? val)
+ (and (list? val)
+ (and-map (lambda (x)
+ (and (string? x) (not (string-index x #\,))))
+ val)))
+(define (serialize-comma-separated-string-list field-name val)
+ (serialize-field field-name (string-join 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)
(define-enumerated-field-type default-encryption
(Never IfRequested Required))
(define-enumerated-field-type error-policy
- (abort-job retry-job retry-this-job stop-printer))
+ (abort-job retry-job retry-current-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
(define (ssl-options? x)
(and (list? x)
- (and-map (lambda (elt) (memq elt '(AllowRC4 AllowSSL3))) x)))
+ (and-map (lambda (elt) (memq elt '(AllowRC4
+ AllowSSL3
+ DenyCBC
+ DenyTLS1.0))) x)))
(define (serialize-ssl-options field-name val)
(serialize-field field-name
(match val
(user
(string "lp")
"Specifies the user name or ID that is used when running external
-programs."))
+programs.")
+ (set-env
+ (string "variable value")
+ "Set the specified environment variable to be passed to child processes."))
(define (serialize-files-configuration field-name val)
#f)
(package cups)
"The CUPS package.")
(extensions
- (package-list (list cups-filters))
+ (package-list (list cups-filters epson-inkjet-printer-escpr
+ foomatic-filters hplip-minimal splix))
"Drivers and other extensions to the CUPS package.")
(files-configuration
(files-configuration (files-configuration))
(boolean #f)
"Specifies whether to purge job history data automatically when it is no
longer required for quotas.")
+ (browse-dns-sd-sub-types
+ (comma-separated-string-list (list "_cups"))
+ "Specifies a list of DNS-SD sub-types to advertise for each shared printer.
+For example, @samp{\"_cups\" \"_print\"} will tell network clients that both
+CUPS sharing and IPP Everywhere are supported.")
(browse-local-protocols
(browse-local-protocols 'dnssd)
"Specifies which protocols to use for local printer sharing.")
(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
+which will retry the job at a later time; @code{retry-current-job}, which retries
the failed job immediately; and @code{stop-printer}, which stops the
printer.")
(filter-limit
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
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.")
+ "Sets encryption options. By default, CUPS only supports encryption
+using TLS v1.0 or higher using known secure cipher suites. Security is
+reduced when @code{Allow} options are used, and enhanced when @code{Deny}
+options are used. The @code{AllowRC4} option enables the 128-bit RC4 cipher
+suites, which are required for some older clients. The @code{AllowSSL3} option
+enables SSL v3.0, which is required for some older clients that do not support
+TLS v1.0. The @code{DenyCBC} option disables all CBC cipher suites. The
+@code{DenyTLS1.0} option disables TLS v1.0 support - this sets the minimum
+protocol version to TLS v1.1.")
#;
(ssl-port
(non-negative-integer 631)
;; Activation gexp.
(with-imported-modules '((guix build utils))
#~(begin
+ (use-modules (guix build utils))
(define (mkdir-p/perms directory owner perms)
(mkdir-p directory)
- (chown "/var/run/cups" (passwd:uid owner) (passwd:gid owner))
+ (chown directory (passwd:uid owner) (passwd:gid owner))
(chmod directory perms))
(define (build-subject parameters)
(string-concatenate
(define* (create-self-signed-certificate-if-absent
#:key private-key public-key (owner (getpwnam "root"))
(common-name (gethostname))
- (organization-name "GuixSD")
+ (organization-name "Guix")
(organization-unit-name "Default Self-Signed Certificate")
(subject-parameters `(("CN" . ,common-name)
("O" . ,organization-name)
(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 "/var/cache/cups" user #o770)
(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
(inherit config)
(extensions
(append (opaque-cups-configuration-extensions config)
- extensions)))))))))
+ extensions)))))))
+
+ (default-value (cups-configuration))
+ (description
+ "Run the CUPS print server.")))
;; A little helper to make it easier to document all those fields.
(define (generate-cups-documentation)
HCoop / jackhill / guix / guix.git / blobdiff