diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/admin.scm | 141 | ||||
| -rw-r--r-- | gnu/services/auditd.scm | 41 | ||||
| -rw-r--r-- | gnu/services/base.scm | 115 | ||||
| -rw-r--r-- | gnu/services/databases.scm | 4 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 3 | ||||
| -rw-r--r-- | gnu/services/docker.scm | 11 | ||||
| -rw-r--r-- | gnu/services/ganeti.scm | 2 | ||||
| -rw-r--r-- | gnu/services/linux.scm | 81 | ||||
| -rw-r--r-- | gnu/services/mcron.scm | 33 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 5 | ||||
| -rw-r--r-- | gnu/services/nix.scm | 22 | ||||
| -rw-r--r-- | gnu/services/virtualization.scm | 100 | ||||
| -rw-r--r-- | gnu/services/web.scm | 19 |
13 files changed, 482 insertions, 95 deletions
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm index 89fa73920d..b34b990f32 100644 --- a/gnu/services/admin.scm +++ b/gnu/services/admin.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> -;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> ;;; ;;; This file is part of GNU Guix. @@ -20,10 +20,13 @@ (define-module (gnu services admin) #:use-module (gnu packages admin) + #:use-module (gnu packages certs) + #:use-module (gnu packages package-management) #:use-module (gnu services) #:use-module (gnu services mcron) #:use-module (gnu services shepherd) #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (guix packages) #:use-module (guix records) #:use-module (srfi srfi-1) @@ -41,7 +44,18 @@ rottlog-configuration rottlog-configuration? rottlog-service - rottlog-service-type)) + rottlog-service-type + + unattended-upgrade-service-type + unattended-upgrade-configuration + unattended-upgrade-configuration? + unattended-upgrade-configuration-operating-system-file + unattended-upgrade-configuration-channels + unattended-upgrade-configuration-schedule + unattended-upgrade-configuration-services-to-restart + unattended-upgrade-configuration-system-expiration + unattended-upgrade-configuration-maximum-duration + unattended-upgrade-configuration-log-file)) ;;; Commentary: ;;; @@ -177,4 +191,127 @@ Old log files are removed or compressed according to the configuration.") rotations))))) (default-value (rottlog-configuration)))) + +;;; +;;; Unattended upgrade. +;;; + +(define-record-type* <unattended-upgrade-configuration> + unattended-upgrade-configuration make-unattended-upgrade-configuration + unattended-upgrade-configuration? + (operating-system-file unattended-upgrade-operating-system-file + (default "/run/current-system/configuration.scm")) + (schedule unattended-upgrade-configuration-schedule + (default "30 01 * * 0")) + (channels unattended-upgrade-configuration-channels + (default #~%default-channels)) + (services-to-restart unattended-upgrade-configuration-services-to-restart + (default '(mcron))) + (system-expiration unattended-upgrade-system-expiration + (default (* 3 30 24 3600))) + (maximum-duration unattended-upgrade-maximum-duration + (default 3600)) + (log-file unattended-upgrade-configuration-log-file + (default %unattended-upgrade-log-file))) + +(define %unattended-upgrade-log-file + "/var/log/unattended-upgrade.log") + +(define (unattended-upgrade-mcron-jobs config) + (define channels + (scheme-file "channels.scm" + (unattended-upgrade-configuration-channels config))) + + (define log + (unattended-upgrade-configuration-log-file config)) + + (define services + (unattended-upgrade-configuration-services-to-restart config)) + + (define expiration + (unattended-upgrade-system-expiration config)) + + (define config-file + (unattended-upgrade-operating-system-file config)) + + (define code + (with-imported-modules (source-module-closure '((guix build utils) + (gnu services herd))) + #~(begin + (use-modules (guix build utils) + (gnu services herd) + (srfi srfi-19) + (srfi srfi-34)) + + (define log + (open-file #$log "a0")) + + (define (timestamp) + (date->string (time-utc->date (current-time time-utc)) + "[~4]")) + + (define (alarm-handler . _) + (format #t "~a time is up, aborting upgrade~%" + (timestamp)) + (exit 1)) + + ;; 'guix time-machine' needs X.509 certificates to authenticate the + ;; Git host. + (setenv "SSL_CERT_DIR" + #$(file-append nss-certs "/etc/ssl/certs")) + + ;; Make sure the upgrade doesn't take too long. + (sigaction SIGALRM alarm-handler) + (alarm #$(unattended-upgrade-maximum-duration config)) + + ;; Redirect stdout/stderr to LOG to save the output of 'guix' below. + (redirect-port log (current-output-port)) + (redirect-port log (current-error-port)) + + (format #t "~a starting upgrade...~%" (timestamp)) + (guard (c ((invoke-error? c) + (report-invoke-error c))) + (invoke #$(file-append guix "/bin/guix") + "time-machine" "-C" #$channels + "--" "system" "reconfigure" #$config-file) + + ;; 'guix system delete-generations' fails when there's no + ;; matching generation. Thus, catch 'invoke-error?'. + (guard (c ((invoke-error? c) + (report-invoke-error c))) + (invoke #$(file-append guix "/bin/guix") + "system" "delete-generations" + #$(string-append (number->string expiration) + "s"))) + + (format #t "~a restarting services...~%" (timestamp)) + (for-each restart-service '#$services) + + ;; XXX: If 'mcron' has been restarted, perhaps this isn't + ;; reached. + (format #t "~a upgrade complete~%" (timestamp)))))) + + (define upgrade + (program-file "unattended-upgrade" code)) + + (list #~(job #$(unattended-upgrade-configuration-schedule config) + #$upgrade))) + +(define (unattended-upgrade-log-rotations config) + (list (log-rotation + (files + (list (unattended-upgrade-configuration-log-file config)))))) + +(define unattended-upgrade-service-type + (service-type + (name 'unattended-upgrade) + (extensions + (list (service-extension mcron-service-type + unattended-upgrade-mcron-jobs) + (service-extension rottlog-service-type + unattended-upgrade-log-rotations))) + (description + "Periodically upgrade the system from the current configuration.") + (default-value (unattended-upgrade-configuration)))) + ;;; admin.scm ends here diff --git a/gnu/services/auditd.scm b/gnu/services/auditd.scm index 8a9292015f..cffc226ec9 100644 --- a/gnu/services/auditd.scm +++ b/gnu/services/auditd.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org> +;;; Copyright © 2020 Robin Green <greenrd@greenrd.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,29 +27,47 @@ #:use-module (guix gexp) #:use-module (guix packages) #:export (auditd-configuration - auditd-service-type)) + auditd-service-type + %default-auditd-configuration-directory)) -; /etc/audit/audit.rules +(define auditd.conf + (plain-file "auditd.conf" "log_file = /var/log/audit.log\nlog_format = \ +ENRICHED\nfreq = 1\nspace_left = 5%\nspace_left_action = \ +syslog\nadmin_space_left_action = ignore\ndisk_full_action = \ +ignore\ndisk_error_action = syslog\n")) -(define-configuration auditd-configuration - (audit - (package audit) - "Audit package.")) +(define %default-auditd-configuration-directory + (computed-file "auditd" + #~(begin + (mkdir #$output) + (copy-file #$auditd.conf + (string-append #$output "/auditd.conf"))))) + +(define-record-type* <auditd-configuration> + auditd-configuration make-auditd-configuration + auditd-configuration? + (audit auditd-configuration-audit ; package + (default audit)) + (configuration-directory auditd-configuration-configuration-directory)) ; file-like (define (auditd-shepherd-service config) - (let* ((audit (auditd-configuration-audit config))) + (let* ((audit (auditd-configuration-audit config)) + (configuration-directory (auditd-configuration-configuration-directory config))) (list (shepherd-service - (documentation "Auditd allows you to audit file system accesses.") + (documentation "Auditd allows you to audit file system accesses and process execution.") (provision '(auditd)) (start #~(make-forkexec-constructor - (list (string-append #$audit "/sbin/auditd")))) + (list (string-append #$audit "/sbin/auditd") "-c" #$configuration-directory) + #:pid-file "/var/run/auditd.pid")) (stop #~(make-kill-destructor)))))) (define auditd-service-type (service-type (name 'auditd) - (description "Allows auditing file system accesses.") + (description "Allows auditing file system accesses and process execution.") (extensions (list (service-extension shepherd-root-service-type auditd-shepherd-service))) - (default-value (auditd-configuration)))) + (default-value + (auditd-configuration + (configuration-directory %default-auditd-configuration-directory))))) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 491f35702a..d560ad5a13 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1558,57 +1558,72 @@ proxy of 'guix-daemon'...~%") (provision '(guix-daemon)) (requirement '(user-processes)) (actions (list shepherd-set-http-proxy-action)) - (modules '((srfi srfi-1))) + (modules '((srfi srfi-1) + (ice-9 match) + (gnu build shepherd))) (start - #~(lambda _ - (define proxy - ;; HTTP/HTTPS proxy. The 'http_proxy' variable is set by - ;; the 'set-http-proxy' action. - (or (getenv "http_proxy") #$http-proxy)) - - (fork+exec-command - (cons* #$(file-append guix "/bin/guix-daemon") - "--build-users-group" #$build-group - "--max-silent-time" #$(number->string max-silent-time) - "--timeout" #$(number->string timeout) - "--log-compression" #$(symbol->string log-compression) - #$@(if use-substitutes? - '() - '("--no-substitutes")) - "--substitute-urls" #$(string-join substitute-urls) - #$@extra-options - - ;; Add CHROOT-DIRECTORIES and all their dependencies - ;; (if these are store items) to the chroot. - (append-map (lambda (file) - (append-map (lambda (directory) - (list "--chroot-directory" - directory)) - (call-with-input-file file - read))) - '#$(map references-file - chroot-directories))) - - #:environment-variables - (append (list #$@(if tmpdir - (list (string-append "TMPDIR=" tmpdir)) - '()) - - ;; Make sure we run in a UTF-8 locale so that - ;; 'guix offload' correctly restores nars that - ;; contain UTF-8 file names such as - ;; 'nss-certs'. See - ;; <https://bugs.gnu.org/32942>. - (string-append "GUIX_LOCPATH=" - #$glibc-utf8-locales - "/lib/locale") - "LC_ALL=en_US.utf8") - (if proxy - (list (string-append "http_proxy=" proxy) - (string-append "https_proxy=" proxy)) - '())) - - #:log-file #$log-file))) + (with-imported-modules (source-module-closure + '((gnu build shepherd))) + #~(lambda args + (define proxy + ;; HTTP/HTTPS proxy. The 'http_proxy' variable is set by + ;; the 'set-http-proxy' action. + (or (getenv "http_proxy") #$http-proxy)) + + (fork+exec-command/container + (cons* #$(file-append guix "/bin/guix-daemon") + "--build-users-group" #$build-group + "--max-silent-time" + #$(number->string max-silent-time) + "--timeout" #$(number->string timeout) + "--log-compression" + #$(symbol->string log-compression) + #$@(if use-substitutes? + '() + '("--no-substitutes")) + "--substitute-urls" #$(string-join substitute-urls) + #$@extra-options + + ;; Add CHROOT-DIRECTORIES and all their dependencies + ;; (if these are store items) to the chroot. + (append-map + (lambda (file) + (append-map (lambda (directory) + (list "--chroot-directory" + directory)) + (call-with-input-file file + read))) + '#$(map references-file + chroot-directories))) + + ;; When running the installer, we need guix-daemon to + ;; operate from within the same MNT namespace as the + ;; installation container. In that case only, enter the + ;; namespace of the process PID passed as start argument. + #:pid (match args + ((pid) (string->number pid)) + (else (getpid))) + + #:environment-variables + (append (list #$@(if tmpdir + (list (string-append "TMPDIR=" tmpdir)) + '()) + + ;; Make sure we run in a UTF-8 locale so that + ;; 'guix offload' correctly restores nars + ;; that contain UTF-8 file names such as + ;; 'nss-certs'. See + ;; <https://bugs.gnu.org/32942>. + (string-append "GUIX_LOCPATH=" + #$glibc-utf8-locales + "/lib/locale") + "LC_ALL=en_US.utf8") + (if proxy + (list (string-append "http_proxy=" proxy) + (string-append "https_proxy=" proxy)) + '())) + + #:log-file #$log-file)))) (stop #~(make-kill-destructor)))))) (define (guix-accounts config) diff --git a/gnu/services/databases.scm b/gnu/services/databases.scm index 473ece4e97..2bddf70f71 100644 --- a/gnu/services/databases.scm +++ b/gnu/services/databases.scm @@ -276,7 +276,9 @@ host all all ::1/128 md5")) (service-extension activation-service-type postgresql-activation) (service-extension account-service-type - (const %postgresql-accounts)))) + (const %postgresql-accounts)) + (service-extension profile-service-type + (compose list postgresql-configuration-postgresql)))) (default-value (postgresql-configuration)))) (define* (postgresql-service #:key (postgresql postgresql) diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 9e45743586..bdbea5dddf 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -836,7 +836,8 @@ when they log out." (list (service-extension activation-service-type (const %accountsservice-activation)) (service-extension dbus-root-service-type list) - (service-extension polkit-service-type list))))) + (service-extension polkit-service-type list))) + (default-value accountsservice))) (define* (accountsservice-service #:key (accountsservice accountsservice)) "Return a service that runs AccountsService, a system service that diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 937dff7bdb..380a942ed2 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -56,7 +56,10 @@ loop-back communications.") "Enable or disable the user-land proxy (enabled by default).") (debug? (boolean #f) - "Enable or disable debug output.")) + "Enable or disable debug output.") + (enable-iptables? + (boolean #t) + "Enable addition of iptables rules (enabled by default).")) (define %docker-accounts (list (user-group (name "docker") (system? #t)))) @@ -91,6 +94,7 @@ loop-back communications.") (define (docker-shepherd-service config) (let* ((docker (docker-configuration-docker config)) (enable-proxy? (docker-configuration-enable-proxy? config)) + (enable-iptables? (docker-configuration-enable-iptables? config)) (proxy (docker-configuration-proxy config)) (debug? (docker-configuration-debug? config))) (shepherd-service @@ -115,7 +119,10 @@ loop-back communications.") '()) (if #$enable-proxy? "--userland-proxy" "") "--userland-proxy-path" (string-append #$proxy - "/bin/proxy")) + "/bin/proxy") + (if #$enable-iptables? + "--iptables" + "--iptables=false")) #:pid-file "/var/run/docker.pid" #:log-file "/var/log/docker.log")) (stop #~(make-kill-destructor))))) diff --git a/gnu/services/ganeti.scm b/gnu/services/ganeti.scm index 8d30472371..e2a2ec63e1 100644 --- a/gnu/services/ganeti.scm +++ b/gnu/services/ganeti.scm @@ -550,7 +550,7 @@ The KVM daemon monitors, using @code{inotify}, KVM instances through their QMP sockets, which are provided by KVM. Using the QMP sockets, the KVM daemon listens for particular shutdown, powerdown, and stop events which will determine if a given instance was shutdown by the user or Ganeti, and this result is -communicated to Ganeti via a special file in the filesystem."))) +communicated to Ganeti via a special file in the file system."))) (define-record-type* <ganeti-mond-configuration> ganeti-mond-configuration make-ganeti-mond-configuration diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index 12934c2084..ec42663a11 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re> +;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +23,7 @@ #:use-module (guix records) #:use-module (guix modules) #:use-module (gnu services) + #:use-module (gnu services base) #:use-module (gnu services shepherd) #:use-module (gnu packages linux) #:use-module (srfi srfi-1) @@ -42,7 +44,15 @@ earlyoom-configuration-send-notification-command earlyoom-service-type - kernel-module-loader-service-type)) + kernel-module-loader-service-type + + zram-device-configuration + zram-device-configuration? + zram-device-configuration-size + zram-device-configuration-compression-algorithm + zram-device-configuration-memory-limit + zram-device-configuration-priority + zram-device-service-type)) ;;; @@ -177,3 +187,72 @@ representation." (compose concatenate) (extend append) (default-value '()))) + + +;;; +;;; Kernel module loader. +;;; + +(define-record-type* <zram-device-configuration> + zram-device-configuration make-zram-device-configuration + zram-device-configuration? + (size zram-device-configration-size + (default "1G")) ; string or integer + (compression-algorithm zram-device-configuration-compression-algorithm + (default 'lzo)) ; symbol + (memory-limit zram-device-configuration-memory-limit + (default 0)) ; string or integer + (priority zram-device-configuration-priority + (default -1))) ; integer + +(define (zram-device-configuration->udev-string config) + "Translate a <zram-device-configuration> into a string which can be +placed in a udev rules file." + (match config + (($ <zram-device-configuration> size compression-algorithm memory-limit priority) + (string-append + "KERNEL==\"zram0\", " + "ATTR{comp_algorithm}=\"" (symbol->string compression-algorithm) "\" " + (if (not (or (equal? "0" size) + (equal? 0 size))) + (string-append "ATTR{disksize}=\"" (if (number? size) + (number->string size) + size) + "\" ") + "") + (if (not (or (equal? "0" memory-limit) + (equal? 0 memory-limit))) + (string-append "ATTR{mem_limit}=\"" (if (number? memory-limit) + (number->string memory-limit) + memory-limit) + "\" ") + "") + "RUN+=\"/run/current-system/profile/sbin/mkswap /dev/zram0\" " + "RUN+=\"/run/current-system/profile/sbin/swapon " + (if (not (equal? -1 priority)) + (string-append "--priority " (number->string priority) " ") + "") + "/dev/zram0\"\n")))) + +(define %zram-device-config + `("modprobe.d/zram.conf" + ,(plain-file "zram.conf" + "options zram num_devices=1"))) + +(define (zram-device-udev-rule config) + (file->udev-rule "99-zram.rules" + (plain-file "99-zram.rules" + (zram-device-configuration->udev-string config)))) + +(define zram-device-service-type + (service-type + (name 'zram) + (default-value (zram-device-configuration)) + (extensions + (list (service-extension kernel-module-loader-service-type + (const (list "zram"))) + (service-extension etc-service-type + (const (list %zram-device-config))) + (service-extension udev-service-type + (compose list zram-device-udev-rule)))) + (description "Creates a zram swap device."))) diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm index d9627c6bd0..bd4e6e7410 100644 --- a/gnu/services/mcron.scm +++ b/gnu/services/mcron.scm @@ -57,8 +57,35 @@ (jobs mcron-configuration-jobs ;list of <mcron-job> (default '()))) -(define (job-file job) - (scheme-file "mcron-job" job)) +(define (job-files mcron jobs) + "Return a list of file-like object for JOBS, a list of gexps." + (define (validated-file job) + ;; This procedure behaves like 'scheme-file' but it runs 'mcron + ;; --schedule' to detect any error in JOB. + (computed-file "mcron-job" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (call-with-output-file "prologue" + (lambda (port) + ;; This prologue allows 'mcron --schedule' to + ;; proceed no matter what #:user option is passed + ;; to 'job'. + (write '(set! getpw + (const (getpwuid (getuid)))) + port))) + + (call-with-output-file "job" + (lambda (port) + (write '#$job port))) + + (invoke #+(file-append mcron "/bin/mcron") + "--schedule=20" "prologue" "job") + (copy-file "job" #$output))) + #:options '(#:env-vars (("COLUMNS" . "150"))))) + + (map validated-file jobs)) (define (shepherd-schedule-action mcron files) "Return a Shepherd action that runs MCRON with '--schedule' for the given @@ -101,7 +128,7 @@ files." (($ <mcron-configuration> mcron ()) ;nothing to do! '()) (($ <mcron-configuration> mcron jobs) - (let ((files (map job-file jobs))) + (let ((files (job-files mcron jobs))) (list (shepherd-service (provision '(mcron)) (requirement '(user-processes)) diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 353fdce2bb..e45b116218 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> -;;; Copyright © 2016, 2018 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2016 John Darrington <jmd@gnu.org> ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be> @@ -1163,7 +1163,8 @@ wireless networking.")))) (start #~(make-forkexec-constructor (list (string-append #$connman "/sbin/connmand") - "-n" "-r" + "--nodaemon" + "--nodnsproxy" #$@(if disable-vpn? '("--noplugin=vpn") '())) ;; As connman(8) notes, when passing '-n', connman diff --git a/gnu/services/nix.scm b/gnu/services/nix.scm index 75b2df02dc..93f46ef71e 100644 --- a/gnu/services/nix.scm +++ b/gnu/services/nix.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019, 2020 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Peng Mei Yu <i@pengmeiyu.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -34,7 +35,10 @@ #:use-module (ice-9 match) #:use-module (ice-9 format) #:use-module (guix modules) - #:export (nix-service-type)) + #:export (nix-service-type + + nix-configuration + nix-configuration?)) ;;; Commentary: ;;; @@ -51,7 +55,9 @@ (default #t)) (build-sandbox-items nix-configuration-build-sandbox-items ;list of strings (default '())) - (extra-config nix-configuration-extra-options ;list of strings + (extra-config nix-configuration-extra-config ;list of strings + (default '())) + (extra-options nix-configuration-extra-options ;list of strings (default '()))) ;; Copied from gnu/services/base.scm @@ -112,19 +118,21 @@ GID." '#$(map references-file (list package))) '#$build-sandbox-items)) - (for-each (cut display <>) '#$extra-config)))))))) + (for-each (cut display <>) '#$extra-config) + (newline)))))))) (define nix-shepherd-service ;; Return a <shepherd-service> for Nix. (match-lambda - (($ <nix-configuration> package _ ...) + (($ <nix-configuration> package _ _ _ extra-options) (list (shepherd-service (provision '(nix-daemon)) (documentation "Run nix-daemon.") (requirement '()) (start #~(make-forkexec-constructor - (list (string-append #$package "/bin/nix-daemon")))) + (list (string-append #$package "/bin/nix-daemon") + #$@extra-options))) (respawn? #f) (stop #~(make-kill-destructor))))))) @@ -134,7 +142,9 @@ GID." (extensions (list (service-extension shepherd-root-service-type nix-shepherd-service) (service-extension account-service-type nix-accounts) - (service-extension activation-service-type nix-activation))) + (service-extension activation-service-type nix-activation) + (service-extension profile-service-type + (compose list nix-configuration-package)))) (description "Run the Nix daemon.") (default-value (nix-configuration)))) diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm index b93ed70099..20e104f48c 100644 --- a/gnu/services/virtualization.scm +++ b/gnu/services/virtualization.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com> -;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -39,6 +39,7 @@ #:use-module (gnu system) #:use-module (guix derivations) #:use-module (guix gexp) + #:use-module (guix modules) #:use-module (guix monads) #:use-module (guix packages) #:use-module (guix records) @@ -61,7 +62,10 @@ hurd-vm-configuration-options hurd-vm-configuration-id hurd-vm-configuration-net-options + hurd-vm-configuration-secrets + hurd-vm-disk-image + hurd-vm-port hurd-vm-net-options hurd-vm-service-type @@ -806,6 +810,41 @@ functionality of the kernel Linux."))) ;;; +;;; Secrets for guest VMs. +;;; + +(define (secret-service-activation port) + "Return an activation snippet that fetches sensitive material at local PORT, +over TCP. Reboot upon failure." + (with-imported-modules '((gnu build secret-service) + (guix build utils)) + #~(begin + (use-modules (gnu build secret-service)) + (let ((sent (secret-service-receive-secrets #$port))) + (unless sent + (sleep 3) + (reboot)))))) + +(define secret-service-type + (service-type + (name 'secret-service) + (extensions (list (service-extension activation-service-type + secret-service-activation))) + (description + "This service fetches secret key and other sensitive material over TCP at +boot time. This service is meant to be used by virtual machines (VMs) that +can only be accessed by their host."))) + +(define (secret-service-operating-system os) + "Return an operating system based on OS that includes the secret-service, +that will be listening to receive secret keys on port 1004, TCP." + (operating-system + (inherit os) + (services (cons (service secret-service-type 1004) + (operating-system-user-services os))))) + + +;;; ;;; The Hurd in VM service: a Childhurd. ;;; @@ -849,11 +888,14 @@ functionality of the kernel Linux."))) (default #f)) (net-options hurd-vm-configuration-net-options ;list of string (thunked) - (default (hurd-vm-net-options this-record)))) + (default (hurd-vm-net-options this-record))) + (secret-root hurd-vm-configuration-secret-root ;string + (default "/etc/childhurd"))) (define (hurd-vm-disk-image config) - "Return a disk-image for the Hurd according to CONFIG." - (let ((os (hurd-vm-configuration-os config)) + "Return a disk-image for the Hurd according to CONFIG. The secret-service +is added to the OS specified in CONFIG." + (let ((os (secret-service-operating-system (hurd-vm-configuration-os config))) (disk-size (hurd-vm-configuration-disk-size config))) (system-image (image @@ -861,15 +903,27 @@ functionality of the kernel Linux."))) (size disk-size) (operating-system os))))) -(define (hurd-vm-net-options config) +(define (hurd-vm-port config base) + "Return the forwarded vm port for this childhurd config." (let ((id (or (hurd-vm-configuration-id config) 0))) - (define (qemu-vm-port base) - (number->string (+ base (* 1000 id)))) - `("--device" "rtl8139,netdev=net0" - "--netdev" ,(string-append - "user,id=net0" - ",hostfwd=tcp:127.0.0.1:" (qemu-vm-port 10022) "-:2222" - ",hostfwd=tcp:127.0.0.1:" (qemu-vm-port 15900) "-:5900")))) + (+ base (* 1000 id)))) +(define %hurd-vm-secrets-port 11004) +(define %hurd-vm-ssh-port 10022) +(define %hurd-vm-vnc-port 15900) + +(define (hurd-vm-net-options config) + `("--device" "rtl8139,netdev=net0" + "--netdev" + ,(string-append "user,id=net0" + ",hostfwd=tcp:127.0.0.1:" + (number->string (hurd-vm-port config %hurd-vm-secrets-port)) + "-:1004" + ",hostfwd=tcp:127.0.0.1:" + (number->string (hurd-vm-port config %hurd-vm-ssh-port)) + "-:2222" + ",hostfwd=tcp:127.0.0.1:" + (number->string (hurd-vm-port config %hurd-vm-vnc-port)) + "-:5900"))) (define (hurd-vm-shepherd-service config) "Return a <shepherd-service> for a Hurd in a Virtual Machine with CONFIG." @@ -900,8 +954,26 @@ functionality of the kernel Linux."))) (string->symbol (number->string id))) provisions) provisions)) - (requirement '(networking)) - (start #~(make-forkexec-constructor #$vm-command)) + (requirement '(loopback networking user-processes)) + (start + (with-imported-modules + (source-module-closure '((gnu build secret-service) + (guix build utils))) + #~(let ((spawn (make-forkexec-constructor #$vm-command))) + (lambda _ + (let ((pid (spawn)) + (port #$(hurd-vm-port config %hurd-vm-secrets-port)) + (root #$(hurd-vm-configuration-secret-root config))) + (catch #t + (lambda _ + (secret-service-send-secrets port root)) + (lambda (key . args) + (kill (- pid) SIGTERM) + (apply throw key args))) + pid))))) + (modules `((gnu build secret-service) + (guix build utils) + ,@%default-modules)) (stop #~(make-kill-destructor)))))) (define hurd-vm-service-type diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 3b9f9e40be..d11a1c0545 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -12,6 +12,7 @@ ;;; Copyright © 2019, 2020 Florian Pelz <pelzflorian@pelzflorian.de> ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr> +;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -794,13 +795,29 @@ of index files." #:user #$user #:group #$group)) (stop #~(make-kill-destructor))))))) +(define fcgiwrap-activation + (match-lambda + (($ <fcgiwrap-configuration> package socket user group) + #~(begin + ;; When listening on a unix socket, create a parent directory for the + ;; socket with the correct permissions. + (when (string-prefix? "unix:" #$socket) + (let ((run-directory + (dirname (substring #$socket (string-length "unix:"))))) + (mkdir-p run-directory) + (chown run-directory + (passwd:uid (getpw #$user)) + (group:gid (getgr #$group))))))))) + (define fcgiwrap-service-type (service-type (name 'fcgiwrap) (extensions (list (service-extension shepherd-root-service-type fcgiwrap-shepherd-service) (service-extension account-service-type - fcgiwrap-accounts))) + fcgiwrap-accounts) + (service-extension activation-service-type + fcgiwrap-activation))) (default-value (fcgiwrap-configuration)))) (define-record-type* <php-fpm-configuration> php-fpm-configuration |