From: "Clément Lassieur" <clement@lassieur.org>
To: 30657@debbugs.gnu.org
Subject: [bug#30657] [PATCH] services: messaging: Prosody config supports file-like objects.
Date: Sat, 3 Mar 2018 02:33:08 +0100 [thread overview]
Message-ID: <20180303013308.12929-1-clement@lassieur.org> (raw)
In-Reply-To: <87o9k6csz9.fsf@gnu.org>
* 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).
(file-like?): New exported procedure.
* 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.
---
doc/guix.texi | 13 +++--
gnu/services/configuration.scm | 23 +++++----
gnu/services/messaging.scm | 111 ++++++++++++++++++++++++-----------------
3 files changed, 87 insertions(+), 60 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
-@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{()}.
@@ -14271,7 +14274,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}.
@@ -14304,13 +14307,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
@@ -14570,6 +14573,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)
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index c45340f02..016ef4e0e 100644
--- 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.
;;;
@@ -42,7 +42,8 @@
define-configuration
validate-configuration
generate-documentation
- serialize-package))
+ serialize-package
+ file-like?))
;;; Commentary:
;;;
@@ -74,11 +75,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 +107,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 +149,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)
@@ -182,3 +184,6 @@
(or (assq-ref sub-documentation field-name) '())))))
fields)))))
(stexi->texi `(*fragment* . ,(generate documentation-name))))
+
+(define (file-like? val)
+ (and (struct? val) ((@@ (guix gexp) lookup-compiler) val)))
diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm
index 427e2121f..aa3d5f0a0 100644
--- 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,16 @@
"_")))
(define (serialize-field field-name val)
- (format #t "~a = ~a;\n" (uglify-field-name field-name) val))
+ #~(string-append
+ #$(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
- (lambda ()
- (format #t "{\n")
- (for-each (lambda (x)
- (format #t "~a;\n" x))
- val)
- (format #t "}")))))
+ #~(string-append
+ "{\n"
+ #$@(map (lambda (x)
+ #~(string-append #$x ";\n"))
+ val)
+ "}")))
(define (serialize-boolean field-name val)
(serialize-field field-name (if val "true" "false")))
@@ -140,17 +140,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 +183,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 +236,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 +285,10 @@ 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"))
+ #~(string-append
+ "ssl = {\n"
+ #$(serialize-configuration val ssl-configuration-fields)
+ "};\n"))
(define-maybe ssl-configuration)
(define %default-modules-enabled
@@ -303,20 +316,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 +347,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 +388,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 +582,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 +594,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 +605,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 +666,10 @@ 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)
+ (serialize-prosody-configuration config)))
+ (config-file (mixed-text-file "prosody.cfg.lua" config-str)))
#~(begin
(use-modules (guix build utils))
(define %user (getpw "prosody"))
--
2.16.2
next prev parent reply other threads:[~2018-03-03 1:34 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-02-28 22:25 [bug#30657] Add support for file-like objects to the Prosody configuration Clément Lassieur
2018-02-28 22:28 ` [bug#30657] [PATCH 1/4] services: utils: Add 'push-tokens' and 'with-tokens-to-list' Clément Lassieur
2018-02-28 22:28 ` [bug#30657] [PATCH 2/4] gexp: Add 'file-like?' Clément Lassieur
2018-03-02 16:51 ` Ludovic Courtès
2018-03-03 1:44 ` Clément Lassieur
2018-03-03 14:38 ` Ludovic Courtès
2018-02-28 22:28 ` [bug#30657] [PATCH 3/4] services: utils: move 'flatten' from (gnu services web) Clément Lassieur
2018-02-28 22:28 ` [bug#30657] [PATCH 4/4] services: messaging: Prosody config supports file-like objects Clément Lassieur
2018-03-02 17:00 ` [bug#30657] Add support for file-like objects to the Prosody configuration Ludovic Courtès
2018-03-03 1:33 ` Clément Lassieur [this message]
2018-03-03 11:43 ` [bug#30657] [PATCH] services: messaging: Prosody config supports file-like objects Clément Lassieur
2018-03-03 14:27 ` Ludovic Courtès
2018-03-03 14:37 ` Ludovic Courtès
2018-03-03 17:38 ` bug#30657: " Clément Lassieur
2018-03-03 1:40 ` [bug#30657] Add support for file-like objects to the Prosody configuration Clément Lassieur
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20180303013308.12929-1-clement@lassieur.org \
--to=clement@lassieur.org \
--cc=30657@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.