Merge branch 'master' into staging

8 files changed, 292 insertions, 57 deletions

diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
index 471c5fd95f..345d8225b2 100644
--- a/gnu/services/audio.scm
+++ b/gnu/services/audio.scm
@@ -140,6 +140,13 @@ audio_output {
                    "--no-daemon"
                    #$(mpd-config->file config))
              #:pid-file #$(mpd-file-name config "pid")
+             #:environment-variables
+             ;; Required to detect PulseAudio when run under a user account.
+             '(#$(string-append
+                   "XDG_RUNTIME_DIR=/run/user/"
+                   (number->string
+                     (passwd:uid
+                       (getpwnam (mpd-configuration-user config))))))
              #:log-file #$(mpd-file-name config "log")))
    (stop  #~(make-kill-destructor))))
 
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm
index 35d7ff3c9c..7b3c8100e2 100644
--- a/gnu/services/dbus.scm
+++ b/gnu/services/dbus.scm
@@ -86,6 +86,19 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
         (use-modules (sxml simple)
                      (srfi srfi-1))
 
+        (define-syntax directives
+          (syntax-rules ()
+            ;; Expand the given directives (SXML expressions) only if their
+            ;; key names a file that exists.
+            ((_ (name directory) rest ...)
+             (let ((dir directory))
+               (if (file-exists? dir)
+                   `((name ,dir)
+                     ,@(directives rest ...))
+                   (directives rest ...))))
+            ((_)
+             '())))
+
         (define (services->sxml services)
           ;; Return the SXML 'includedir' clauses for DIRS.
           `(busconfig
@@ -98,10 +111,13 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
             (servicedir "/etc/dbus-1/system-services")
 
             ,@(append-map (lambda (dir)
-                            `((includedir
-                               ,(string-append dir "/etc/dbus-1/system.d"))
-                              (servicedir       ;for '.service' files
-                               ,(string-append dir "/share/dbus-1/services"))))
+                            (directives
+                             (includedir
+                              (string-append dir "/etc/dbus-1/system.d"))
+                             (includedir
+                              (string-append dir "/share/dbus-1/system.d"))
+                             (servicedir          ;for '.service' files
+                              (string-append dir "/share/dbus-1/services"))))
                           services)))
 
         (mkdir #$output)
@@ -160,18 +176,9 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
 
       (unless (file-exists? "/etc/machine-id")
         (format #t "creating /etc/machine-id...~%")
-        (let ((prog (string-append #$(dbus-configuration-dbus config)
-                                   "/bin/dbus-uuidgen")))
-          ;; XXX: We can't use 'system' because the initrd's
-          ;; guile system(3) only works when 'sh' is in $PATH.
-          (let ((pid (primitive-fork)))
-            (if (zero? pid)
-                (call-with-output-file "/etc/machine-id"
-                  (lambda (port)
-                    (close-fdes 1)
-                    (dup2 (port->fdes port) 1)
-                    (execl prog)))
-                (waitpid pid)))))))
+        (invoke (string-append #$(dbus-configuration-dbus config)
+                               "/bin/dbus-uuidgen")
+                "--ensure=/etc/machine-id"))))
 
 (define dbus-shepherd-service
   (match-lambda
@@ -179,10 +186,10 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
      (list (shepherd-service
             (documentation "Run the D-Bus system daemon.")
             (provision '(dbus-system))
-            (requirement '(user-processes))
+            (requirement '(user-processes syslogd))
             (start #~(make-forkexec-constructor
                       (list (string-append #$dbus "/bin/dbus-daemon")
-                            "--nofork" "--system")
+                            "--nofork" "--system" "--syslog-only")
                       #:pid-file "/var/run/dbus/pid"))
             (stop #~(make-kill-destructor)))))))
 
@@ -213,7 +220,10 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in
                             (append (dbus-configuration-services config)
                                     services)))))
 
-                (default-value (dbus-configuration))))
+                (default-value (dbus-configuration))
+                (description "Run the system-wide D-Bus inter-process message
+bus.  It allows programs and daemons to communicate and is also responsible
+for spawning (@dfn{activating}) D-Bus services on demand.")))
 
 (define* (dbus-service #:key (dbus dbus) (services '()))
   "Return a service that runs the \"system bus\", using @var{dbus}, with
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 449b606a31..0152e86e8a 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -514,12 +514,14 @@ Users need to be in the @code{lp} group to access the D-Bus service.
 
                        ;; It provides polkit "actions".
                        (service-extension polkit-service-type list)))
+                (default-value colord)
                 (description
                  "Run @command{colord}, a system service with a D-Bus
 interface to manage the color profiles of input and output devices such as
 screens and scanners.")))
 
-(define* (colord-service #:key (colord colord))
+(define-deprecated (colord-service #:key (colord colord))
+  colord-service-type
   "Return a service that runs @command{colord}, a system service with a D-Bus
 interface to manage the color profiles of input and output devices such as
 screens and scanners.  It is notably used by the GNOME Color Manager graphical
@@ -1094,7 +1096,7 @@ dispatches events from it.")))
          (service upower-service-type)
          (accountsservice-service)
          (service cups-pk-helper-service-type)
-         (colord-service)
+         (service colord-service-type)
          (geoclue-service)
          (service polkit-service-type)
          (elogind-service)
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 5f37cb0782..43b6261c07 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -45,6 +45,9 @@
             zone-file
             zone-entry
 
+            knot-resolver-service-type
+            knot-resolver-configuration
+
             dnsmasq-service-type
             dnsmasq-configuration
 
@@ -639,6 +642,89 @@
 
 
 ;;;
+;;; Knot Resolver.
+;;;
+
+(define-record-type* <knot-resolver-configuration>
+  knot-resolver-configuration
+  make-knot-resolver-configuration
+  knot-resolver-configuration?
+  (package knot-resolver-configuration-package
+           (default knot-resolver))
+  (kresd-config-file knot-resolver-kresd-config-file
+                     (default %kresd.conf))
+  (garbage-collection-interval knot-resolver-garbage-collection-interval
+                               (default 1000)))
+
+(define %kresd.conf
+  (plain-file "kresd.conf" "-- -*- mode: lua -*-
+net = { '127.0.0.1', '::1' }
+user('knot-resolver', 'knot-resolver')
+modules = { 'hints > iterate', 'stats', 'predict' }
+cache.size = 100 * MB
+"))
+
+(define %knot-resolver-accounts
+  (list (user-group
+         (name "knot-resolver")
+         (system? #t))
+        (user-account
+         (name "knot-resolver")
+         (group "knot-resolver")
+         (system? #t)
+         (home-directory "/var/cache/knot-resolver")
+         (shell (file-append shadow "/sbin/nologin")))))
+
+(define (knot-resolver-activation config)
+  #~(begin
+      (use-modules (guix build utils))
+      (let ((rundir "/var/cache/knot-resolver")
+            (owner (getpwnam "knot-resolver")))
+        (mkdir-p rundir)
+        (chown rundir (passwd:uid owner) (passwd:gid owner)))))
+
+(define knot-resolver-shepherd-services
+  (match-lambda
+    (($ <knot-resolver-configuration> package
+                                      kresd-config-file
+                                      garbage-collection-interval)
+     (list
+      (shepherd-service
+       (provision '(kresd))
+       (requirement '(networking))
+       (documentation "Run the Knot Resolver daemon.")
+       (start #~(make-forkexec-constructor
+                 '(#$(file-append package "/sbin/kresd")
+                   "-c" #$kresd-config-file "-f" "1"
+                   "/var/cache/knot-resolver")))
+       (stop #~(make-kill-destructor)))
+      (shepherd-service
+       (provision '(kres-cache-gc))
+       (requirement '(user-processes))
+       (documentation "Run the Knot Resolver Garbage Collector daemon.")
+       (start #~(make-forkexec-constructor
+                 '(#$(file-append package "/sbin/kres-cache-gc")
+                   "-d" #$(number->string garbage-collection-interval)
+                   "-c" "/var/cache/knot-resolver")
+                 #:user "knot-resolver"
+                 #:group "knot-resolver"))
+       (stop #~(make-kill-destructor)))))))
+
+(define knot-resolver-service-type
+  (service-type
+   (name 'knot-resolver)
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             knot-resolver-shepherd-services)
+          (service-extension activation-service-type
+                             knot-resolver-activation)
+          (service-extension account-service-type
+                             (const %knot-resolver-accounts))))
+   (default-value (knot-resolver-configuration))
+   (description "Run the Knot DNS Resolver.")))
+
+
+;;;
 ;;; Dnsmasq.
 ;;;
 
diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm
index 7276f7056d..511f4fb2fe 100644
--- a/gnu/services/monitoring.scm
+++ b/gnu/services/monitoring.scm
@@ -473,7 +473,8 @@ configuration file."))
                            (list "
 fastcgi_param PHP_VALUE \"post_max_size = 16M
                           max_execution_time = 300\";
-")))))))))
+")))))))
+   (listen '("80"))))
 
 (define-configuration zabbix-front-end-configuration
   ;; TODO: Specify zabbix front-end package.
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 93d9b6a15e..6485c08ff7 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -12,6 +12,7 @@
 ;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Sou Bunnbu <iyzsong@member.fsf.org>
+;;; Copyright © 2019 Alex Griffin <a@ajgrf.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -154,7 +155,17 @@
             nftables-configuration?
             nftables-configuration-package
             nftables-configuration-ruleset
-            %default-nftables-ruleset))
+            %default-nftables-ruleset
+
+            pagekite-service-type
+            pagekite-configuration
+            pagekite-configuration?
+            pagekite-configuration-package
+            pagekite-configuration-kitename
+            pagekite-configuration-kitesecret
+            pagekite-configuration-frontend
+            pagekite-configuration-kites
+            pagekite-configuration-extra-file))
 
 ;;; Commentary:
 ;;;
@@ -345,7 +356,7 @@ Protocol (DHCP) client, on all the non-loopback network interfaces."
                 (res '()))
        (if (list? x)
            (fold loop res x)
-           (cons (format #f "~s" x) res)))))
+           (cons (format #f "~a" x) res)))))
 
   (match ntp-server
     (($ <ntp-server> type address options)
@@ -394,15 +405,16 @@ deprecated.  Please use <ntp-server> records instead.\n")
        ntp-servers))))
 
 (define ntp-shepherd-service
-  (match-lambda
-    (($ <ntp-configuration> ntp servers allow-large-adjustment?)
-     (let ()
-       ;; TODO: Add authentication support.
-       (define config
-         (string-append "driftfile /var/run/ntpd/ntp.drift\n"
-                        (string-join (map ntp-server->string servers)
-                                     "\n")
-                        "
+  (lambda (config)
+    (match config
+      (($ <ntp-configuration> ntp servers allow-large-adjustment?)
+       (let ((servers (ntp-configuration-servers config)))
+         ;; TODO: Add authentication support.
+         (define config
+           (string-append "driftfile /var/run/ntpd/ntp.drift\n"
+                          (string-join (map ntp-server->string servers)
+                                       "\n")
+                          "
 # Disable status queries as a workaround for CVE-2013-5211:
 # <http://support.ntp.org/bin/view/Main/SecurityNotice#DRDoS_Amplification_Attack_using>.
 restrict default kod nomodify notrap nopeer noquery limited
@@ -416,20 +428,20 @@ restrict -6 ::1
 # option by default, as documented in the 'ntp.conf' manual.
 restrict source notrap nomodify noquery\n"))
 
-       (define ntpd.conf
-         (plain-file "ntpd.conf" config))
+         (define ntpd.conf
+           (plain-file "ntpd.conf" config))
 
-       (list (shepherd-service
-              (provision '(ntpd))
-              (documentation "Run the Network Time Protocol (NTP) daemon.")
-              (requirement '(user-processes networking))
-              (start #~(make-forkexec-constructor
-                        (list (string-append #$ntp "/bin/ntpd") "-n"
-                              "-c" #$ntpd.conf "-u" "ntpd"
-                              #$@(if allow-large-adjustment?
-                                     '("-g")
-                                     '()))))
-              (stop #~(make-kill-destructor))))))))
+         (list (shepherd-service
+                (provision '(ntpd))
+                (documentation "Run the Network Time Protocol (NTP) daemon.")
+                (requirement '(user-processes networking))
+                (start #~(make-forkexec-constructor
+                          (list (string-append #$ntp "/bin/ntpd") "-n"
+                                "-c" #$ntpd.conf "-u" "ntpd"
+                                #$@(if allow-large-adjustment?
+                                       '("-g")
+                                       '()))))
+                (stop #~(make-kill-destructor)))))))))
 
 (define %ntp-accounts
   (list (user-account
@@ -1526,4 +1538,100 @@ table inet filter {
                              (compose list nftables-configuration-package))))
    (default-value (nftables-configuration))))
 
+
+;;;
+;;; PageKite
+;;;
+
+(define-record-type* <pagekite-configuration>
+  pagekite-configuration
+  make-pagekite-configuration
+  pagekite-configuration?
+  (package pagekite-configuration-package
+           (default pagekite))
+  (kitename pagekite-configuration-kitename
+            (default #f))
+  (kitesecret pagekite-configuration-kitesecret
+              (default #f))
+  (frontend pagekite-configuration-frontend
+            (default #f))
+  (kites pagekite-configuration-kites
+         (default '("http:@kitename:localhost:80:@kitesecret")))
+  (extra-file pagekite-configuration-extra-file
+              (default #f)))
+
+(define (pagekite-configuration-file config)
+  (match-record config <pagekite-configuration>
+    (package kitename kitesecret frontend kites extra-file)
+    (mixed-text-file "pagekite.rc"
+                     (if extra-file
+                         (string-append "optfile = " extra-file "\n")
+                         "")
+                     (if kitename
+                         (string-append "kitename = " kitename "\n")
+                         "")
+                     (if kitesecret
+                         (string-append "kitesecret = " kitesecret "\n")
+                         "")
+                     (if frontend
+                         (string-append "frontend = " frontend "\n")
+                         "defaults\n")
+                     (string-join (map (lambda (kite)
+                                         (string-append "service_on = " kite))
+                                       kites)
+                                  "\n"
+                                  'suffix))))
+
+(define (pagekite-shepherd-service config)
+  (match-record config <pagekite-configuration>
+    (package kitename kitesecret frontend kites extra-file)
+    (with-imported-modules (source-module-closure
+                            '((gnu build shepherd)
+                              (gnu system file-systems)))
+      (shepherd-service
+       (documentation "Run the PageKite service.")
+       (provision '(pagekite))
+       (requirement '(networking))
+       (modules '((gnu build shepherd)
+                  (gnu system file-systems)))
+       (start #~(make-forkexec-constructor/container
+                 (list #$(file-append package "/bin/pagekite")
+                       "--clean"
+                       "--nullui"
+                       "--nocrashreport"
+                       "--runas=pagekite:pagekite"
+                       (string-append "--optfile="
+                                      #$(pagekite-configuration-file config)))
+                 #:log-file "/var/log/pagekite.log"
+                 #:mappings #$(if extra-file
+                                  #~(list (file-system-mapping
+                                           (source #$extra-file)
+                                           (target source)))
+                                  #~'())))
+       ;; SIGTERM doesn't always work for some reason.
+       (stop #~(make-kill-destructor SIGINT))))))
+
+(define %pagekite-accounts
+  (list (user-group (name "pagekite") (system? #t))
+        (user-account
+         (name "pagekite")
+         (group "pagekite")
+         (system? #t)
+         (comment "PageKite user")
+         (home-directory "/var/empty")
+         (shell (file-append shadow "/sbin/nologin")))))
+
+(define pagekite-service-type
+  (service-type
+   (name 'pagekite)
+   (default-value (pagekite-configuration))
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             (compose list pagekite-shepherd-service))
+          (service-extension account-service-type
+                             (const %pagekite-accounts))))
+   (description
+    "Run @url{https://pagekite.net/,PageKite}, a tunneling solution to make
+local servers publicly accessible on the web, even behind NATs and firewalls.")))
+
 ;;; networking.scm ends here
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index bc8ac9b40a..2cd4e5e89c 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -433,9 +433,11 @@ potential infinite waits blocking libvirt."))
            (start #~(make-forkexec-constructor
                      (list (string-append #$libvirt "/sbin/libvirtd")
                            "-f" #$config-file)
+                     ;; For finding qemu and ip binaries.
                      #:environment-variables
-                     ;; For finding qemu binaries.
-                     '("PATH=/run/current-system/profile/bin")))
+                     (list (string-append
+                            "PATH=/run/current-system/profile/bin:"
+                            "/run/current-system/profile/sbin"))))
            (stop #~(make-kill-destructor))))))
 
 (define libvirt-service-type
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 899be1c168..3d149a105d 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
-;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 ng0 <ng0@n0.is>
 ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
@@ -9,6 +9,7 @@
 ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
 ;;; Copyright © 2017, 2018, 2019 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2018 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2019 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -95,6 +96,7 @@
             nginx-configuration-upstream-blocks
             nginx-configuration-server-names-hash-bucket-size
             nginx-configuration-server-names-hash-bucket-max-size
+            nginx-configuration-modules
             nginx-configuration-extra-content
             nginx-configuration-file
 
@@ -522,6 +524,7 @@
                                  (default #f))
   (server-names-hash-bucket-max-size nginx-configuration-server-names-hash-bucket-max-size
                                      (default #f))
+  (modules nginx-configuration-modules (default '()))
   (extra-content nginx-configuration-extra-content
                  (default ""))
   (file          nginx-configuration-file         ;#f | string | file-like
@@ -542,6 +545,9 @@ of index files."
         ((? string? str) (list str " ")))
       names))
 
+(define (emit-load-module module)
+  (list "load_module " module ";\n"))
+
 (define emit-nginx-location-config
   (match-lambda
     (($ <nginx-location-configuration> uri body)
@@ -615,12 +621,14 @@ of index files."
                  server-blocks upstream-blocks
                  server-names-hash-bucket-size
                  server-names-hash-bucket-max-size
+                 modules
                  extra-content)
    (apply mixed-text-file "nginx.conf"
           (flatten
            "user nginx nginx;\n"
            "pid " run-directory "/pid;\n"
            "error_log " log-directory "/error.log info;\n"
+           (map emit-load-module modules)
            "http {\n"
            "    client_body_temp_path " run-directory "/client_body_temp;\n"
            "    proxy_temp_path " run-directory "/proxy_temp;\n"
@@ -1039,13 +1047,24 @@ a webserver.")
          (shell (file-append shadow "/sbin/nologin")))))
 
 (define %hpcguix-web-activation
-  #~(begin
-      (use-modules (guix build utils))
-      (let ((home-dir "/var/cache/guix/web")
-            (user (getpwnam "hpcguix-web")))
-        (mkdir-p home-dir)
-        (chown home-dir (passwd:uid user) (passwd:gid user))
-        (chmod home-dir #o755))))
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils)
+                     (ice-9 ftw))
+
+        (let ((home-dir "/var/cache/guix/web")
+              (user (getpwnam "hpcguix-web")))
+          (mkdir-p home-dir)
+          (chown home-dir (passwd:uid user) (passwd:gid user))
+          (chmod home-dir #o755)
+
+          ;; Remove stale 'packages.json.lock' file (and other lock files, if
+          ;; any) since that would prevent 'packages.json' from being updated.
+          (for-each (lambda (lock)
+                      (delete-file (string-append home-dir "/" lock)))
+                    (scandir home-dir
+                             (lambda (file)
+                               (string-suffix? ".lock" file))))))))
 
 (define %hpcguix-web-log-file
   "/var/log/hpcguix-web.log")
@@ -1425,7 +1444,7 @@ ADMINS = [
 
 DEBUG = " #$(if debug? "True" "False") "
 
-ENABLE_REST_API = " #$(if enable-xmlrpc? "True" "False") "
+ENABLE_REST_API = " #$(if enable-rest-api? "True" "False") "
 ENABLE_XMLRPC = " #$(if enable-xmlrpc? "True" "False") "
 
 FORCE_HTTPS_LINKS = " #$(if force-https-links? "True" "False") "