services: messaging: Prosody config supports file-like objects.

* doc/guix.texi (Messaging Services): Update accordingly. * gnu/services/configuration.scm (serialize-configuration, serialize-maybe-stem, serialize-package): Return strings or string-valued gexps (these procedures were only used for their side-effects). * gnu/services/messaging.scm (serialize-field, serialize-field-list, enclose-quotes, serialize-raw-content, serialize-ssl-configuration, serialize-virtualhost-configuration-list, serialize-int-component-configuration-list, serialize-ext-component-configuration-list, serialize-virtualhost-configuration, serialize-int-component-configuration, serialize-ext-component-configuration, serialize-prosody-configuration): Return strings or string-valued gexps and stop printing. (prosody-activation): Use SERIALIZE-PROSODY-CONFIGURATION's return value with MIXED-TEXT-FILE instead of using its output with PLAIN-FILE. (serialize-non-negative-integer, serialize-non-negative-integer-list): Convert numbers to strings. (file-object?, serialize-file-object, file-object-list?, serialize-file-object-list): New procedures. (ssl-configuration)[capath, cafile], (prosody-configuration)[plugin-paths, groups-file]: Replace FILE-NAME with FILE-OBJECT. * guix/gexp.scm (file-like?): New exported procedure.
2018-02-26 01:12:24 +01:00 · 2018-02-26 01:12:24 +01:00 · bdcf0e6fd4
parent fb547c3429
commit bdcf0e6fd4
4 changed files with 83 additions and 60 deletions
--- a/doc/guix.texi
+++ b/doc/guix.texi
@ -14258,6 +14258,9 @@ There is also a way to specify the configuration as a string, if you
 have an old @code{prosody.cfg.lua} file that you want to port over from
 some other system; see the end for more details.

+The @code{file-object} type designates either a file-like object
+(@pxref{G-Expressions, file-like objects}) or a file name.
+
@c The following documentation was initially generated by
@c (generate-documentation) in (gnu services messaging).  Manually maintained
@c documentation is better, so we shouldn't hesitate to edit below as
@ -14278,7 +14281,7 @@ Location of the Prosody data storage directory.  See
 Defaults to @samp{"/var/lib/prosody"}.
@end deftypevr

-@deftypevr {@code{prosody-configuration} parameter} file-name-list plugin-paths
+@deftypevr {@code{prosody-configuration} parameter} file-object-list plugin-paths
 Additional plugin directories.  They are searched in all the specified
 paths in order.  See @url{https://prosody.im/doc/plugins_directory}.
 Defaults to @samp{()}.
@ -14319,7 +14322,7 @@ should you want to disable them then add them to this list.
 Defaults to @samp{()}.
@end deftypevr

-@deftypevr {@code{prosody-configuration} parameter} file-name groups-file
+@deftypevr {@code{prosody-configuration} parameter} file-object groups-file
 Path to a text file where the shared groups are defined.  If this path is
 empty then @samp{mod_groups} does nothing.  See
@url{https://prosody.im/doc/modules/mod_groups}.
@ -14352,13 +14355,13 @@ Path to your private key file.
 Path to your certificate file.
@end deftypevr

-@deftypevr {@code{ssl-configuration} parameter} file-name capath
+@deftypevr {@code{ssl-configuration} parameter} file-object capath
 Path to directory containing root certificates that you wish Prosody to
 trust when verifying the certificates of remote servers.
 Defaults to @samp{"/etc/ssl/certs"}.
@end deftypevr

-@deftypevr {@code{ssl-configuration} parameter} maybe-file-name cafile
+@deftypevr {@code{ssl-configuration} parameter} maybe-file-object cafile
 Path to a file containing root certificates that you wish Prosody to trust.
 Similar to @code{capath} but with all certificates concatenated together.
@end deftypevr
@ -14618,6 +14621,8 @@ string, you could instantiate a prosody service like this:
          (prosody.cfg.lua "")))
@end example

+@c end of Prosody auto-generated documentation
+
@subsubheading BitlBee Service

@cindex IRC (Internet Relay Chat)
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
-;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@ -74,11 +74,12 @@
  (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))
