summary refs log tree commit diff
path: root/gnu/tests
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-10-12 16:50:47 +0000
committerMathieu Othacehe <othacehe@gnu.org>2021-10-12 17:46:23 +0000
commita1eca979fb8da842e73c42f4f53be29b169810f2 (patch)
tree681c7283e412bb8a29c2531c4408b49c3e184764 /gnu/tests
parent48d86a9ec6d8d2e97da2299ea41a03ef4cdaab83 (diff)
parent371aa5777a3805a3886f3feea5f1960fe3fe4219 (diff)
downloadguix-a1eca979fb8da842e73c42f4f53be29b169810f2.tar.gz
Merge remote-tracking branch 'origin/master' into core-updates-frozen.
Diffstat (limited to 'gnu/tests')
-rw-r--r--gnu/tests/ganeti.scm31
-rw-r--r--gnu/tests/install.scm74
2 files changed, 89 insertions, 16 deletions
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index 6d3f032036..41996678dd 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Marius Bakke <marius@gnu.org>.
+;;; Copyright © 2020, 2021 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2020 Brice Waegeneire <brice@waegenei.re>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -52,17 +52,17 @@
     (hosts-file (plain-file "hosts" (format #f "
 127.0.0.1       localhost
 ::1             localhost
-10.0.2.2        gnt1.example.com gnt1
+10.0.2.15       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"
+     (append (list (static-networking-service "eth0" "10.0.2.15"
                                               #:netmask "255.255.255.0"
-                                              #:gateway "10.0.2.1"
-                                              #:name-servers '("10.0.2.1"))
+                                              #:gateway "10.0.2.2"
+                                              #:name-servers '("10.0.2.3"))
 
                    (service openssh-service-type
                             (openssh-configuration
@@ -83,8 +83,7 @@
                           (master-netdev "eth0")
                           (hvparams '())
                           (extra-packages '())
-                          (rapi-port 5080)
-                          (noded-port 1811))
+                          (rapi-port 5080))
   "Run tests in %GANETI-OS."
   (define os
     (marionette-operating-system
@@ -96,7 +95,6 @@
                           (guix combinators))))
 
   (define %forwarded-rapi-port 5080)
-  (define %forwarded-noded-port 1811)
 
   (define vm
     (virtual-machine
@@ -104,14 +102,14 @@
      ;; 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)))))
+     (port-forwardings `((,%forwarded-rapi-port . ,rapi-port)))))
 
   (define test
     (with-imported-modules '((gnu build marionette))
       #~(begin
           (use-modules (srfi srfi-11) (srfi srfi-64)
                        (web uri) (web client) (web response)
+                       (ice-9 iconv)
                        (gnu build marionette))
 
           (define marionette
@@ -211,18 +209,19 @@
                          "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.
+          ;; Try accessing the RAPI.
           (test-equal "http-get RAPI version"
-            '(200 "2")
+            '(200 "2\n")
             (let-values
                 (((response text)
                   (http-get #$(simple-format
                                #f "http://localhost:~A/version"
                                %forwarded-rapi-port)
-                            #:decode-body? #t)))
-              (list (response-code response) text)))
+                            #:decode-body? #f)))
+              (list (response-code response)
+                    ;; The API response lacks a content-type, so
+                    ;; (http-client) won't decode it for us.
+                    (bytevector->string text "UTF-8"))))
 
           (test-equal "gnt-os list"
             "debootstrap+default\nguix+default\n"
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 130a4f76b0..98de4c8359 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -72,6 +72,7 @@
             %test-btrfs-raid-root-os
             %test-jfs-root-os
             %test-f2fs-root-os
+            %test-xfs-root-os
             %test-lvm-separate-home-os
 
             %test-gui-installed-os
@@ -1396,6 +1397,79 @@ build (current-guix) and then store a couple of full system images.")
 
 
 ;;;
+;;; XFS root file system.
+;;;
+
+(define-os-with-source (%xfs-root-os %xfs-root-os-source)
+  ;; The OS we want to install.
+  (use-modules (gnu) (gnu tests) (srfi srfi-1))
+
+  (operating-system
+    (host-name "liberigilo")
+    (timezone "Europe/Paris")
+    (locale "en_US.UTF-8")
+
+    (bootloader (bootloader-configuration
+                 (bootloader grub-bootloader)
+                 (targets (list "/dev/vdb"))))
+    (kernel-arguments '("console=ttyS0"))
+    (file-systems (cons (file-system
+                          (device (file-system-label "my-root"))
+                          (mount-point "/")
+                          (type "xfs"))
+                        %base-file-systems))
+    (users (cons (user-account
+                  (name "charlie")
+                  (group "users")
+                  (supplementary-groups '("wheel" "audio" "video")))
+                 %base-user-accounts))
+    (services (cons (service marionette-service-type
+                             (marionette-configuration
+                              (imported-modules '((gnu services herd)
+                                                  (guix combinators)))))
+                    %base-services))))
+
+(define %xfs-root-installation-script
+  ;; Shell script of a simple installation.
+  "\
+. /etc/profile
+set -e -x
+guix --version
+
+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 2G \\
+  set 1 boot on \\
+  set 1 bios_grub on
+mkfs.xfs -L my-root -q /dev/vdb2
+mount /dev/vdb2 /mnt
+herd start cow-store /mnt
+mkdir /mnt/etc
+cp /etc/target-config.scm /mnt/etc/config.scm
+guix system build /mnt/etc/config.scm
+guix system init /mnt/etc/config.scm /mnt --no-substitutes
+sync
+reboot\n")
+
+(define %test-xfs-root-os
+  (system-test
+   (name "xfs-root-os")
+   (description
+    "Test basic functionality of an OS installed like one would do by hand.
+This test is expensive in terms of CPU and storage usage since we need to
+build (current-guix) and then store a couple of full system images.")
+   (value
+    (mlet* %store-monad ((image   (run-install %xfs-root-os
+                                               %xfs-root-os-source
+                                               #:script
+                                               %xfs-root-installation-script))
+                         (command (qemu-command/writable-image image)))
+      (run-basic-test %xfs-root-os command "xfs-root-os")))))
+
+
+;;;
 ;;; Installation through the graphical interface.
 ;;;