mirror of
git://git.savannah.gnu.org/guix.git
synced 2023-12-14 03:33:07 +01:00
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.
This commit is contained in:
Clément Lassieur
parent
fb547c3429
commit
bdcf0e6fd4
4 changed files with 83 additions and 60 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
Loading…
Reference in a new issue