diff options
| -rw-r--r-- | doc/guix.texi | 13 | ||||
| -rw-r--r-- | gnu/services/configuration.scm | 17 | ||||
| -rw-r--r-- | gnu/services/messaging.scm | 106 | ||||
| -rw-r--r-- | guix/gexp.scm | 7 |
4 files changed, 83 insertions, 60 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 50438f7cb4..057272df46 100644 --- 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) diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index c45340f02f..707944cbe0 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. ;;; @@ -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) diff --git a/gnu/services/messaging.scm b/gnu/services/messaging.scm index 427e2121f6..80ffed0f2f 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,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")) diff --git a/guix/gexp.scm b/guix/gexp.scm index f005c4d296..8dea022e04 100644 --- 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." |