gnu: Add openjdk12.

[jackhill/guix/guix.git] / gnu / services / cups.scm

diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index 391046a..9d21b6e 100644 (file)
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -1,5 +1,8 @@
 ;;; 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>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56,6 +59,21 @@
          (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)
@@ -64,11 +82,28 @@
 (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)
@@ -811,6 +846,7 @@ IPP specifications.")
   ;; 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))
@@ -827,7 +863,7 @@ IPP specifications.")
         (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)
@@ -860,6 +896,7 @@ IPP specifications.")
           (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
@@ -894,7 +931,7 @@ IPP specifications.")
                     (if (file-exists? dst)
                         (format (current-error-port) "warning: ~a exists\n" dst)
                         (symlink src dst))))
-                (find-files (string-append package path))))
+                (find-files (string-append package path) #:stat stat)))
              (list #$@paths)))
           (list #$@packages))
          #t))))
@@ -988,7 +1025,11 @@ extensions that it uses."
                       (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)