diff options
Diffstat (limited to 'gnu/services')
-rw-r--r-- | gnu/services/base.scm | 32 | ||||
-rw-r--r-- | gnu/services/cuirass.scm | 325 | ||||
-rw-r--r-- | gnu/services/cups.scm | 12 | ||||
-rw-r--r-- | gnu/services/databases.scm | 240 | ||||
-rw-r--r-- | gnu/services/networking.scm | 65 | ||||
-rw-r--r-- | gnu/services/shepherd.scm | 67 | ||||
-rw-r--r-- | gnu/services/syncthing.scm | 89 | ||||
-rw-r--r-- | gnu/services/virtualization.scm | 8 | ||||
-rw-r--r-- | gnu/services/web.scm | 27 |
9 files changed, 653 insertions, 212 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 945b546607..f6a490f712 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015, 2016, 2020 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> @@ -279,7 +279,9 @@ system objects."))) (define root-file-system-service-type (shepherd-service-type 'root-file-system - (const %root-file-system-shepherd-service))) + (const %root-file-system-shepherd-service) + (description "Take care of syncing the root file +system and of remounting it read-only when the system shuts down."))) (define (root-file-system-service) "Return a service whose sole purpose is to re-mount read-only the root file @@ -570,7 +572,9 @@ down."))) (requirement '(udev)) (provision '(trng)) (start #~(make-forkexec-constructor '#$rngd-command)) - (stop #~(make-kill-destructor)))))) + (stop #~(make-kill-destructor)))) + (description "Run the @command{rngd} random number generation daemon to +supply entropy to the kernel's pool."))) (define* (rngd-service #:key (rng-tools rng-tools) @@ -597,7 +601,8 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (provision '(host-name)) (start #~(lambda _ (sethostname #$name))) - (one-shot? #t))))) + (one-shot? #t))) + (description "Initialize the machine's host name."))) (define (host-name-service name) "Return a service that sets the host name to @var{name}." @@ -626,7 +631,8 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (display 1 port)))) #t)) (stop #~(const #f))))) - #t)) ;default to UTF-8 + #t ;default to UTF-8 + (description "Ensure the Linux virtual terminals run in UTF-8 mode."))) (define console-keymap-service-type (shepherd-service-type @@ -638,7 +644,10 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (start #~(lambda _ (zero? (system* #$(file-append kbd "/bin/loadkeys") #$@files)))) - (respawn? #f))))) + (respawn? #f))) + (description "@emph{This service is deprecated in favor of the +@code{keyboard-layout} field of @code{operating-system}.} Load the given list +of console keymaps with @command{loadkeys}."))) (define-deprecated (console-keymap-service #:rest files) #f @@ -1341,7 +1350,9 @@ Service Switch}, for an example." (pid (spawn))) (umask mask) pid)))) - (stop #~(make-kill-destructor)))))) + (stop #~(make-kill-destructor)))) + (description "Run the syslog daemon, @command{syslogd}, which is +responsible for logging system messages."))) ;; Snippet adapted from the GNU inetutils manual. (define %default-syslog.conf @@ -2207,7 +2218,8 @@ instance." (when device (restart-on-EINTR (swapoff device))) #f))) - (respawn? #f)))))) + (respawn? #f)))) + (description "Turn on the virtual memory swap area."))) (define (swap-service device) "Return a service that uses @var{device} as a swap device." @@ -2321,7 +2333,9 @@ This service is not part of @var{%base-services}." (requirement '(user-processes udev dbus-system)) (provision (list (symbol-append 'term- (string->symbol virtual-terminal)))) (start #~(make-forkexec-constructor #$kmscon-command)) - (stop #~(make-kill-destructor))))))) + (stop #~(make-kill-destructor))))) + (description "Start the @command{kmscon} virtual terminal emulator for the +Linux @dfn{kernel mode setting} (KMS)."))) (define-record-type* <static-networking> static-networking make-static-networking diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 7706ed41c6..2d0bf47b48 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> +;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org> @@ -24,19 +24,29 @@ (define-module (gnu services cuirass) #:use-module (guix gexp) #:use-module (guix records) + #:use-module (guix utils) #:use-module (gnu packages admin) #:use-module (gnu packages ci) #:use-module (gnu packages version-control) #:use-module (gnu services) #:use-module (gnu services base) + #:use-module (gnu services databases) #:use-module (gnu services shepherd) #:use-module (gnu services admin) #:use-module (gnu system shadow) - #:export (<cuirass-configuration> + #:export (<cuirass-remote-server-configuration> + cuirass-remote-server-configuration + cuirass-remote-server-configuration? + + <cuirass-configuration> cuirass-configuration cuirass-configuration? + cuirass-service-type - cuirass-service-type)) + <cuirass-remote-worker-configuration> + cuirass-remote-worker-configuration + cuirass-remote-worker-configuration? + cuirass-remote-worker-service-type)) ;;;; Commentary: ;;; @@ -45,6 +55,27 @@ ;;; ;;;; Code: +(define %cuirass-default-database + "dbname=cuirass host=/var/run/postgresql") + +(define-record-type* <cuirass-remote-server-configuration> + cuirass-remote-server-configuration make-cuirass-remote-server-configuration + cuirass-remote-server-configuration? + (backend-port cuirass-remote-server-configuration-backend-port ;int + (default #f)) + (publish-port cuirass-remote-server-configuration-publish-port ;int + (default #f)) + (log-file cuirass-remote-server-log-file ;string + (default "/var/log/cuirass-remote-server.log")) + (cache cuirass-remote-server-configuration-cache ;string + (default "/var/cache/cuirass/remote/")) + (trigger-url cuirass-remote-server-trigger-url ;string + (default #f)) + (public-key cuirass-remote-server-configuration-public-key ;string + (default #f)) + (private-key cuirass-remote-server-configuration-private-key ;string + (default #f))) + (define-record-type* <cuirass-configuration> cuirass-configuration make-cuirass-configuration cuirass-configuration? @@ -54,25 +85,18 @@ (default "/var/log/cuirass.log")) (web-log-file cuirass-configuration-web-log-file ;string (default "/var/log/cuirass-web.log")) - (queries-log-file cuirass-configuration-queries-log-file ;string - (default #f)) - (web-queries-log-file - cuirass-configuration-web-queries-log-file ;string - (default #f)) (cache-directory cuirass-configuration-cache-directory ;string (dir-name) (default "/var/cache/cuirass")) - (ttl cuirass-configuration-ttl ;integer - (default (* 30 24 3600))) (user cuirass-configuration-user ;string (default "cuirass")) (group cuirass-configuration-group ;string (default "cuirass")) (interval cuirass-configuration-interval ;integer (seconds) (default 60)) - (queue-size cuirass-configuration-queue-size - (default 1)) - (database cuirass-configuration-database ;string (file-name) - (default "/var/lib/cuirass/cuirass.db")) + (remote-server cuirass-configuration-remote-server + (default #f)) + (database cuirass-configuration-database ;string + (default %cuirass-default-database)) (port cuirass-configuration-port ;integer (port) (default 8081)) (host cuirass-configuration-host ;string @@ -94,15 +118,11 @@ (cache-directory (cuirass-configuration-cache-directory config)) (web-log-file (cuirass-configuration-web-log-file config)) (log-file (cuirass-configuration-log-file config)) - (queries-log-file (cuirass-configuration-queries-log-file config)) - (web-queries-log-file - (cuirass-configuration-web-queries-log-file config)) (user (cuirass-configuration-user config)) (group (cuirass-configuration-group config)) (interval (cuirass-configuration-interval config)) - (queue-size (cuirass-configuration-queue-size config)) + (remote-server (cuirass-configuration-remote-server config)) (database (cuirass-configuration-database config)) - (ttl (cuirass-configuration-ttl config)) (port (cuirass-configuration-port config)) (host (cuirass-configuration-host config)) (specs (cuirass-configuration-specifications config)) @@ -110,64 +130,95 @@ (one-shot? (cuirass-configuration-one-shot? config)) (fallback? (cuirass-configuration-fallback? config)) (extra-options (cuirass-configuration-extra-options config))) - (list (shepherd-service - (documentation "Run Cuirass.") - (provision '(cuirass)) - (requirement '(guix-daemon networking)) - (start #~(make-forkexec-constructor - (list (string-append #$cuirass "/bin/cuirass") - "--cache-directory" #$cache-directory - "--specifications" - #$(scheme-file "cuirass-specs.scm" specs) - "--database" #$database - "--ttl" #$(string-append (number->string ttl) "s") - "--interval" #$(number->string interval) - "--queue-size" #$(number->string queue-size) - #$@(if queries-log-file - (list (string-append "--log-queries=" - queries-log-file)) - '()) - #$@(if use-substitutes? '("--use-substitutes") '()) - #$@(if one-shot? '("--one-shot") '()) - #$@(if fallback? '("--fallback") '()) - #$@extra-options) - - #:environment-variables - (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" - (string-append "GIT_EXEC_PATH=" #$git - "/libexec/git-core")) - - #:user #$user - #:group #$group - #:log-file #$log-file)) - (stop #~(make-kill-destructor))) - (shepherd-service - (documentation "Run Cuirass web interface.") - (provision '(cuirass-web)) - (requirement '(guix-daemon networking)) - (start #~(make-forkexec-constructor - (list (string-append #$cuirass "/bin/cuirass") - "--cache-directory" #$cache-directory - "--specifications" - #$(scheme-file "cuirass-specs.scm" specs) - "--database" #$database - "--ttl" #$(string-append (number->string ttl) "s") - "--web" - "--port" #$(number->string port) - "--listen" #$host - "--interval" #$(number->string interval) - #$@(if web-queries-log-file - (list (string-append "--log-queries=" - web-queries-log-file)) - '()) - #$@(if use-substitutes? '("--use-substitutes") '()) - #$@(if fallback? '("--fallback") '()) - #$@extra-options) + `(,(shepherd-service + (documentation "Run Cuirass.") + (provision '(cuirass)) + (requirement '(guix-daemon postgres networking)) + (start #~(make-forkexec-constructor + (list (string-append #$cuirass "/bin/cuirass") + "--cache-directory" #$cache-directory + "--specifications" + #$(scheme-file "cuirass-specs.scm" specs) + "--database" #$database + "--interval" #$(number->string interval) + #$@(if remote-server '("--build-remote") '()) + #$@(if use-substitutes? '("--use-substitutes") '()) + #$@(if one-shot? '("--one-shot") '()) + #$@(if fallback? '("--fallback") '()) + #$@extra-options) - #:user #$user - #:group #$group - #:log-file #$web-log-file)) - (stop #~(make-kill-destructor)))))) + #:environment-variables + (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" + (string-append "GIT_EXEC_PATH=" #$git + "/libexec/git-core")) + + #:user #$user + #:group #$group + #:log-file #$log-file)) + (stop #~(make-kill-destructor))) + ,(shepherd-service + (documentation "Run Cuirass web interface.") + (provision '(cuirass-web)) + (requirement '(guix-daemon postgres networking)) + (start #~(make-forkexec-constructor + (list (string-append #$cuirass "/bin/cuirass") + "--cache-directory" #$cache-directory + "--database" #$database + "--web" + "--port" #$(number->string port) + "--listen" #$host + "--interval" #$(number->string interval) + #$@(if use-substitutes? '("--use-substitutes") '()) + #$@(if fallback? '("--fallback") '()) + #$@extra-options) + + #:user #$user + #:group #$group + #:log-file #$web-log-file)) + (stop #~(make-kill-destructor))) + ,@(if remote-server + (match-record remote-server <cuirass-remote-server-configuration> + (backend-port publish-port log-file cache trigger-url + public-key private-key) + (list + (shepherd-service + (documentation "Run Cuirass remote build server.") + (provision '(cuirass-remote-server)) + (requirement '(avahi-daemon cuirass guix-daemon networking)) + (start #~(make-forkexec-constructor + (list (string-append #$cuirass "/bin/remote-server") + (string-append "--database=" #$database) + (string-append "--cache=" #$cache) + (string-append "--user=" #$user) + #$@(if backend-port + (list (string-append + "--backend-port=" + (number->string backend-port))) + '()) + #$@(if publish-port + (list (string-append + "--publish-port=" + (number->string publish-port))) + '()) + #$@(if trigger-url + (list + (string-append + "--trigger-substitute-url=" + trigger-url)) + '()) + #$@(if public-key + (list + (string-append "--public-key=" + public-key)) + '()) + #$@(if private-key + (list + (string-append "--private-key=" + private-key)) + '())) + #:log-file #$log-file)) + (stop #~(make-kill-destructor))))) + '())))) (define (cuirass-account config) "Return the user accounts and user groups for CONFIG." @@ -184,16 +235,24 @@ (home-directory (string-append "/var/lib/" cuirass-user)) (shell (file-append shadow "/sbin/nologin")))))) +(define (cuirass-postgresql-role config) + (let ((user (cuirass-configuration-user config))) + (list (postgresql-role + (name user) + (create-database? #t))))) + (define (cuirass-activation config) "Return the activation code for CONFIG." - (let ((cache (cuirass-configuration-cache-directory config)) - (db (dirname (cuirass-configuration-database config))) - (user (cuirass-configuration-user config)) - (log "/var/log/cuirass") - (queries-log-file (cuirass-configuration-queries-log-file config)) - (web-queries-log-file - (cuirass-configuration-web-queries-log-file config)) - (group (cuirass-configuration-group config))) + (let* ((cache (cuirass-configuration-cache-directory config)) + (remote-server (cuirass-configuration-remote-server config)) + (remote-cache (and remote-server + (cuirass-remote-server-configuration-cache + remote-server))) + (db (dirname + (cuirass-configuration-database config))) + (user (cuirass-configuration-user config)) + (log "/var/log/cuirass") + (group (cuirass-configuration-group config))) (with-imported-modules '((guix build utils)) #~(begin (use-modules (guix build utils)) @@ -202,37 +261,24 @@ (mkdir-p #$db) (mkdir-p #$log) + (when #$remote-cache + (mkdir-p #$remote-cache)) + (let ((uid (passwd:uid (getpw #$user))) (gid (group:gid (getgr #$group)))) (chown #$cache uid gid) (chown #$db uid gid) (chown #$log uid gid) - (let ((queries-log-file #$queries-log-file)) - (when queries-log-file - (call-with-output-file queries-log-file (const #t)) - (chown #$queries-log-file uid gid))) - - (let ((web-queries-log-file #$web-queries-log-file)) - (when web-queries-log-file - (call-with-output-file web-queries-log-file (const #t)) - (chown web-queries-log-file uid gid)))))))) + (when #$remote-cache + (chown #$remote-cache uid gid))))))) (define (cuirass-log-rotations config) "Return the list of log rotations that corresponds to CONFIG." - (let ((queries-log-file (cuirass-configuration-queries-log-file config)) - (web-queries-log-file - (cuirass-configuration-web-queries-log-file config))) - (list (log-rotation - (files `(,(cuirass-configuration-log-file config) - ,@(if queries-log-file - (list queries-log-file) - '()) - ,@(if web-queries-log-file - (list web-queries-log-file) - '()))) - (frequency 'weekly) - (options '("rotate 40")))))) ;worth keeping + (list (log-rotation + (files (list (cuirass-configuration-log-file config))) + (frequency 'weekly) + (options '("rotate 40"))))) ;worth keeping (define cuirass-service-type (service-type @@ -244,7 +290,72 @@ (service-extension rottlog-service-type cuirass-log-rotations) (service-extension activation-service-type cuirass-activation) (service-extension shepherd-root-service-type cuirass-shepherd-service) - (service-extension account-service-type cuirass-account))) + (service-extension account-service-type cuirass-account) + (service-extension postgresql-role-service-type + cuirass-postgresql-role))) (description "Run the Cuirass continuous integration service."))) +(define-record-type* <cuirass-remote-worker-configuration> + cuirass-remote-worker-configuration make-cuirass-remote-worker-configuration + cuirass-remote-worker-configuration? + (cuirass cuirass-remote-worker-configuration-cuirass ;package + (default cuirass)) + (workers cuirass-remote-worker-workers ;int + (default 1)) + (systems cuirass-remote-worker-systems ;list + (default (list (%current-system)))) + (log-file cuirass-remote-worker-log-file ;string + (default "/var/log/cuirass-remote-worker.log")) + (publish-port cuirass-remote-worker-configuration-publish-port ;int + (default #f)) + (public-key cuirass-remote-worker-configuration-public-key ;string + (default #f)) + (private-key cuirass-remote-worker-configuration-private-key ;string + (default #f))) + +(define (cuirass-remote-worker-shepherd-service config) + "Return a <shepherd-service> for the Cuirass remote worker service with +CONFIG." + (match-record config <cuirass-remote-worker-configuration> + (cuirass workers systems log-file publish-port public-key private-key) + (list (shepherd-service + (documentation "Run Cuirass remote build worker.") + (provision '(cuirass-remote-worker)) + (requirement '(avahi-daemon guix-daemon networking)) + (start #~(make-forkexec-constructor + (list (string-append #$cuirass "/bin/remote-worker") + (string-append "--workers=" + #$(number->string workers)) + #$@(if systems + (list (string-append + "--systems=" + (string-join systems ","))) + '()) + #$@(if publish-port + (list (string-append + "--publish-port=" + (number->string publish-port))) + '()) + #$@(if public-key + (list + (string-append "--public-key=" + public-key)) + '()) + #$@(if private-key + (list + (string-append "--private-key=" + private-key)) + '())) + #:log-file #$log-file)) + (stop #~(make-kill-destructor)))))) + +(define cuirass-remote-worker-service-type + (service-type + (name 'cuirass-remote-worker) + (extensions + (list + (service-extension shepherd-root-service-type + cuirass-remote-worker-shepherd-service))) + (description + "Run the Cuirass remote build worker service."))) diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm index e8957c6859..17ed04e58b 100644 --- a/gnu/services/cups.scm +++ b/gnu/services/cups.scm @@ -32,7 +32,7 @@ #:use-module (guix records) #:use-module (guix gexp) #:use-module (ice-9 match) - #:use-module ((srfi srfi-1) #:select (append-map)) + #:use-module ((srfi srfi-1) #:select (append-map find)) #:export (cups-service-type cups-configuration opaque-cups-configuration @@ -50,7 +50,13 @@ ;;; Code: (define %cups-accounts - (list (user-group (name "lp") (system? #t)) + (list (or + ;; The "lp" group should already exist; try to reuse it. + (find (lambda (group) + (and (user-group? group) + (string=? (user-group-name group) "lp"))) + %base-groups) + (user-group (name "lp") (system? #t))) (user-group (name "lpadmin") (system? #t)) (user-account (name "lp") @@ -482,7 +488,7 @@ programs.") (package cups) "The CUPS package.") (extensions - (package-list (list cups-filters epson-inkjet-printer-escpr + (package-list (list brlaser cups-filters epson-inkjet-printer-escpr foomatic-filters hplip-minimal splix)) "Drivers and other extensions to the CUPS package.") (files-configuration diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index d2dc5f0da8..c11898693f 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -43,6 +43,7 @@ postgresql-config-file-log-destination postgresql-config-file-hba-file postgresql-config-file-ident-file + postgresql-config-file-socket-directory postgresql-config-file-extra-config postgresql-configuration @@ -51,11 +52,24 @@ postgresql-configuration-port postgresql-configuration-locale postgresql-configuration-file + postgresql-configuration-log-directory postgresql-configuration-data-directory postgresql-service postgresql-service-type + postgresql-role + postgresql-role? + postgresql-role-name + postgresql-role-permissions + postgresql-role-create-database? + postgresql-role-configuration + postgresql-role-configuration? + postgresql-role-configuration-host + postgresql-role-configuration-roles + + postgresql-role-service-type + memcached-service-type memcached-configuration memcached-configuration? @@ -101,36 +115,48 @@ host all all ::1/128 md5")) (define-record-type* <postgresql-config-file> postgresql-config-file make-postgresql-config-file postgresql-config-file? - (log-destination postgresql-config-file-log-destination - (default "syslog")) - (hba-file postgresql-config-file-hba-file - (default %default-postgres-hba)) - (ident-file postgresql-config-file-ident-file - (default %default-postgres-ident)) - (extra-config postgresql-config-file-extra-config - (default '()))) + (log-destination postgresql-config-file-log-destination + (default "syslog")) + (hba-file postgresql-config-file-hba-file + (default %default-postgres-hba)) + (ident-file postgresql-config-file-ident-file + (default %default-postgres-ident)) + (socket-directory postgresql-config-file-socket-directory + (default "/var/run/postgresql")) + (extra-config postgresql-config-file-extra-config + (default '()))) (define-gexp-compiler (postgresql-config-file-compiler (file <postgresql-config-file>) system target) (match file (($ <postgresql-config-file> log-destination hba-file - ident-file extra-config) - (define (single-quote string) - (if string - (list "'" string "'") - '())) - - (define contents - (append-map - (match-lambda - ((key) '()) - ((key . #f) '()) - ((key values ...) `(,key " = " ,@values "\n"))) - - `(("log_destination" ,@(single-quote log-destination)) - ("hba_file" ,@(single-quote hba-file)) - ("ident_file" ,@(single-quote ident-file)) - ,@extra-config))) + ident-file socket-directory + extra-config) + ;; See: https://www.postgresql.org/docs/current/config-setting.html. + (define (format-value value) + (cond + ((boolean? value) + (list (if value "on" "off"))) + ((number? value) + (list (number->string value))) + (else + (list "'" value "'")))) + + (define contents + (append-map + (match-lambda + ((key) '()) + ((key . #f) '()) + ((key values ...) + `(,key " = " ,@(append-map format-value values) "\n"))) + + `(("log_destination" ,log-destination) + ("hba_file" ,hba-file) + ("ident_file" ,ident-file) + ,@(if socket-directory + `(("unix_socket_directories" ,socket-directory)) + '()) + ,@extra-config))) (gexp->derivation "postgresql.conf" @@ -151,6 +177,8 @@ host all all ::1/128 md5")) (default "en_US.utf8")) (config-file postgresql-configuration-file (default (postgresql-config-file))) + (log-directory postgresql-configuration-log-directory + (default "/var/log/postgresql")) (data-directory postgresql-configuration-data-directory (default "/var/lib/postgresql/data")) (extension-packages postgresql-configuration-extension-packages @@ -178,7 +206,9 @@ host all all ::1/128 md5")) #:builder (begin (use-modules (guix build utils) (guix build union) (srfi srfi-26)) - (union-build (assoc-ref %outputs "out") (map (lambda (input) (cdr input)) %build-inputs)) + (union-build (assoc-ref %outputs "out") + (map (lambda (input) (cdr input)) + %build-inputs)) #t))) (inputs `(("postgresql" ,postgresql) @@ -187,15 +217,18 @@ host all all ::1/128 md5")) (define postgresql-activation (match-lambda - (($ <postgresql-configuration> postgresql port locale config-file data-directory - extension-packages) + (($ <postgresql-configuration> postgresql port locale config-file + log-directory data-directory + extension-packages) #~(begin (use-modules (guix build utils) (ice-9 match)) (let ((user (getpwnam "postgres")) - (initdb (string-append #$(final-postgresql postgresql extension-packages) - "/bin/initdb")) + (initdb (string-append + #$(final-postgresql postgresql + extension-packages) + "/bin/initdb")) (initdb-args (append (if #$locale @@ -205,6 +238,18 @@ host all all ::1/128 md5")) (mkdir-p #$data-directory) (chown #$data-directory (passwd:uid user) (passwd:gid user)) + ;; Create the socket directory. + (let ((socket-directory + #$(postgresql-config-file-socket-directory config-file))) + (when (string? socket-directory) + (mkdir-p socket-directory) + (chown socket-directory (passwd:uid user) (passwd:gid user)))) + + ;; Create the log directory. + (when (string? #$log-directory) + (mkdir-p #$log-directory) + (chown #$log-directory (passwd:uid user) (passwd:gid user))) + ;; Drop privileges and init state directory in a new ;; process. Wait for it to finish before proceeding. (match (primitive-fork) @@ -227,8 +272,9 @@ host all all ::1/128 md5")) (define postgresql-shepherd-service (match-lambda - (($ <postgresql-configuration> postgresql port locale config-file data-directory - extension-packages) + (($ <postgresql-configuration> postgresql port locale config-file + log-directory data-directory + extension-packages) (let* ((pg_ctl-wrapper ;; Wrapper script that switches to the 'postgres' user before ;; launching daemon. @@ -240,13 +286,21 @@ host all all ::1/128 md5")) (match (command-line) ((_ mode) (let ((user (getpwnam "postgres")) - (pg_ctl #$(file-append (final-postgresql postgresql extension-packages) + (pg_ctl #$(file-append + (final-postgresql postgresql + extension-packages) "/bin/pg_ctl")) (options (format #f "--config-file=~a -p ~d" #$config-file #$port))) (setgid (passwd:gid user)) (setuid (passwd:uid user)) - (execl pg_ctl pg_ctl "-D" #$data-directory "-o" options + (execl pg_ctl pg_ctl "-D" #$data-directory + #$@(if (string? log-directory) + (list "-l" + (string-append log-directory + "/pg_ctl.log")) + '()) + "-o" options mode))))))) (pid-file (in-vicinity data-directory "postmaster.pid")) (action (lambda args @@ -266,25 +320,29 @@ host all all ::1/128 md5")) (stop (action "stop")))))))) (define postgresql-service-type - (service-type (name 'postgresql) - (extensions - (list (service-extension shepherd-root-service-type - postgresql-shepherd-service) - (service-extension activation-service-type - postgresql-activation) - (service-extension account-service-type - (const %postgresql-accounts)) - (service-extension profile-service-type - (compose list postgresql-configuration-postgresql)))))) + (service-type + (name 'postgresql) + (extensions + (list (service-extension shepherd-root-service-type + postgresql-shepherd-service) + (service-extension activation-service-type + postgresql-activation) + (service-extension account-service-type + (const %postgresql-accounts)) + (service-extension + profile-service-type + (compose list postgresql-configuration-postgresql)))))) (define-deprecated (postgresql-service #:key (postgresql postgresql) (port 5432) (locale "en_US.utf8") (config-file (postgresql-config-file)) - (data-directory "/var/lib/postgresql/data") + (data-directory + "/var/lib/postgresql/data") (extension-packages '())) postgresql-service-type - "Return a service that runs @var{postgresql}, the PostgreSQL database server. + "Return a service that runs @var{postgresql}, the PostgreSQL database +server. The PostgreSQL daemon loads its runtime configuration from @var{config-file} and stores the database cluster in @var{data-directory}." @@ -297,6 +355,96 @@ and stores the database cluster in @var{data-directory}." (data-directory data-directory) (extension-packages extension-packages)))) +(define-record-type* <postgresql-role> + postgresql-role make-postgresql-role + postgresql-role? + (name postgresql-role-name) ;string + (permissions postgresql-role-permissions + (default '(createdb login))) ;list + (create-database? postgresql-role-create-database? ;boolean + (default #f))) + +(define-record-type* <postgresql-role-configuration> + postgresql-role-configuration make-postgresql-role-configuration + postgresql-role-configuration? + (host postgresql-role-configuration-host ;string + (default "/var/run/postgresql")) + (log postgresql-role-configuration-log ;string + (default "/var/log/postgresql_roles.log")) + (roles postgresql-role-configuration-roles + (default '()))) ;list + +(define (postgresql-create-roles config) + ;; See: https://www.postgresql.org/docs/current/sql-createrole.html for the + ;; complete permissions list. + (define (format-permissions permissions) + (let ((dict '(bypassrls createdb createrole login replication superuser))) + (string-join (filter-map (lambda (permission) + (and (member permission dict) + (string-upcase + (symbol->string permission)))) + permissions) + " "))) + + (define (roles->queries roles) + (apply mixed-text-file "queries" + (append-map + (lambda (role) + (match-record role <postgresql-role> + (name permissions create-database?) + `("SELECT NOT(EXISTS(SELECT 1 FROM pg_catalog.pg_roles WHERE \ +rolname = '" ,name "')) as not_exists;\n" +"\\gset\n" +"\\if :not_exists\n" +"CREATE ROLE " ,name +" WITH " ,(format-permissions permissions) +";\n" +,@(if create-database? + `("CREATE DATABASE " ,name + " OWNER " ,name ";\n") + '()) +"\\endif\n"))) + roles))) + + (let ((host (postgresql-role-configuration-host config)) + (roles (postgresql-role-configuration-roles config))) + (program-file + "postgresql-create-roles" + #~(begin + (let ((psql #$(file-append postgresql "/bin/psql"))) + (execl psql psql "-a" + "-h" #$host + "-f" #$(roles->queries roles))))))) + +(define (postgresql-role-shepherd-service config) + (match-record config <postgresql-role-configuration> + (log) + (list (shepherd-service + (requirement '(postgres)) + (provision '(postgres-roles)) + (one-shot? #t) + (start #~(make-forkexec-constructor + (list #$(postgresql-create-roles config)) + #:user "postgres" #:group "postgres" + #:log-file #$log)) + (documentation "Create PostgreSQL roles."))))) + +(define postgresql-role-service-type + (service-type (name 'postgresql-role) + (extensions + (list (service-extension shepherd-root-service-type + postgresql-role-shepherd-service))) + (compose concatenate) + (extend (lambda (config extended-roles) + (match-record config <postgresql-role-configuration> + (host roles) + (postgresql-role-configuration + (host host) + (roles (append roles extended-roles)))))) + (default-value (postgresql-role-configuration)) + (description "Ensure the specified PostgreSQL roles are +created after the PostgreSQL database is started."))) + ;;; ;;; Memcached diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 9ec0f6a9ca..a4d4ac0646 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 John Darrington <jmd@gnu.org> @@ -14,6 +14,7 @@ ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org> ;;; Copyright © 2019 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +43,7 @@ #:use-module (gnu packages admin) #:use-module (gnu packages base) #:use-module (gnu packages bash) + #:use-module (gnu packages cluster) #:use-module (gnu packages connman) #:use-module (gnu packages freedesktop) #:use-module (gnu packages linux) @@ -192,7 +194,11 @@ yggdrasil-configuration-log-level yggdrasil-configuration-log-to yggdrasil-configuration-json-config - yggdrasil-configuration-package)) + yggdrasil-configuration-package + + keepalived-configuration + keepalived-configuration? + keepalived-service-type)) ;;; Commentary: ;;; @@ -277,7 +283,9 @@ fe80::1%lo0 apps.facebook.com\n") (and (zero? (cdr (waitpid pid))) (read-pid-file #$pid-file))))) (stop #~(make-kill-destructor)))) - isc-dhcp)) + isc-dhcp + (description "Run @command{dhcp}, a Dynamic Host Configuration +Protocol (DHCP) client, on all the non-loopback network interfaces."))) (define-deprecated (dhcp-client-service #:key (dhcp isc-dhcp)) dhcp-client-service-type @@ -552,9 +560,7 @@ make an initial adjustment of more than 1,000 seconds." (constraint-from openntpd-constraint-from (default '())) (constraints-from openntpd-constraints-from - (default '())) - (allow-large-adjustment? openntpd-allow-large-adjustment? - (default #f))) ; upstream default + (default '()))) (define (openntpd-configuration->string config) @@ -586,8 +592,7 @@ make an initial adjustment of more than 1,000 seconds." "\n"))) ;add a trailing newline (define (openntpd-shepherd-service config) - (let ((openntpd (openntpd-configuration-openntpd config)) - (allow-large-adjustment? (openntpd-allow-large-adjustment? config))) + (let ((openntpd (openntpd-configuration-openntpd config))) (define ntpd.conf (plain-file "ntpd.conf" (openntpd-configuration->string config))) @@ -599,10 +604,7 @@ make an initial adjustment of more than 1,000 seconds." (start #~(make-forkexec-constructor (list (string-append #$openntpd "/sbin/ntpd") "-f" #$ntpd.conf - "-d" ;; don't daemonize - #$@(if allow-large-adjustment? - '("-s") - '())) + "-d") ;; don't daemonize ;; When ntpd is daemonized it repeatedly tries to respawn ;; while running, leading shepherd to disable it. To ;; prevent spamming stderr, redirect output to logfile. @@ -1865,4 +1867,43 @@ See yggdrasil -genconf for config options.") (service-extension profile-service-type (compose list yggdrasil-configuration-package)))))) + +;;; +;;; Keepalived +;;; + +(define-record-type* <keepalived-configuration> + keepalived-configuration make-keepalived-configuration + keepalived-configuration? + (keepalived keepalived-configuration-keepalived ;<package> + (default keepalived)) + (config-file keepalived-configuration-config-file ;file-like + (default #f))) + +(define keepalived-shepherd-service + (match-lambda + (($ <keepalived-configuration> keepalived config-file) + (list + (shepherd-service + (provision '(keepalived)) + (documentation "Run keepalived.") + (requirement '(loopback)) + (start #~(make-forkexec-constructor + (list (string-append #$keepalived "/sbin/keepalived") + "--dont-fork" "--log-console" "--log-detail" + "--pid=/var/run/keepalived.pid" + (string-append "--use-file=" #$config-file)) + #:pid-file "/var/run/keepalived.pid" + #:log-file "/var/log/keepalived.log")) + (respawn? #f) + (stop #~(make-kill-destructor))))))) + +(define keepalived-service-type + (service-type (name 'keepalived) + (extensions (list (service-extension shepherd-root-service-type + keepalived-shepherd-service))) + (description + "Run @uref{https://www.keepalived.org/, Keepalived} +routing software."))) + ;;; networking.scm ends here diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm index 1faeb350df..e2ec59f5aa 100644 --- a/gnu/services/shepherd.scm +++ b/gnu/services/shepherd.scm @@ -1,8 +1,9 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,7 +37,12 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) - #:export (shepherd-root-service-type + #:export (shepherd-configuration + shepherd-configuration? + shepherd-configuration-shepherd + shepherd-configuration-services + + shepherd-root-service-type %shepherd-root-service shepherd-service-type @@ -76,7 +82,18 @@ ;;; Code: -(define (shepherd-boot-gexp services) +(define-record-type* <shepherd-configuration> + shepherd-configuration make-shepherd-configuration + shepherd-configuration? + (shepherd shepherd-configuration-shepherd + (default shepherd)) ; package + (services shepherd-configuration-services + (default '()))) ; list of <shepherd-service> + +(define (shepherd-boot-gexp config) + "Return a gexp starting the shepherd service." + (let ((shepherd (shepherd-configuration-shepherd config)) + (services (shepherd-configuration-services config))) #~(begin ;; Keep track of the booted system. (false-if-exception (delete-file "/run/booted-system")) @@ -95,7 +112,10 @@ ;; Start shepherd. (execl #$(file-append shepherd "/bin/shepherd") "shepherd" "--config" - #$(shepherd-configuration-file services)))) + #$(shepherd-configuration-file services shepherd))))) + +(define shepherd-packages + (compose list shepherd-configuration-shepherd)) (define shepherd-root-service-type (service-type @@ -103,39 +123,46 @@ ;; Extending the root shepherd service (aka. PID 1) happens by ;; concatenating the list of services provided by the extensions. (compose concatenate) - (extend append) + (extend (lambda (config extra-services) + (shepherd-configuration + (inherit config) + (services (append (shepherd-configuration-services config) + extra-services))))) (extensions (list (service-extension boot-service-type shepherd-boot-gexp) (service-extension profile-service-type - (const (list shepherd))))) + shepherd-packages))) + (default-value (shepherd-configuration)) (description "Run the GNU Shepherd as PID 1---i.e., the operating system's first process. The Shepherd takes care of managing services such as daemons by ensuring they are started and stopped in the right order."))) (define %shepherd-root-service - ;; The root shepherd service, aka. PID 1. Its parameter is a list of - ;; <shepherd-service> objects. - (service shepherd-root-service-type '())) + ;; The root shepherd service, aka. PID 1. Its parameter is a + ;; <shepherd-configuration>. + (service shepherd-root-service-type)) (define-syntax shepherd-service-type - (syntax-rules () + (syntax-rules (description) "Return a <service-type> denoting a simple shepherd service--i.e., the type for a service that extends SHEPHERD-ROOT-SERVICE-TYPE and nothing else. When DEFAULT is given, use it as the service's default value." - ((_ service-name proc default) + ((_ service-name proc default (description text)) (service-type (name service-name) (extensions (list (service-extension shepherd-root-service-type (compose list proc)))) - (default-value default))) - ((_ service-name proc) + (default-value default) + (description text))) + ((_ service-name proc (description text)) (service-type (name service-name) (extensions (list (service-extension shepherd-root-service-type - (compose list proc)))))))) + (compose list proc)))) + (description text))))) (define %default-imported-modules ;; Default set of modules imported for a service's consumption. @@ -268,9 +295,9 @@ stored." #~(#$name #$doc #$proc))) (shepherd-service-actions service)))))))) -(define (scm->go file) +(define (scm->go file shepherd) "Compile FILE, which contains code to be loaded by shepherd's config file, -and return the resulting '.go' file." +and return the resulting '.go' file. SHEPHERD is used as shepherd package." (let-system (system target) (with-extensions (list shepherd) (computed-file (string-append (basename (scheme-file-name file) ".scm") @@ -292,11 +319,13 @@ and return the resulting '.go' file." #:options '(#:local-build? #t #:substitutable? #f))))) -(define (shepherd-configuration-file services) - "Return the shepherd configuration file for SERVICES." +(define (shepherd-configuration-file services shepherd) + "Return the shepherd configuration file for SERVICES. SHEPHERD is used +as shepherd package." (assert-valid-graph services) - (let ((files (map shepherd-service-file services))) + (let ((files (map shepherd-service-file services)) + (scm->go (cute scm->go <> shepherd))) (define config #~(begin (use-modules (srfi srfi-34) diff --git a/gnu/services/syncthing.scm b/gnu/services/syncthing.scm new file mode 100644 index 0000000000..12ebe7c107 --- /dev/null +++ b/gnu/services/syncthing.scm @@ -0,0 +1,89 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu services syncthing) + #:use-module (gnu packages syncthing) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (syncthing-configuration + syncthing-configuration? + syncthing-service-type)) + +;;; Commentary: +;;; +;;; This module provides a service definition for the syncthing service. +;;; +;;; Code: + +(define-record-type* <syncthing-configuration> + syncthing-configuration make-syncthing-configuration + syncthing-configuration? + (syncthing syncthing-configuration-syncthing ;<package> + (default syncthing)) + (arguments syncthing-configuration-arguments ;list of strings + (default '())) + (logflags syncthing-configuration-logflags ;number + (default 0)) + (user syncthing-configuration-user ;string + (default #f)) + (group syncthing-configuration-group ;string + (default "users")) + (home syncthing-configuration-home ;string + (default #f))) + +(define syncthing-shepherd-service + (match-lambda + (($ <syncthing-configuration> syncthing arguments logflags user group home) + (list + (shepherd-service + (provision (list (string->symbol (string-append "syncthing-" user)))) + (documentation "Run syncthing.") + (requirement '(loopback)) + (start #~(make-forkexec-constructor + (append (list (string-append #$syncthing "/bin/syncthing") + "-no-browser" + "-no-restart" + (string-append "-logflags=" (number->string #$logflags))) + '#$arguments) + #:user #$user + #:group #$group + #:environment-variables + (append (list (string-append "HOME=" (or #$home (passwd:dir (getpw #$user)))) + "SSL_CERT_DIR=/etc/ssl/certs" + "SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt") + (remove (lambda (str) + (or (string-prefix? "HOME=" str) + (string-prefix? "SSL_CERT_DIR=" str) + (string-prefix? "SSL_CERT_FILE=" str))) + (environ))))) + (respawn? #f) + (stop #~(make-kill-destructor))))))) + +(define syncthing-service-type + (service-type (name 'syncthing) + (extensions (list (service-extension shepherd-root-service-type + syncthing-shepherd-service))) + (description + "Run @uref{https://github.com/syncthing/syncthing, Syncthing} +decentralized continuous file system synchronization."))) + +;;; syncthing.scm ends here diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index f435630faf..a45da14a80 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com> ;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org> -;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2020,2021 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -717,7 +717,7 @@ potential infinite waits blocking libvirt.")) (platforms qemu-binfmt-configuration-platforms (default '())) ;safest default (guix-support? qemu-binfmt-configuration-guix-support? - (default #f))) + (default #t))) (define (qemu-platform->binfmt qemu platform) "Return a gexp that evaluates to a binfmt string for PLATFORM, using the @@ -917,7 +917,9 @@ is added to the OS specified in CONFIG." (disk-size (hurd-vm-configuration-disk-size config)) (type (lookup-image-type-by-name 'hurd-qcow2)) (os->image (image-type-constructor type))) - (system-image (os->image os)))) + (system-image + (image (inherit (os->image os)) + (size disk-size))))) (define (hurd-vm-port config base) "Return the forwarded vm port for this childhurd config." diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 855f4e649b..ff7b262b6a 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -922,19 +922,20 @@ of index files." (define php-fpm-accounts (match-lambda (($ <php-fpm-configuration> php socket user group socket-user socket-group _ _ _ _ _ _) - (list - (user-group (name "php-fpm") (system? #t)) - (user-group - (name group) - (system? #t)) - (user-account - (name user) - (group group) - (supplementary-groups '("php-fpm")) - (system? #t) - (comment "php-fpm daemon user") - (home-directory "/var/empty") - (shell (file-append shadow "/sbin/nologin"))))))) + `(,@(if (equal? group "php-fpm") + '() + (list (user-group (name "php-fpm") (system? #t)))) + ,(user-group + (name group) + (system? #t)) + ,(user-account + (name user) + (group group) + (supplementary-groups '("php-fpm")) + (system? #t) + (comment "php-fpm daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))))) (define (default-php-fpm-config socket user group socket-user socket-group pid-file log-file pm display-errors timezone workers-log-file) |