diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/configuration.scm | 159 | ||||
| -rw-r--r-- | gnu/services/databases.scm | 7 | ||||
| -rw-r--r-- | gnu/services/docker.scm | 10 | ||||
| -rw-r--r-- | gnu/services/guix.scm | 30 | ||||
| -rw-r--r-- | gnu/services/linux.scm | 49 | ||||
| -rw-r--r-- | gnu/services/mail.scm | 31 | ||||
| -rw-r--r-- | gnu/services/nix.scm | 6 | ||||
| -rw-r--r-- | gnu/services/vpn.scm | 13 |
8 files changed, 238 insertions, 67 deletions
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 90f12a8d39..21cb829382 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -2,6 +2,8 @@ ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> +;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,11 +40,18 @@ configuration-field-getter configuration-field-default-value-thunk configuration-field-documentation + + configuration-error? + + define-configuration + no-serialization + serialize-configuration define-maybe - define-configuration validate-configuration generate-documentation + configuration->documentation + empty-serializer serialize-package)) ;;; Commentary: @@ -63,6 +72,10 @@ (define (configuration-missing-field kind field) (configuration-error (format #f "~a configuration missing required field ~a" kind field))) +(define (configuration-no-default-value kind field) + (configuration-error + (format #f "The field `~a' of the `~a' configuration record \ +does not have a default value" field kind))) (define-record-type* <configuration-field> configuration-field make-configuration-field configuration-field? @@ -91,7 +104,7 @@ fields)) (define-syntax-rule (id ctx parts ...) - "Assemble PARTS into a raw (unhygienic) identifier." + "Assemble PARTS into a raw (unhygienic) identifier." (datum->syntax ctx (symbol-append (syntax->datum parts) ...))) (define-syntax define-maybe @@ -109,51 +122,93 @@ (define (serialize-maybe-stem field-name val) (if (stem? val) (serialize-stem field-name val) "")))))))) +(define (define-configuration-helper serialize? syn) + (syntax-case syn () + ((_ stem (field (field-type def ...) doc custom-serializer ...) ...) + (with-syntax (((field-getter ...) + (map (lambda (field) + (id #'stem #'stem #'- field)) + #'(field ...))) + ((field-predicate ...) + (map (lambda (type) + (id #'stem type #'?)) + #'(field-type ...))) + ((field-default ...) + (map (match-lambda + ((field-type default-value) + default-value) + ((field-type) + ;; Quote `undefined' to prevent a possibly + ;; unbound warning. + (syntax 'undefined))) + #'((field-type def ...) ...))) + ((field-serializer ...) + (map (lambda (type custom-serializer) + (and serialize? + (match custom-serializer + ((serializer) + serializer) + (() + (id #'stem #'serialize- type))))) + #'(field-type ...) + #'((custom-serializer ...) ...)))) + #`(begin + (define-record-type* #,(id #'stem #'< #'stem #'>) + #,(id #'stem #'% #'stem) + #,(id #'stem #'make- #'stem) + #,(id #'stem #'stem #'?) + (%location #,(id #'stem #'stem #'-location) + (default (and=> (current-source-location) + source-properties->location)) + (innate)) + #,@(map (lambda (name getter def) + (if (eq? (syntax->datum def) (quote 'undefined)) + #`(#,name #,getter) + #`(#,name #,getter (default #,def)))) + #'(field ...) + #'(field-getter ...) + #'(field-default ...))) + (define #,(id #'stem #'stem #'-fields) + (list (configuration-field + (name 'field) + (type 'field-type) + (getter field-getter) + (predicate field-predicate) + (serializer field-serializer) + (default-value-thunk + (lambda () + (display '#,(id #'stem #'% #'stem)) + (if (eq? (syntax->datum field-default) + 'undefined) + (configuration-no-default-value + '#,(id #'stem #'% #'stem) 'field) + field-default))) + (documentation doc)) + ...)) + (define-syntax-rule (stem arg (... ...)) + (let ((conf (#,(id #'stem #'% #'stem) arg (... ...)))) + (validate-configuration conf + #,(id #'stem #'stem #'-fields)) + conf))))))) + +(define no-serialization ;syntactic keyword for 'define-configuration' + '(no serialization)) + (define-syntax define-configuration - (lambda (stx) - (syntax-case stx () - ((_ stem (field (field-type def) doc) ...) - (with-syntax (((field-getter ...) - (map (lambda (field) - (id #'stem #'stem #'- field)) - #'(field ...))) - ((field-predicate ...) - (map (lambda (type) - (id #'stem type #'?)) - #'(field-type ...))) - ((field-serializer ...) - (map (lambda (type) - (id #'stem #'serialize- type)) - #'(field-type ...)))) - #`(begin - (define-record-type* #,(id #'stem #'< #'stem #'>) - #,(id #'stem #'% #'stem) - #,(id #'stem #'make- #'stem) - #,(id #'stem #'stem #'?) - (%location #,(id #'stem #'-location) - (default (and=> (current-source-location) - source-properties->location)) - (innate)) - (field field-getter (default def)) - ...) - (define #,(id #'stem #'stem #'-fields) - (list (configuration-field - (name 'field) - (type 'field-type) - (getter field-getter) - (predicate field-predicate) - (serializer field-serializer) - (default-value-thunk (lambda () def)) - (documentation doc)) - ...)) - (define-syntax-rule (stem arg (... ...)) - (let ((conf (#,(id #'stem #'% #'stem) arg (... ...)))) - (validate-configuration conf - #,(id #'stem #'stem #'-fields)) - conf)))))))) - -(define (serialize-package field-name val) - "") + (lambda (s) + (syntax-case s (no-serialization) + ((_ stem (field (field-type def ...) doc custom-serializer ...) ... + (no-serialization)) + (define-configuration-helper + #f #'(_ stem (field (field-type def ...) doc custom-serializer ...) + ...))) + ((_ stem (field (field-type def ...) doc custom-serializer ...) ...) + (define-configuration-helper + #t #'(_ stem (field (field-type def ...) doc custom-serializer ...) + ...)))))) + +(define (empty-serializer field-name val) "") +(define serialize-package empty-serializer) ;; A little helper to make it easier to document all those fields. (define (generate-documentation documentation documentation-name) @@ -188,3 +243,15 @@ (or (assq-ref sub-documentation field-name) '()))))) fields))))) (stexi->texi `(*fragment* . ,(generate documentation-name)))) + +(define (configuration->documentation configuration-symbol) + "Take CONFIGURATION-SYMBOL, the symbol corresponding to the name used when +defining a configuration record with DEFINE-CONFIGURATION, and output the +Texinfo documentation of its fields." + ;; This is helper for a simple, straight-forward application of + ;; GENERATE-DOCUMENTATION. + (let ((fields-getter (module-ref (current-module) + (symbol-append configuration-symbol + '-fields)))) + (display (generate-documentation `((,configuration-symbol ,fields-getter)) + configuration-symbol)))) diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index 4a6d36b50b..eba88cdb68 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net> ;;; Copyright © 2020 Marius Bakke <marius@gnu.org> +;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz> ;;; ;;; This file is part of GNU Guix. ;;; @@ -527,6 +528,7 @@ created after the PostgreSQL database is started."))) (port mysql-configuration-port (default 3306)) (socket mysql-configuration-socket (default "/run/mysqld/mysqld.sock")) (extra-content mysql-configuration-extra-content (default "")) + (extra-environment mysql-configuration-extra-environment (default #~'())) (auto-upgrade? mysql-configuration-auto-upgrade? (default #t))) (define %mysql-accounts @@ -611,11 +613,14 @@ FLUSH PRIVILEGES; (provision '(mysql)) (documentation "Run the MySQL server.") (start (let ((mysql (mysql-configuration-mysql config)) + (extra-env (mysql-configuration-extra-environment config)) (my.cnf (mysql-configuration-file config))) #~(make-forkexec-constructor (list (string-append #$mysql "/bin/mysqld") (string-append "--defaults-file=" #$my.cnf)) - #:user "mysql" #:group "mysql"))) + #:user "mysql" #:group "mysql" + #:log-file "/var/log/mysqld.log" + #:environment-variables #$extra-env))) (stop #~(make-kill-destructor))))) (define (mysql-upgrade-wrapper mysql socket-file) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 7acfbea49f..be85316180 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net> -;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com> ;;; @@ -37,11 +37,6 @@ docker-service-type singularity-service-type)) -;;; We're not using serialize-configuration, but we must define this because -;;; the define-configuration macro validates it exists. -(define (serialize-boolean field-name val) - "") - (define-configuration docker-configuration (docker (package docker) @@ -64,7 +59,8 @@ loop-back communications.") "Enable or disable debug output.") (enable-iptables? (boolean #t) - "Enable addition of iptables rules (enabled by default).")) + "Enable addition of iptables rules (enabled by default).") + (no-serialization)) (define %docker-accounts (list (user-group (name "docker") (system? #t)))) diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm index d1d31febdc..a5ed28647f 100644 --- a/gnu/services/guix.scm +++ b/gnu/services/guix.scm @@ -58,6 +58,7 @@ guix-build-coordinator-agent-configuration-authentication guix-build-coordinator-agent-configuration-systems guix-build-coordinator-agent-configuration-max-parallel-builds + guix-build-coordinator-agent-configuration-max-1min-load-average guix-build-coordinator-agent-configuration-derivation-substitute-urls guix-build-coordinator-agent-configuration-non-derivation-substitute-urls @@ -156,6 +157,9 @@ (max-parallel-builds guix-build-coordinator-agent-configuration-max-parallel-builds (default 1)) + (max-1min-load-average + guix-build-coordinator-agent-configuration-max-1min-load-average + (default #f)) (derivation-substitute-urls guix-build-coordinator-agent-configuration-derivation-substitute-urls (default #f)) @@ -201,7 +205,7 @@ (user guix-build-coordinator-queue-builds-configuration-user (default "guix-build-coordinator-queue-builds")) (coordinator guix-build-coordinator-queue-builds-coordinator - (default "http://localhost:8745")) + (default "http://localhost:8746")) (systems guix-build-coordinator-queue-builds-configuration-systems (default #f)) (systems-and-targets @@ -325,7 +329,9 @@ #~(begin (use-modules (guix build utils)) - (define %user (getpw "guix-build-coordinator")) + (define %user + (getpw #$(guix-build-coordinator-configuration-user + config))) (chmod "/var/lib/guix-build-coordinator" #o755) @@ -370,6 +376,7 @@ (define (guix-build-coordinator-agent-shepherd-services config) (match-record config <guix-build-coordinator-agent-configuration> (package user coordinator authentication max-parallel-builds + max-1min-load-average derivation-substitute-urls non-derivation-substitute-urls systems) (list @@ -402,6 +409,10 @@ token-file)))) #$(simple-format #f "--max-parallel-builds=~A" max-parallel-builds) + #$@(if max-1min-load-average + #~(#$(simple-format #f "--max-1min-load-average=~A" + max-1min-load-average)) + #~()) #$@(if derivation-substitute-urls #~(#$(string-append "--derivation-substitute-urls=" @@ -429,7 +440,9 @@ #~(begin (use-modules (guix build utils)) - (define %user (getpw "guix-build-coordinator-agent")) + (define %user + (getpw #$(guix-build-coordinator-agent-configuration-user + config))) (mkdir-p "/var/log/guix-build-coordinator") @@ -493,7 +506,6 @@ processed-commits-file)) #~())) #:user #$user - #:pid-file "/var/run/guix-build-coordinator-queue-builds/pid" #:environment-variables `(,(string-append "GUIX_LOCPATH=" #$glibc-utf8-locales "/lib/locale") @@ -505,11 +517,15 @@ #~(begin (use-modules (guix build utils)) + (define %user + (getpw #$(guix-build-coordinator-queue-builds-configuration-user + config))) + (mkdir-p "/var/log/guix-build-coordinator") - ;; Allow writing the PID file - (mkdir-p "/var/run/guix-build-coordinator-queue-builds") - (chown "/var/run/guix-build-coordinator-queue-builds" + ;; Allow writing the processed commits file + (mkdir-p "/var/cache/guix-build-coordinator-queue-builds") + (chown "/var/cache/guix-build-coordinator-queue-builds" (passwd:uid %user) (passwd:gid %user)))) diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index 340b330030..2eb02ac5a3 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com> +;;; Copyright © 2021 B. Wilson <elaexuotee@wilsonb.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,6 +48,11 @@ kernel-module-loader-service-type + rasdaemon-configuration + rasdaemon-configuration? + rasdaemon-configuration-record? + rasdaemon-service-type + zram-device-configuration zram-device-configuration? zram-device-configuration-size @@ -190,6 +196,49 @@ representation." ;;; +;;; Reliability, Availability, and Serviceability (RAS) daemon +;;; + +(define-record-type* <rasdaemon-configuration> + rasdaemon-configuration make-rasdaemon-configuration + rasdaemon-configuration? + (record? rasdaemon-configuration-record? (default #f))) + +(define (rasdaemon-configuration->command-line-args config) + "Translate <rasdaemon-configuration> to its command line arguments + representation" + (let ((record? (rasdaemon-configuration-record? config))) + `(,(file-append rasdaemon "/sbin/rasdaemon") + "--foreground" ,@(if record? '("--record") '())))) + +(define (rasdaemon-activation config) + (let ((record? (rasdaemon-configuration-record? config)) + (rasdaemon-dir "/var/lib/rasdaemon")) + (with-imported-modules '((guix build utils)) + #~(if #$record? (mkdir-p #$rasdaemon-dir))))) + +(define (rasdaemon-shepherd-service config) + (shepherd-service + (documentation "Run rasdaemon") + (provision '(rasdaemon)) + (requirement '(syslogd)) + (start #~(make-forkexec-constructor + '#$(rasdaemon-configuration->command-line-args config))) + (stop #~(make-kill-destructor)))) + +(define rasdaemon-service-type + (service-type + (name 'rasdaemon) + (default-value (rasdaemon-configuration)) + (extensions + (list (service-extension shepherd-root-service-type + (compose list rasdaemon-shepherd-service)) + (service-extension activation-service-type rasdaemon-activation))) + (compose concatenate) + (description "Run @command{rasdaemon}, the RAS monitor"))) + + +;;; ;;; Kernel module loader. ;;; diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm index 81f692e437..72dc123f41 100644 --- a/gnu/services/mail.scm +++ b/gnu/services/mail.scm @@ -355,7 +355,28 @@ This is used by imap (for shared users) and lda.") (mail-max-userip-connections (non-negative-integer 10) "Maximum number of IMAP connections allowed for a user from each IP -address. NOTE: The username is compared case-sensitively.")) +address. NOTE: The username is compared case-sensitively.") + (imap-metadata? + (boolean #f) + "Whether to enable the @code{IMAP METADATA} extension as defined in +@uref{https://tools.ietf.org/html/rfc5464, RFC@tie{}5464}, which provides +a means for clients to set and retrieve per-mailbox, per-user metadata +and annotations over IMAP. + +If this is @samp{#t}, you must also specify a dictionary @i{via} the +@code{mail-attribute-dict} setting.") + (managesieve-notify-capability + (space-separated-string-list '()) + "Which NOTIFY capabilities to report to clients that first connect to +the ManageSieve service, before authentication. These may differ from the +capabilities offered to authenticated users. If this field is left empty, +report what the Sieve interpreter supports by default.") + (managesieve-sieve-capability + (space-separated-string-list '()) + "Which SIEVE capabilities to report to clients that first connect to +the ManageSieve service, before authentication. These may differ from the +capabilities offered to authenticated users. If this field is left empty, +report what the Sieve interpreter supports by default.")) (define (serialize-protocol-configuration field-name val) (format #t "protocol ~a {\n" (protocol-configuration-name val)) @@ -1133,6 +1154,14 @@ disabled.") @samp{mdbox-rotate-size}. This setting currently works only in Linux with some file systems (ext4, xfs).") + (mail-attribute-dict + (string "") + "The location of a dictionary used to store @code{IMAP METADATA} +as defined by @uref{https://tools.ietf.org/html/rfc5464, RFC@tie{}5464}. + +The IMAP METADATA commands are available only if the ``imap'' +protocol configuration's @code{imap-metadata?} field is @samp{#t}.") + (mail-attachment-dir (string "") "sdbox and mdbox support saving mail attachments to external files, diff --git a/gnu/services/nix.scm b/gnu/services/nix.scm index 1aef47db0a..619e3cae54 100644 --- a/gnu/services/nix.scm +++ b/gnu/services/nix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019, 2020 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2019, 2020, 2021 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2020 Peng Mei Yu <i@pengmeiyu.com> ;;; ;;; This file is part of GNU Guix. @@ -19,6 +19,7 @@ (define-module (gnu services nix) #:use-module (gnu packages admin) + #:use-module (gnu packages bash) #:use-module (gnu packages package-management) #:use-module (gnu services base) #:use-module (gnu services configuration) @@ -121,7 +122,8 @@ GID." (format #t "sandbox = ~a~%" (if #$sandbox "true" "false")) ;; config.nix captures store file names. (format #t "build-sandbox-paths = ~{~a ~}~%" - (append internal-sandbox-paths + (append (list (string-append "/bin/sh=" #$bash-minimal "/bin/sh")) + internal-sandbox-paths '#$build-sandbox-items)) (for-each (cut display <>) '#$extra-config))))))))))) diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm index 3e315a6df2..6fbe20a849 100644 --- a/gnu/services/vpn.scm +++ b/gnu/services/vpn.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017 Julien Lepiller <julien@lepiller.eu> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -537,7 +538,9 @@ is truncated and rewritten every minute.") (endpoint wireguard-peer-endpoint (default #f)) ;string (public-key wireguard-peer-public-key) ;string - (allowed-ips wireguard-peer-allowed-ips)) ;list of strings + (allowed-ips wireguard-peer-allowed-ips) ;list of strings + (keep-alive wireguard-peer-keep-alive + (default #f))) ;integer (define-record-type* <wireguard-configuration> wireguard-configuration make-wireguard-configuration @@ -560,16 +563,20 @@ is truncated and rewritten every minute.") (let ((name (wireguard-peer-name peer)) (public-key (wireguard-peer-public-key peer)) (endpoint (wireguard-peer-endpoint peer)) - (allowed-ips (wireguard-peer-allowed-ips peer))) + (allowed-ips (wireguard-peer-allowed-ips peer)) + (keep-alive (wireguard-peer-keep-alive peer))) (format #f "[Peer] #~a PublicKey = ~a AllowedIPs = ~a -~a" +~a~a" name public-key (string-join allowed-ips ",") (if endpoint (format #f "Endpoint = ~a\n" endpoint) + "") + (if keep-alive + (format #f "PersistentKeepalive = ~a\n" keep-alive) "\n")))) (match-record config <wireguard-configuration> |