Merge branch 'master' into staging

7 files changed, 458 insertions, 54 deletions

diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5ab33e1104..ea6c9a33fe 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -157,7 +157,7 @@ inside %DOCKER-OS."
           (version "0")
           (source #f)
           (build-system trivial-build-system)
-          (arguments `(#:guile ,guile-2.2
+          (arguments `(#:guile ,guile-3.0
                        #:builder
                        (let ((out (assoc-ref %outputs "out")))
                          (mkdir out)
@@ -171,7 +171,7 @@ standard output device and then enters a new line.")
           (home-page #f)
           (license license:public-domain)))
        (profile (profile-derivation (packages->manifest
-                                     (list guile-2.2 guile-json-3
+                                     (list guile-3.0 guile-json-3
                                            guest-script-package))
                                     #:hooks '()
                                     #:locales? #f))
@@ -254,7 +254,7 @@ inside %DOCKER-OS."
                 (define (wait-for-container-file container file)
                   ;; Wait for FILE to show up in CONTAINER.
                   (docker-cli "exec" container
-                              #$(file-append guile-2.2 "/bin/guile")
+                              #$(file-append guile-3.0 "/bin/guile")
                               "-c"
                               (object->string
                                `(let loop ((n 15))
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
new file mode 100644
index 0000000000..ff853a7149
--- /dev/null
+++ b/gnu/tests/ganeti.scm
@@ -0,0 +1,270 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Marius Bakke <marius@gnu.org>.
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests ganeti)
+  #:use-module (gnu)
+  #:use-module (gnu tests)
+  #:use-module (gnu system vm)
+  #:use-module (gnu services)
+  #:use-module (gnu services ganeti)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services ssh)
+  #:use-module (gnu packages virtualization)
+  #:use-module (guix gexp)
+  #:use-module (ice-9 format)
+  #:export (%test-ganeti-kvm %test-ganeti-lxc))
+
+(define %ganeti-os
+  (operating-system
+    (host-name "gnt1")
+    (timezone "Etc/UTC")
+    (locale "en_US.UTF-8")
+
+    (bootloader (bootloader-configuration
+                 (bootloader grub-bootloader)
+                 (target "/dev/vda")))
+    (file-systems (cons (file-system
+                          (device (file-system-label "my-root"))
+                          (mount-point "/")
+                          (type "ext4"))
+                        %base-file-systems))
+    (firmware '())
+
+    ;; The hosts file must contain a nonlocal IP for host-name.
+    ;; In addition, the cluster name must resolve to an IP address that
+    ;; is not currently provisioned.
+    (hosts-file (plain-file "hosts" (format #f "
+127.0.0.1       localhost
+::1             localhost
+10.0.2.2        gnt1.example.com gnt1
+192.168.254.254 ganeti.example.com
+")))
+
+    (packages (append (list ganeti-instance-debootstrap ganeti-instance-guix)
+                      %base-packages))
+    (services
+     (append (list (static-networking-service "eth0" "10.0.2.2"
+                                              #:netmask "255.255.255.0"
+                                              #:gateway "10.0.2.1"
+                                              #:name-servers '("10.0.2.1"))
+
+                   (service openssh-service-type
+                            (openssh-configuration
+                             (permit-root-login 'without-password)))
+
+                   (service ganeti-service-type
+                            (ganeti-configuration
+                             (file-storage-paths '("/srv/ganeti/file-storage"))
+                             (rapi-configuration
+                              (ganeti-rapi-configuration
+                               ;; Disable TLS so we can test the RAPI without
+                               ;; pulling in GnuTLS.
+                               (ssl? #f)))
+                             (os %default-ganeti-os))))
+             %base-services))))
+
+(define* (run-ganeti-test hypervisor #:key
+                          (master-netdev "eth0")
+                          (hvparams '())
+                          (extra-packages '())
+                          (rapi-port 5080)
+                          (noded-port 1811))
+  "Run tests in %GANETI-OS."
+  (define os
+    (marionette-operating-system
+     (operating-system
+       (inherit %ganeti-os)
+       (packages (append extra-packages
+                         (operating-system-packages %ganeti-os))))
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define %forwarded-rapi-port 5080)
+  (define %forwarded-noded-port 1811)
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     ;; Some of the daemons are fairly memory-hungry.
+     (memory-size 512)
+     ;; Forward HTTP ports so we can access them from the "outside".
+     (port-forwardings `((,%forwarded-rapi-port . ,rapi-port)
+                         (,%forwarded-noded-port . ,noded-port)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (web uri) (web client) (web response)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "ganeti")
+
+          ;; Ganeti uses the Shepherd to start/stop daemons, so make sure
+          ;; it is ready before we begin.  It takes a while because all
+          ;; Ganeti daemons fail to start initially.
+          (test-assert "shepherd is ready"
+            (wait-for-unix-socket "/var/run/shepherd/socket" marionette))
+
+          (test-eq "gnt-cluster init"
+            0
+            (marionette-eval
+             '(begin
+                (setenv
+                 "PATH"
+                 ;; Init needs to run 'ssh-keygen', 'ip', etc.
+                 "/run/current-system/profile/sbin:/run/current-system/profile/bin")
+                (system* #$(file-append ganeti "/sbin/gnt-cluster") "init"
+                         (string-append "--master-netdev=" #$master-netdev)
+                         ;; TODO: Enable more disk backends.
+                         "--enabled-disk-templates=file"
+                         (string-append "--enabled-hypervisors="
+                                        #$hypervisor)
+                         (string-append "--hypervisor-parameters="
+                                        #$hypervisor ":"
+                                        (string-join '#$hvparams "\n"))
+                         ;; Set the default NIC mode to 'routed' to avoid having to
+                         ;; configure a full bridge to placate 'gnt-cluster verify'.
+                         "--nic-parameters=mode=routed,link=eth0"
+                         "ganeti.example.com"))
+             marionette))
+
+          ;; Disable the watcher while doing daemon tests to prevent interference.
+          (test-eq "watcher pause"
+            0
+            (marionette-eval
+             '(begin
+                (system* #$(file-append ganeti "/sbin/gnt-cluster")
+                         "watcher" "pause" "1h"))
+             marionette))
+
+          (test-assert "force-start wconfd"
+            ;; Check that the 'force-start' Shepherd action works, used in a
+            ;; master-failover scenario.
+            (marionette-eval
+             '(begin
+                (setenv "PATH" "/run/current-system/profile/bin")
+                (invoke "herd" "stop" "ganeti-wconfd")
+                (invoke "herd" "disable" "ganeti-wconfd")
+                (invoke "herd" "force-start" "ganeti-wconfd"))
+             marionette))
+
+          ;; Verify that the cluster is healthy.
+          (test-eq "gnt-cluster verify 1"
+            0
+            (marionette-eval
+             '(begin
+                (system* #$(file-append ganeti "/sbin/gnt-cluster") "verify"))
+             marionette))
+
+          ;; Try stopping and starting daemons with daemon-util like
+          ;; 'gnt-node add', 'gnt-cluster init', etc.
+          (test-eq "daemon-util stop-all"
+            0
+            (marionette-eval
+             '(begin
+                (system* #$(file-append ganeti "/lib/ganeti/daemon-util")
+                         "stop-all"))
+             marionette))
+
+          (test-eq "daemon-util start-all"
+            0
+            (marionette-eval
+             '(begin
+                (system* #$(file-append ganeti "/lib/ganeti/daemon-util")
+                         "start-all"))
+             marionette))
+
+          ;; Check that the cluster is still healthy after the daemon restarts.
+          (test-eq "gnt-cluster verify 2"
+            0
+            (marionette-eval
+             '(begin
+                (system* #$(file-append ganeti "/sbin/gnt-cluster") "verify"))
+             marionette))
+
+          (test-eq "watcher continue"
+            0
+            (marionette-eval
+             '(begin
+                (system* #$(file-append ganeti "/sbin/gnt-cluster")
+                         "watcher" "continue"))
+             marionette))
+
+          ;; Try accessing the RAPI.  This causes an expected failure:
+          ;;   https://github.com/ganeti/ganeti/issues/1502
+          ;; Run it anyway for easy testing of potential fixes.
+          (test-equal "http-get RAPI version"
+            '(200 "2")
+            (let-values
+                (((response text)
+                  (http-get #$(simple-format
+                               #f "http://localhost:~A/version"
+                               %forwarded-rapi-port)
+                            #:decode-body? #t)))
+              (list (response-code response) text)))
+
+          (test-equal "gnt-os list"
+            "debootstrap+default\nguix+default\n"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 popen))
+                (let* ((port (open-pipe*
+                              OPEN_READ
+                              #$(file-append ganeti "/sbin/gnt-os")
+                              "list" "--no-headers"))
+                       (output (get-string-all port)))
+                  (close-pipe port)
+                  output))
+             marionette))
+
+          (test-eq "gnt-cluster destroy"
+            0
+            (marionette-eval
+             '(begin
+                (system* #$(file-append ganeti "/sbin/gnt-cluster")
+                         "destroy" "--yes-do-it"))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 1)))))
+
+  (gexp->derivation (string-append "ganeti-" hypervisor "-test") test))
+
+(define %test-ganeti-kvm
+  (system-test
+   (name "ganeti-kvm")
+   (description "Provision a Ganeti cluster using the KVM hypervisor.")
+   (value (run-ganeti-test "kvm"
+                           ;; Set kernel_path to an empty string to prevent
+                           ;; 'gnt-cluster verify' from testing for its presence.
+                           #:hvparams '("kernel_path=")
+                           #:extra-packages (list qemu)))))
+
+(define %test-ganeti-lxc
+  (system-test
+   (name "ganeti-lxc")
+   (description "Provision a Ganeti cluster using LXC as the hypervisor.")
+   (value (run-ganeti-test "lxc"
+                           #:extra-packages (list lxc)))))
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index b2edfa5c22..9656e5f41f 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -163,7 +163,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts
 guix build isc-dhcp
 parted --script /dev/vdb mklabel gpt \\
   mkpart primary ext2 1M 3M \\
-  mkpart primary ext2 3M 1.4G \\
+  mkpart primary ext2 3M 1.6G \\
   set 1 boot on \\
   set 1 bios_grub on
 mkfs.ext4 -L my-root /dev/vdb2
@@ -188,7 +188,7 @@ guix --version
 export GUIX_BUILD_OPTIONS=--no-grafts
 guix build isc-dhcp
 parted --script /dev/vdb mklabel gpt \\
-  mkpart ext2 1M 1.4G \\
+  mkpart ext2 1M 1.6G \\
   set 1 legacy_boot on
 mkfs.ext4 -L my-root -O '^64bit' /dev/vdb1
 mount /dev/vdb1 /mnt
@@ -419,7 +419,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts
 guix build isc-dhcp
 parted --script /dev/vda mklabel gpt \\
   mkpart primary ext2 1M 3M \\
-  mkpart primary ext2 3M 1.4G \\
+  mkpart primary ext2 3M 1.6G \\
   set 1 boot on \\
   set 1 bios_grub on
 mkfs.ext4 -L my-root /dev/vda2
@@ -631,8 +631,8 @@ guix --version
 export GUIX_BUILD_OPTIONS=--no-grafts
 parted --script /dev/vdb mklabel gpt \\
   mkpart primary ext2 1M 3M \\
-  mkpart primary ext2 3M 1.4G \\
-  mkpart primary ext2 1.4G 2.8G \\
+  mkpart primary ext2 3M 1.6G \\
+  mkpart primary ext2 1.6G 3.2G \\
   set 1 boot on \\
   set 1 bios_grub on
 yes | mdadm --create /dev/md0 --verbose --level=mirror --raid-devices=2 \\
@@ -658,7 +658,7 @@ by 'mdadm'.")
                                                %raid-root-os-source
                                                #:script
                                                %raid-root-installation-script
-                                               #:target-size (* 2800 MiB)))
+                                               #:target-size (* 3200 MiB)))
                          (command (qemu-command/writable-image image)))
       (run-basic-test %raid-root-os
                       `(,@command) "raid-root-os")))))
@@ -719,7 +719,7 @@ export GUIX_BUILD_OPTIONS=--no-grafts
 ls -l /run/current-system/gc-roots
 parted --script /dev/vdb mklabel gpt \\
   mkpart primary ext2 1M 3M \\
-  mkpart primary ext2 3M 1.4G \\
+  mkpart primary ext2 3M 1.6G \\
   set 1 boot on \\
   set 1 bios_grub on
 echo -n " %luks-passphrase " | \\
diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm
index 732fbc54d7..d20b8ac59e 100644
--- a/gnu/tests/monitoring.scm
+++ b/gnu/tests/monitoring.scm
@@ -280,7 +280,7 @@ zabbix||{}
              '(file-exists? "/var/run/nginx/pid")
              marionette))
 
-          ;; Make sure we can access pages that correspond to our repository.
+          ;; Make sure we can access pages that correspond to our Zabbix instance.
           (letrec-syntax ((test-url
                            (syntax-rules ()
                              ((_ path code)
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index ca18b2f452..022663aa67 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Thomas Danckaert <post@thomasdanckaert.be>
-;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2017, 2020 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
@@ -174,12 +174,15 @@ port 7, and a dict service on port 2628."
                          (respawn? #f)))))
 
 (define %openvswitch-os
-  (simple-operating-system
-   (static-networking-service "ovs0" "10.1.1.1"
-                              #:netmask "255.255.255.252"
-                              #:requirement '(openvswitch-configuration))
-   (service openvswitch-service-type)
-   openvswitch-configuration-service))
+  (operating-system
+    (inherit (simple-operating-system
+              (static-networking-service "ovs0" "10.1.1.1"
+                                         #:netmask "255.255.255.252"
+                                         #:requirement '(openvswitch-configuration))
+              (service openvswitch-service-type)
+              openvswitch-configuration-service))
+    ;; Ensure the interface name does not change depending on the driver.
+    (kernel-arguments (cons "net.ifnames=0" %default-kernel-arguments))))
 
 (define (run-openvswitch-test)
   (define os
diff --git a/gnu/tests/package-management.scm b/gnu/tests/package-management.scm
new file mode 100644
index 0000000000..087eaf923e
--- /dev/null
+++ b/gnu/tests/package-management.scm
@@ -0,0 +1,130 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Oleg Pykhalov <go.wigust@gmail.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests package-management)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages package-management)
+  #:use-module (gnu services)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services nix)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu tests)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:export (%test-nix))
+
+;;; Commentary:
+;;;
+;;; This module provides a test definition for the nix-daemon
+;;;
+;;; Code:
+
+(define* (run-nix-test name test-os)
+  "Run tests in TEST-OS, which has nix-daemon running."
+  (define os
+    (marionette-operating-system
+     test-os
+     #:imported-modules '((gnu services herd))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '((8080 . 80)))
+     (memory-size 1024)))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11)
+                       (srfi srfi-64)
+                       (gnu build marionette)
+                       (web client)
+                       (web response))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin #$name)
+
+          ;; XXX: Shepherd reads the config file *before* binding its control
+          ;; socket, so /var/run/shepherd/socket might not exist yet when the
+          ;; 'marionette' service is started.
+          (test-assert "shepherd socket ready"
+            (marionette-eval
+             `(begin
+                (use-modules (gnu services herd))
+                (let loop ((i 10))
+                  (cond ((file-exists? (%shepherd-socket-file))
+                         #t)
+                        ((> i 0)
+                         (sleep 1)
+                         (loop (- i 1)))
+                        (else
+                         'failure))))
+             marionette))
+
+          (test-assert "Nix daemon running"
+            (marionette-eval
+             '(begin
+                ;; Wait for nix-daemon to be up and running.
+                (start-service 'nix-daemon)
+                (with-output-to-file "guix-test.nix"
+                  (lambda ()
+                    (display "\
+with import <nix/config.nix>;
+
+derivation {
+  system = builtins.currentSystem;
+  name = \"guix-test\";
+  builder = shell;
+  args = [\"-c\" \"mkdir $out\\necho FOO > $out/foo\"];
+  PATH = coreutils;
+}
+")))
+                (zero? (system* (string-append #$nix "/bin/nix-build")
+                                "--substituters" "" "--debug" "--no-out-link"
+                                "guix-test.nix")))
+             marionette))
+
+	  (test-end)
+
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation (string-append name "-test") test))
+
+(define %nix-os
+  ;; Return operating system under test.
+  (let ((base-os
+         (simple-operating-system
+          (service nix-service-type)
+	  (service dhcp-client-service-type))))
+    (operating-system
+      (inherit base-os)
+      (packages (cons nix (operating-system-packages base-os))))))
+
+(define %test-nix
+  (system-test
+   (name "nix")
+   (description "Connect to a running nix-daemon")
+   (value (run-nix-test name %nix-os))))
+
+;;; package-management.scm ends here
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 1c984dd6f4..7513eab2e4 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -521,42 +521,43 @@ HTTP-PORT."
 ;;; Patchwork
 ;;;
 
-(define patchwork-initial-database-setup-service
-  (match-lambda
-    (($ <patchwork-database-configuration>
-        engine name user password host port)
-
-     (define start-gexp
-       #~(lambda ()
-           (let ((pid (primitive-fork))
-                 (postgres (getpwnam "postgres")))
-             (if (eq? pid 0)
-                 (dynamic-wind
-                   (const #t)
-                   (lambda ()
-                     (setgid (passwd:gid postgres))
-                     (setuid (passwd:uid postgres))
-                     (primitive-exit
-                      (if (and
-                           (zero?
-                            (system* #$(file-append postgresql "/bin/createuser")
-                                     #$user))
-                           (zero?
-                            (system* #$(file-append postgresql "/bin/createdb")
-                                     "-O" #$user #$name)))
-                          0
-                          1)))
-                   (lambda ()
-                     (primitive-exit 1)))
-                 (zero? (cdr (waitpid pid)))))))
-
-     (shepherd-service
-      (requirement '(postgres))
-      (provision '(patchwork-postgresql-user-and-database))
-      (start start-gexp)
-      (stop #~(const #f))
-      (respawn? #f)
-      (documentation "Setup patchwork database.")))))
+(define (patchwork-initial-database-setup-service configuration)
+  (define start-gexp
+    #~(lambda ()
+        (let ((pid (primitive-fork))
+              (postgres (getpwnam "postgres")))
+          (if (eq? pid 0)
+              (dynamic-wind
+                (const #t)
+                (lambda ()
+                  (setgid (passwd:gid postgres))
+                  (setuid (passwd:uid postgres))
+                  (primitive-exit
+                   (if (and
+                        (zero?
+                         (system* #$(file-append postgresql "/bin/createuser")
+                                  #$(patchwork-database-configuration-user
+                                      configuration)))
+                        (zero?
+                         (system* #$(file-append postgresql "/bin/createdb")
+                                  "-O"
+                                  #$(patchwork-database-configuration-user
+                                      configuration)
+                                  #$(patchwork-database-configuration-name
+                                      configuration))))
+                       0
+                       1)))
+                (lambda ()
+                  (primitive-exit 1)))
+              (zero? (cdr (waitpid pid)))))))
+
+  (shepherd-service
+   (requirement '(postgres))
+   (provision '(patchwork-postgresql-user-and-database))
+   (start start-gexp)
+   (stop #~(const #f))
+   (respawn? #f)
+   (documentation "Setup patchwork database.")))
 
 (define (patchwork-os patchwork)
   (simple-operating-system