ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
* 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 2018-02-26 01:12:24 +01:00
parent fb547c3429
commit bdcf0e6fd4
No known key found for this signature in database
GPG key ID: 89F96D4808F359C7
4 changed files with 83 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
doc/guix.texi
View file

@ -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)

17
gnu/services/configuration.scm
View file

@ -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 @@ (define-record-type* <configuration-field>
(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-syntax define-maybe
(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 @@ (define-syntax-rule (stem arg (... ...))
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)

106
gnu/services/messaging.scm
View file

@ -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 (uglify-field-name field-name)
"_")))
(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 (serialize-string-or-boolean field-name val)
(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 @@ (define (serialize-file-name-list field-name val)
(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 @@ (define-configuration ssl-configuration
"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 @@ (define-configuration ssl-configuration
(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 @@ (define %default-modules-enabled
(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 @@ (define-all-configurations prosody-configuration
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 @@ (define-all-configurations prosody-configuration
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 @@ (define (rest? field)
'(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 @@ (define (rest? field)
(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 @@ (define (rest? field)
'(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 @@ (define (prosody-activation config)
(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"))

7
guix/gexp.scm
View file

@ -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-module (guix gexp)
define-gexp-compiler
gexp-compiler?
file-like?
lower-object
lower-inputs
@ -182,6 +184,11 @@ (define (lookup-compiler object)
(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."