+  #~(string-append
+     #$@(map (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)
@ -105,7 +106,7 @@
             (define (maybe-stem? val)
               (or (eq? val 'disabled) (stem? val)))
             (define (serialize-maybe-stem field-name val)
-               (when (stem? val) (serialize-stem field-name val)))))))))
+               (if (stem? val) (serialize-stem field-name val) ""))))))))

 (define-syntax define-configuration
  (lambda (stx)
@ -147,7 +148,7 @@
                   conf))))))))

 (define (serialize-package field-name val)
-  #f)
+  "")

 ;; A little helper to make it easier to document all those fields.
 (define (generate-documentation documentation documentation-name)
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;;
@ -115,16 +115,9 @@
                 "_")))

 (define (serialize-field field-name val)
-  (format #t "~a = ~a;\n" (uglify-field-name field-name) val))
+  #~(format #f "~a = ~a;\n" #$(uglify-field-name field-name) #$val))
 (define (serialize-field-list field-name val)
-  (serialize-field field-name
-                   (with-output-to-string
-                     (lambda ()
-                       (format #t "{\n")
-                       (for-each (lambda (x)
-                                   (format #t "~a;\n" x))
-                                 val)
-                       (format #t "}")))))
+  (serialize-field field-name #~(format #f "{\n~@{~a;\n~}}" #$@val)))

 (define (serialize-boolean field-name val)
  (serialize-field field-name (if val "true" "false")))
@ -140,17 +133,17 @@
 (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))
+  (serialize-field field-name (number->string val)))
 (define-maybe non-negative-integer)

 (define (non-negative-integer-list? val)
  (and (list? val) (and-map non-negative-integer? val)))
 (define (serialize-non-negative-integer-list field-name val)
-  (serialize-field-list field-name val))
+  (serialize-field-list field-name (map number->string val)))
 (define-maybe non-negative-integer-list)

 (define (enclose-quotes s)
-  (format #f "\"~a\"" s))
+  #~(string-append "\"" #$s "\""))
 (define (serialize-string field-name val)
  (serialize-field field-name (enclose-quotes val)))
 (define-maybe string)
@ -183,10 +176,22 @@
  (serialize-string-list field-name val))
 (define-maybe file-name)

+(define (file-object? val)
+  (or (file-like? val) (file-name? val)))
+(define (serialize-file-object field-name val)
+  (serialize-string field-name val))
+(define-maybe file-object)
+
+(define (file-object-list? val)
+  (and (list? val) (and-map file-object? val)))
+(define (serialize-file-object-list field-name val)
+  (serialize-string-list field-name val))
+(define-maybe file-object)
+
 (define (raw-content? val)
  (not (eq? val 'disabled)))
 (define (serialize-raw-content field-name val)
-  (format #t "~a" val))
+  val)
 (define-maybe raw-content)

 (define-configuration mod-muc-configuration
@ -224,12 +229,12 @@ just joined the room."))
   "Path to your certificate file.")

  (capath
-   (file-name "/etc/ssl/certs")
+   (file-object "/etc/ssl/certs")
   "Path to directory containing root certificates that you wish Prosody to
 trust when verifying the certificates of remote servers.")

  (cafile
-   (maybe-file-name 'disabled)
+   (maybe-file-object 'disabled)
   "Path to a file containing root certificates that you wish Prosody to trust.
 Similar to @code{capath} but with all certificates concatenated together.")

@ -273,9 +278,8 @@ can create such a file with:
   (maybe-string 'disabled)
   "Password for encrypted private keys."))
 (define (serialize-ssl-configuration field-name val)
-  (format #t "ssl = {\n")
-  (serialize-configuration val ssl-configuration-fields)
-  (format #t "};\n"))
+  #~(format #f "ssl = {\n~a};\n"
+            #$(serialize-configuration val ssl-configuration-fields)))
 (define-maybe ssl-configuration)

 (define %default-modules-enabled
@ -303,20 +307,23 @@ can create such a file with:
  (define (virtualhost-configuration-list? val)
    (and (list? val) (and-map virtualhost-configuration? val)))
  (define (serialize-virtualhost-configuration-list l)
-    (for-each
-     (lambda (val) (serialize-virtualhost-configuration val)) l))
+    #~(string-append
+       #$@(map (lambda (val)
+                 (serialize-virtualhost-configuration val)) l)))

  (define (int-component-configuration-list? val)
    (and (list? val) (and-map int-component-configuration? val)))
  (define (serialize-int-component-configuration-list l)
-    (for-each
-     (lambda (val) (serialize-int-component-configuration val)) l))
+    #~(string-append
+       #$@(map (lambda (val)
+                 (serialize-int-component-configuration val)) l)))

  (define (ext-component-configuration-list? val)
    (and (list? val) (and-map ext-component-configuration? val)))
  (define (serialize-ext-component-configuration-list l)
-    (for-each
-     (lambda (val) (serialize-ext-component-configuration val)) l))
+    #~(string-append
+       #$@(map (lambda (val)
+                 (serialize-ext-component-configuration val)) l)))

  (define-all-configurations prosody-configuration
    (prosody
@ -331,7 +338,7 @@ can create such a file with:
     global)

    (plugin-paths
-     (file-name-list '())
+     (file-object-list '())
     "Additional plugin directories.  They are searched in all the specified
 paths in order.  See @url{https://prosody.im/doc/plugins_directory}."
     global)
@ -372,7 +379,7 @@ should you want to disable them then add them to this list."
     common)

    (groups-file
-     (file-name "/var/lib/prosody/sharedgroups.txt")
+     (file-object "/var/lib/prosody/sharedgroups.txt")
     "Path to a text file where the shared groups are defined.  If this path is
 empty then @samp{mod_groups} does nothing.  See
@url{https://prosody.im/doc/modules/mod_groups}."
@ -566,8 +573,9 @@ See also @url{https://prosody.im/doc/modules/mod_muc}."
               '(domain))))
  (let ((domain (virtualhost-configuration-domain config))
        (rest (filter rest? virtualhost-configuration-fields)))
-    (format #t "VirtualHost \"~a\"\n" domain)
-    (serialize-configuration config rest)))
+    #~(string-append
+       #$(format #f "VirtualHost \"~a\"\n" domain)
+       #$(serialize-configuration config rest))))

 ;; Serialize Component line first.
 (define (serialize-int-component-configuration config)
@ -577,8 +585,9 @@ See also @url{https://prosody.im/doc/modules/mod_muc}."
  (let ((hostname (int-component-configuration-hostname config))
        (plugin (int-component-configuration-plugin config))
        (rest (filter rest? int-component-configuration-fields)))
-    (format #t "Component \"~a\" \"~a\"\n" hostname plugin)
-    (serialize-configuration config rest)))
+    #~(string-append
+       #$(format #f "Component \"~a\" \"~a\"\n" hostname plugin)
+       #$(serialize-configuration config rest))))

 ;; Serialize Component line first.
 (define (serialize-ext-component-configuration config)
@ -587,22 +596,24 @@ See also @url{https://prosody.im/doc/modules/mod_muc}."
               '(hostname))))
  (let ((hostname (ext-component-configuration-hostname config))
        (rest (filter rest? ext-component-configuration-fields)))
-    (format #t "Component \"~a\"\n" hostname)
-    (serialize-configuration config rest)))
+    #~(string-append
+       #$(format #f "Component \"~a\"\n" hostname)
+       #$(serialize-configuration config rest))))

 ;; Serialize virtualhosts and components last.
 (define (serialize-prosody-configuration config)
  (define (rest? field)
    (not (memq (configuration-field-name field)
               '(virtualhosts int-components ext-components))))
-  (let ((rest (filter rest? prosody-configuration-fields)))
-    (serialize-configuration config rest))
-  (serialize-virtualhost-configuration-list
-   (prosody-configuration-virtualhosts config))
-  (serialize-int-component-configuration-list
-   (prosody-configuration-int-components config))
-  (serialize-ext-component-configuration-list
-   (prosody-configuration-ext-components config)))
+  #~(string-append
+     #$(let ((rest (filter rest? prosody-configuration-fields)))
+         (serialize-configuration config rest))
+     #$(serialize-virtualhost-configuration-list
+        (prosody-configuration-virtualhosts config))
+     #$(serialize-int-component-configuration-list
+        (prosody-configuration-int-components config))
+     #$(serialize-ext-component-configuration-list
+        (prosody-configuration-ext-components config))))

 (define-configuration opaque-prosody-configuration
  (prosody
@ -646,13 +657,12 @@ See also @url{https://prosody.im/doc/modules/mod_muc}."
         (default-certs-dir "/etc/prosody/certs")
         (data-path (prosody-configuration-data-path config))
         (pidfile-dir (dirname (prosody-configuration-pidfile config)))
-         (config-str
-          (if (opaque-prosody-configuration? config)
-              (opaque-prosody-configuration-prosody.cfg.lua config)
-              (with-output-to-string
-                (lambda ()
-                  (serialize-prosody-configuration config)))))
-         (config-file (plain-file "prosody.cfg.lua" config-str)))
+         (config-str (if (opaque-prosody-configuration? config)
+                         (opaque-prosody-configuration-prosody.cfg.lua config)
+                         #~(begin
+                             (use-modules (ice-9 format))
+                             #$(serialize-prosody-configuration config))))
+         (config-file (mixed-text-file "prosody.cfg.lua" config-str)))
    #~(begin
        (use-modules (guix build utils))
        (define %user (getpw "prosody"))
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@ -86,6 +87,7 @@

            define-gexp-compiler
            gexp-compiler?
+            file-like?
            lower-object

            lower-inputs
@ -182,6 +184,11 @@ procedure to lower it; otherwise return #f."
  (and=> (hashq-ref %gexp-compilers (struct-vtable object))
         gexp-compiler-lower))

+(define (file-like? object)
+  "Return #t if OBJECT leads to a file in the store once unquoted in a
+G-expression; otherwise return #f."
+  (and (struct? object) (->bool (lookup-compiler object))))
+
 (define (lookup-expander object)
  "Search for an expander for OBJECT.  Upon success, return the three argument
 procedure to expand it; otherwise return #f."