summary refs log tree commit diff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/admin.scm141
-rw-r--r--gnu/services/auditd.scm41
-rw-r--r--gnu/services/base.scm115
-rw-r--r--gnu/services/databases.scm4
-rw-r--r--gnu/services/desktop.scm3
-rw-r--r--gnu/services/docker.scm11
-rw-r--r--gnu/services/ganeti.scm2
-rw-r--r--gnu/services/linux.scm81
-rw-r--r--gnu/services/mcron.scm33
-rw-r--r--gnu/services/networking.scm5
-rw-r--r--gnu/services/nix.scm22
-rw-r--r--gnu/services/virtualization.scm100
-rw-r--r--gnu/services/web.scm19
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
generated by cgit-pink 1.4.1 (git 2.36.1) at 2024-12-23 02:50:23 +0000