[bug#30657] [PATCH 4/4] services: messaging: Prosody config supports file-like objects.

[Clément Lassieur]

* doc/guix.texi (Messaging Services): Update accordingly.
* gnu/services/messaging.scm (serialize-field, enclose-quotes,
serialize-raw-content, serialize-ssl-configuration,
serialize-virtualhost-configuration, serialize-int-component-configuration,
serialize-ext-component-configuration, prosody-activation): Replace 'format'
with 'push-token' and 'with-output-to-string' with 'with-tokens-to-list'.
(prosody-activation): Replace 'plain-file' with 'mixed-text-file' and flatten
the tokens.
(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'.
---
 doc/guix.texi              | 13 +++++++----
 gnu/services/messaging.scm | 58 ++++++++++++++++++++++++++++------------------
 2 files changed, 45 insertions(+), 26 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 24db16761..3bb544e62 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -14210,6 +14210,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
@@ -14230,7 +14233,7 @@ Location of the Prosody data storage directory.  See
 Defaults to @samp{"/var/lib/prosody"}.
 @end deftypevr
 
address@hidden address@hidden parameter} file-name-list plugin-paths
address@hidden address@hidden 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{()}.
@@ -14271,7 +14274,7 @@ should you want to disable them then add them to this 
list.
 Defaults to @samp{()}.
 @end deftypevr
 
address@hidden address@hidden parameter} file-name groups-file
address@hidden address@hidden 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}.
@@ -14304,13 +14307,13 @@ Path to your private key file.
 Path to your certificate file.
 @end deftypevr
 
address@hidden address@hidden parameter} file-name capath
address@hidden address@hidden 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
 
address@hidden address@hidden parameter} maybe-file-name cafile
address@hidden address@hidden 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
@@ -14570,6 +14573,8 @@ string, you could instantiate a prosody service like 
this:
           (prosody.cfg.lua "")))
 @end example
 
address@hidden end of Prosody auto-generated documentation
+
 @subsubheading BitlBee Service
 
 @cindex IRC (Internet Relay Chat)
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 427e2121f..316eebecb 100644
--- a/gnu/services/messaging.scm
+++ b/gnu/services/messaging.scm
@@ -24,6 +24,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services configuration)
+  #:use-module (gnu services utils)
   #:use-module (gnu system shadow)
   #:use-module (guix gexp)
   #:use-module (guix modules)
@@ -115,16 +116,16 @@
                  "_")))
 
 (define (serialize-field field-name val)
-  (format #t "~a = ~a;\n" (uglify-field-name field-name) val))
+  (push-tokens (format #f "~a = " (uglify-field-name field-name)) val ";\n"))
 (define (serialize-field-list field-name val)
   (serialize-field field-name
-                   (with-output-to-string
+                   (with-tokens-to-list
                      (lambda ()
-                       (format #t "{\n")
+                       (push-tokens "{\n")
                        (for-each (lambda (x)
-                                   (format #t "~a;\n" x))
+                                   (push-tokens x ";\n"))
                                  val)
-                       (format #t "}")))))
+                       (push-tokens "}")))))
 
 (define (serialize-boolean field-name val)
   (serialize-field field-name (if val "true" "false")))
@@ -140,17 +141,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))
+  (list "\"" s "\""))
 (define (serialize-string field-name val)
   (serialize-field field-name (enclose-quotes val)))
 (define-maybe string)
@@ -183,10 +184,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))
+  (push-tokens val))
 (define-maybe raw-content)
 
 (define-configuration mod-muc-configuration
@@ -224,12 +237,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 +286,9 @@ 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")
+  (push-tokens "ssl = {\n")
   (serialize-configuration val ssl-configuration-fields)
-  (format #t "};\n"))
+  (push-tokens "};\n"))
 (define-maybe ssl-configuration)
 
 (define %default-modules-enabled
@@ -331,7 +344,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 +385,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,7 +579,7 @@ 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)
+    (push-tokens (format #f "VirtualHost \"~a\"\n" domain))
     (serialize-configuration config rest)))
 
 ;; Serialize Component line first.
@@ -577,7 +590,7 @@ 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)
+    (push-tokens (format #f "Component \"~a\" \"~a\"\n" hostname plugin))
     (serialize-configuration config rest)))
 
 ;; Serialize Component line first.
@@ -587,7 +600,7 @@ 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)
+    (push-tokens (format #f "Component \"~a\"\n" hostname))
     (serialize-configuration config rest)))
 
 ;; Serialize virtualhosts and components last.
@@ -646,13 +659,14 @@ 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
+         (config-tokens
           (if (opaque-prosody-configuration? config)
-              (opaque-prosody-configuration-prosody.cfg.lua config)
-              (with-output-to-string
+              (list (opaque-prosody-configuration-prosody.cfg.lua config))
+              (with-tokens-to-list
                 (lambda ()
                   (serialize-prosody-configuration config)))))
-         (config-file (plain-file "prosody.cfg.lua" config-str)))
+         (config-file
+          (apply mixed-text-file "prosody.cfg.lua" (flatten config-tokens))))
     #~(begin
         (use-modules (guix build utils))
         (define %user (getpw "prosody"))
-- 
2.16.2