[bug#76488,4/4] tests: Test installation on Debian.

Message ID ac27fc5a59300e05489bc3b76cca87cefb430913.1740243928.git.ludo@gnu.org
State New
Headers
Series Test installation on Debian |

Commit Message

Ludovic Courtès Feb. 22, 2025, 5:10 p.m. UTC
  * gnu/tests/foreign.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.

Change-Id: I1f24d83bdc298acbef15db2e19775cc1d3fbd56c
---
 gnu/local.mk          |   1 +
 gnu/tests/foreign.scm | 337 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 338 insertions(+)
 create mode 100644 gnu/tests/foreign.scm
  

Comments

Rodion Goritskov Feb. 23, 2025, 9:21 p.m. UTC | #1
Hi,

Ludovic Courtès <ludo@gnu.org> writes:

> * gnu/tests/foreign.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
>
> Change-Id: I1f24d83bdc298acbef15db2e19775cc1d3fbd56c
> ---
>  gnu/local.mk          |   1 +
>  gnu/tests/foreign.scm | 337 ++++++++++++++++++++++++++++++++++++++++++
>  2 files changed, 338 insertions(+)

I got some questions on the test itself.

> diff --git a/gnu/tests/foreign.scm b/gnu/tests/foreign.scm
> new file mode 100644
> index 00000000000..8cf580cb22d
> --- /dev/null
> +++ b/gnu/tests/foreign.scm
> +(define-module (gnu tests foreign)
> +  #:use-module (guix download)
> +  #:use-module (guix gexp)
> +  #:use-module (guix modules)
> +  #:use-module (guix monads)
> +  #:use-module (guix packages)
> +  #:use-module (guix profiles)
> +  #:autoload   (guix store) (%store-prefix %store-monad %graft?)
> +  #:use-module (gnu compression)
> +  #:use-module (gnu tests)
> +  #:use-module (gnu packages base)
> +  #:use-module (gnu packages bootstrap)
> +  #:use-module (gnu packages guile)
> +  #:use-module (gnu packages make-bootstrap)
> +  #:use-module (gnu packages package-management)
> +  #:use-module (gnu packages virtualization)
> +  #:use-module (gnu system vm)
> +  #:use-module ((guix scripts pack) #:prefix pack:)
> +  #:use-module (srfi srfi-9))

How could I run this test?
As I see, the #:export is missing, so I couldn't run it with the make
check-system.
Sorry, I am kind of a newcomer to the Guile world - I see the call of
the %test-foreign-install in the end of the file, but how should I run
the whole file?

> +  (define vm
> +    (virtual-machine
> +     (marionette-operating-system %simple-os)))

Somehow I got some out of memory errors a couple of times during the
qcow build with this configuration
- so I changed to the following and stopped encountering this issue (odd
that 256 MB is not enough here sometimes):
>  (define vm
>    (virtual-machine
>     (operating-system (marionette-operating-system %simple-os))
>     (memory-size 512)))


> +            (marionette-eval '(begin
> +                                (use-modules (guix build utils))
> +                                (mkdir-p "/mnt/opt/guix")
> +                                (copy-recursively #$%guile-static-initrd
> +                                                  "/mnt/opt/guix"
> +                                                  #:log (%make-void-port "w")))

On this step I see, that guile reports that source files are newer than go
files and starts recompilation.
Probably, that is because of updated timestamps when copying.
Looks like it could be fixed with the keep-mtime? set to true.
>             (marionette-eval '(begin
>                                (use-modules (guix build utils))
>                                (mkdir-p "/mnt/opt/guix")
>                                (copy-recursively #$%guile-static-initrd
>                                                  "/mnt/opt/guix"
>                                                  #:log (%make-void-port "w")
>                                                  #:keep-mtime? #t))

After that test installs guix on debian, but during the build of
hello it starts building all the dependencies, which is unexpected, I
think, and fails during the fetching of sources (which is, probably,
expected, because the network is not available).

Sorry for the inconvenience, I still figuring out how it works (or
should work).
  
Ludovic Courtès Feb. 23, 2025, 10 p.m. UTC | #2
Hi Rodion,

Rodion Goritskov <rodion@goritskov.com> skribis:

> How could I run this test?
> As I see, the #:export is missing, so I couldn't run it with the make
> check-system.
> Sorry, I am kind of a newcomer to the Guile world - I see the call of
> the %test-foreign-install in the end of the file, but how should I run
> the whole file?

Oops, I ran it with:

  ./pre-inst-env guix build -f gnu/tests/foreign.scm

but really, it should have exported the test so one can run:

  make check-system TESTS=debian-install

I’ll fix that in a second version.

>> +  (define vm
>> +    (virtual-machine
>> +     (marionette-operating-system %simple-os)))
>
> Somehow I got some out of memory errors a couple of times during the
> qcow build with this configuration
> - so I changed to the following and stopped encountering this issue (odd
> that 256 MB is not enough here sometimes):

Interesting; it worked for me.  But perhaps that has to do with the
timestamp issue: if .scm files were being recompiled due to timestamps,
then the process ended up consuming more memory.

>> +            (marionette-eval '(begin
>> +                                (use-modules (guix build utils))
>> +                                (mkdir-p "/mnt/opt/guix")
>> +                                (copy-recursively #$%guile-static-initrd
>> +                                                  "/mnt/opt/guix"
>> +                                                  #:log (%make-void-port "w")))
>
> On this step I see, that guile reports that source files are newer than go
> files and starts recompilation.
> Probably, that is because of updated timestamps when copying.
> Looks like it could be fixed with the keep-mtime? set to true.

Yes, that’s a good idea.  I guess I was just lucky the .scm timestamps
looked older than .go timestamps.

> After that test installs guix on debian, but during the build of
> hello it starts building all the dependencies, which is unexpected, I
> think, and fails during the fetching of sources (which is, probably,
> expected, because the network is not available).

‘%installation-tarball-manifest’ is so that only ‘hello’ itself is
missing from the store.  If you observe that it tries to build more,
then something is wrong; looking at the “The following derivations will
be built” message can (maybe) give a hint, by looking at the bottom of
that long derivation list.

Thanks for taking a look, I’ll send a new version fixing these issues!

Ludo’.
  
Efraim Flashner Feb. 24, 2025, 9:30 a.m. UTC | #3
On Sat, Feb 22, 2025 at 06:10:16PM +0100, Ludovic Courtès wrote:
> +
> +(define debian-12-qcow2
> +  ;; Image taken from <https://www.debian.org/distrib/>.
> +  ;; XXX: Those images are periodically removed from debian.org.
> +  (origin
> +    (uri
> +     "https://cloud.debian.org/images/cloud/bookworm/latest/debian-12-nocloud-amd64.qcow2")
> +    (method url-fetch)
> +    (sha256
> +     (base32
> +      "06vlcq2dzgczlyp9lfkkdf3dgvfjp22lh5xz0mnl0bdgzq61sykb"))))
> 

It would probably be better to use the direct URL
https://cloud.debian.org/images/cloud/bookworm/20250210-2019/debian-12-nocloud-amd64-20250210-2019.qcow2

I have questions about also running the test on aarch64 or powerpc64le,
but that can be adjusted after the fact.
  
Ludovic Courtès Feb. 24, 2025, 10 a.m. UTC | #4
Rodion Goritskov <rodion@goritskov.com> skribis:

> After that test installs guix on debian, but during the build of
> hello it starts building all the dependencies, which is unexpected, I
> think, and fails during the fetching of sources (which is, probably,
> expected, because the network is not available).

Silly me: this patch series actually depends on
<https://issues.guix.gnu.org/76485>.  That’s why you’re experiencing
this.

As a workaround, you can build with ‘--no-grafts’.

Ludo’.
  
Ludovic Courtès Feb. 24, 2025, 10:01 a.m. UTC | #5
Hello,

Efraim Flashner <efraim@flashner.co.il> skribis:

> It would probably be better to use the direct URL
> https://cloud.debian.org/images/cloud/bookworm/20250210-2019/debian-12-nocloud-amd64-20250210-2019.qcow2

Will do!

> I have questions about also running the test on aarch64 or powerpc64le,
> but that can be adjusted after the fact.

Right.  I only focused on x86_64-linux here.

Thanks,
Ludo’.
  
Ludovic Courtès Feb. 24, 2025, 12:56 p.m. UTC | #6
Just sent v2 of this patch series.
  

Patch

diff --git a/gnu/local.mk b/gnu/local.mk
index c421da85cba..66cca59839e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -848,6 +848,7 @@  GNU_SYSTEM_MODULES =				\
   %D%/tests/docker.scm				\
   %D%/tests/emacs.scm				\
   %D%/tests/file-sharing.scm			\
+  %D%/tests/foreign.scm				\
   %D%/tests/ganeti.scm				\
   %D%/tests/gdm.scm				\
   %D%/tests/guix.scm				\
diff --git a/gnu/tests/foreign.scm b/gnu/tests/foreign.scm
new file mode 100644
index 00000000000..8cf580cb22d
--- /dev/null
+++ b/gnu/tests/foreign.scm
@@ -0,0 +1,337 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Ludovic Courtès <ludo@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 foreign)
+  #:use-module (guix download)
+  #:use-module (guix gexp)
+  #:use-module (guix modules)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:autoload   (guix store) (%store-prefix %store-monad %graft?)
+  #:use-module (gnu compression)
+  #:use-module (gnu tests)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages bootstrap)
+  #:use-module (gnu packages guile)
+  #:use-module (gnu packages make-bootstrap)
+  #:use-module (gnu packages package-management)
+  #:use-module (gnu packages virtualization)
+  #:use-module (gnu system vm)
+  #:use-module ((guix scripts pack) #:prefix pack:)
+  #:use-module (srfi srfi-9))
+
+(define marionette-systemd-service
+  ;; Definition of the marionette service for systemd.
+  (plain-file "marionette.service" "
+[Unit]
+Description=Guix marionette service
+
+[Install]
+WantedBy=multi-user.target
+
+[Service]
+ExecStart=/opt/guix/bin/guile --no-auto-compile \\
+  /opt/guix/share/guix/marionette-repl.scm\n"))
+
+(define* (qcow-image-with-marionette image
+                                     #:key
+                                     (name "image-with-marionette.qcow2")
+                                     (device "/dev/vdb1"))
+  "Instrument IMAGE, returning a new image that contains a statically-linked
+Guile under /opt/guix and a marionette systemd service.  The relevant file
+system is expected to be on DEVICE."
+  (define vm
+    (virtual-machine
+     (marionette-operating-system %simple-os)))
+
+  (define build
+    (with-imported-modules (source-module-closure
+                            '((guix build utils)
+                              (gnu build marionette)))
+      #~(begin
+          (use-modules (guix build utils)
+                       (gnu build marionette))
+
+          (define target-image
+            #$output)
+
+          (invoke #+(file-append qemu "/bin/qemu-img")
+                  "create" "-b" #$image
+                  "-F" "qcow2" "-f" "qcow2" target-image
+                  "10G")
+
+          ;; Run a VM that will mount IMAGE and populate it.  This is somewhat
+          ;; more convenient to set up than 'guestfish' from libguestfs.
+          (let ((marionette
+                 (make-marionette
+                  (list #$vm "-drive"
+                        (string-append "file=" target-image
+                                       ",format=qcow2,if=virtio,"
+                                       "cache=writeback,werror=report,readonly=off")))))
+
+            (marionette-eval '(system* "mount" #$device "/mnt")
+                             marionette)
+            (marionette-eval '(system* "ls" "-la" "/mnt")
+                             marionette)
+            (marionette-eval '(begin
+                                (use-modules (guix build utils))
+                                (mkdir-p "/mnt/opt/guix")
+                                (copy-recursively #$%guile-static-initrd
+                                                  "/mnt/opt/guix"
+                                                  #:log (%make-void-port "w")))
+                             marionette)
+            (marionette-eval '(system* "/mnt/opt/guix/bin/guile" "--version")
+                             marionette)
+            (unless (= 42 (status:exit-val
+                           (marionette-eval '(system* "/mnt/opt/guix/bin/guile"
+                                                      "-c" "(exit 42)")
+                                            marionette)))
+              (error "statically-linked Guile is broken"))
+
+            ;; Install the marionette systemd service and activate it.
+            (marionette-eval '(begin
+                                (mkdir-p "/mnt/opt/guix/share/guix")
+                                (copy-file #$(marionette-program)
+                                           "/mnt/opt/guix/share/guix/marionette-repl.scm")
+
+                                (mkdir-p "/mnt/etc/systemd/system")
+                                (copy-file #$marionette-systemd-service
+                                           "/mnt/etc/systemd/system/marionette.service")
+
+                                ;; Activate the service, as per 'systemctl
+                                ;; enable marionette.service'.
+                                (symlink
+                                 "/etc/systemd/system/marionette.service"
+                                 "/mnt/etc/systemd/system/multi-user.target.wants/marionette.service"))
+                             marionette)
+
+            (unless (zero? (marionette-eval '(system* "umount" "/mnt")
+                                            marionette))
+              (error "failed to unmount device"))))))
+
+  (computed-file name build))
+
+(define (manifest-entry-without-grafts entry)
+  "Return ENTRY with grafts disabled on its contents."
+  (manifest-entry
+    (inherit entry)
+    (item (with-parameters ((%graft? #f))
+            (manifest-entry-item entry)))))
+
+(define %installation-tarball-manifest
+  ;; Manifest of the Guix installation tarball.
+  (concatenate-manifests
+   (list (packages->manifest (list guix))
+
+         ;; Include the dependencies of 'hello' in addition to 'guix' so that
+         ;; we can test 'guix build hello'.
+         (map-manifest-entries
+          manifest-entry-without-grafts
+          (package->development-manifest hello))
+
+         ;; Add the source of 'hello'.
+         (manifest
+          (list (manifest-entry
+                  (name "hello-source")
+                  (version (package-version hello))
+                  (item (let ((file (origin-actual-file-name
+                                     (package-source hello))))
+                          (computed-file
+                           "hello-source"
+                           #~(begin
+                               ;; Put the tarball in a subdirectory since
+                               ;; profile union crashes otherwise.
+                               (mkdir #$output)
+                               (mkdir (in-vicinity #$output "src"))
+                               (symlink #$(package-source hello)
+                                        (in-vicinity #$output
+                                                     (string-append "src/"
+                                                                    #$file))))))))))
+
+         ;; Include 'guile-final', which is needed when building derivations
+         ;; such as that of 'hello' but missing from the development manifest.
+         ;; Add '%bootstrap-guile', used by 'guix install --bootstrap'.
+         (map-manifest-entries
+          manifest-entry-without-grafts
+          (packages->manifest (list (canonical-package guile-3.0)
+                                    %bootstrap-guile))))))
+
+(define %guix-install-script
+  ;; The 'guix-install.sh' script.
+  ;;
+  ;; To test local changes, replace the expression below with:
+  ;;
+  ;;   (local-file "../../etc/guix-install.sh")
+  ;;
+  ;; This cannot be done unconditionally since that file does not exists in
+  ;; inferiors.
+  (file-append (package-source guix) "/etc/guix-install.sh"))
+
+(define (run-foreign-install-test image name)
+  "Run an installation of Guix in IMAGE, the QCOW2 image of a systemd-based
+GNU/Linux distro, and check that the installation is functional."
+  (define instrumented-image
+    (qcow-image-with-marionette image
+                                #:name (string-append name ".qcow2")))
+
+  (define (test tarball)
+    (with-imported-modules (source-module-closure
+                            '((gnu build marionette)
+                              (gnu system file-systems)))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (gnu system file-systems)
+                       (srfi srfi-64)
+                       (ice-9 match))
+
+          (define marionette
+            (make-marionette
+             (list (string-append #$qemu-minimal "/bin/" (qemu-command))
+                   #$@(common-qemu-options instrumented-image
+                                           (list (%store-prefix))
+                                           #:image-format "qcow2"
+                                           #:rw-image? #t)
+                   "-m" "512"
+                   "-snapshot")))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "foreign-install")
+
+          (test-equal "marionette works"
+            "Linux"
+            (marionette-eval '(utsname:sysname (uname))
+                             marionette))
+
+          (test-equal "mount host file store"
+            0
+            (marionette-eval
+             '(begin
+                (mkdir "/host")
+                (system* "mount" "-t" "9p"
+                         "-o" "trans=virtio,cache=loose,ro"
+                         #$(file-system->mount-tag (%store-prefix))
+                         "/host"))
+             marionette))
+
+          (test-assert "screenshot before"
+            (marionette-control (string-append "screendump " #$output
+                                               "/before-install.ppm")
+                                marionette))
+
+          (test-assert "install fake dependencies"
+            ;; The installation script insists on checking for the
+            ;; availability of 'wget' and 'gpg' but does not actually use them
+            ;; when 'GUIX_BINARY_FILE_NAME' is set.  Provide fake binaries.
+            (marionette-eval '(begin
+                                (symlink "/bin/true" "/bin/wget")
+                                (symlink "/bin/true" "/bin/gpg")
+                                #t)
+                             marionette))
+
+          (test-assert "run install script"
+            (marionette-eval '(system
+                               (string-append
+                                "yes '' | GUIX_BINARY_FILE_NAME="
+                                (in-vicinity "/host"
+                                             (basename #$tarball))
+                                " sh "
+                                (in-vicinity
+                                 "/host"
+                                 (string-drop #$%guix-install-script
+                                              #$(string-length
+                                                 (%store-prefix))))))
+                             marionette))
+
+          (test-equal "hello not already built"
+            #f
+            ;; Check that the next test will really build 'hello'.
+            (marionette-eval '(file-exists?
+                               #$(with-parameters ((%graft? #f))
+                                   hello))
+                             marionette))
+
+          (test-equal "guix build hello"
+            0
+            ;; Check that guix-daemon is up and running and that the build
+            ;; environment is properly set up (build users, etc.).
+            (marionette-eval '(system* "guix" "build" "hello" "--no-grafts")
+                             marionette))
+
+          (test-assert "hello indeed built"
+            (marionette-eval '(file-exists?
+                               #$(with-parameters ((%graft? #f))
+                                   hello))
+                             marionette))
+
+          (test-equal "guix install hello"
+            0
+            ;; Check that ~/.guix-profile & co. are properly created.
+            (marionette-eval '(let ((pw (getpwuid (getuid))))
+                                (setenv "USER" (passwd:name pw))
+                                (setenv "HOME" (pk 'home (passwd:dir pw)))
+                                (system* "guix" "install" "hello"
+                                         "--no-grafts" "--bootstrap"))
+                             marionette))
+
+          (test-equal "user profile created"
+            0
+            (marionette-eval '(system "ls -lad ~/.guix-profile")
+                             marionette))
+
+          (test-equal "hello"
+            0
+            (marionette-eval '(system "~/.guix-profile/bin/hello")
+                             marionette))
+
+          (test-assert "screenshot after"
+            (marionette-control (string-append "screendump " #$output
+                                               "/after-install.ppm")
+                                marionette))
+
+          (test-end))))
+
+  (mlet* %store-monad ((profile (profile-derivation
+                                 %installation-tarball-manifest))
+                       (tarball (pack:self-contained-tarball
+                                 "guix-binary" profile
+                                 #:compressor (lookup-compressor "zstd")
+                                 #:profile-name "current-guix"
+                                 #:localstatedir? #t)))
+    (gexp->derivation name (test tarball))))
+
+(define debian-12-qcow2
+  ;; Image taken from <https://www.debian.org/distrib/>.
+  ;; XXX: Those images are periodically removed from debian.org.
+  (origin
+    (uri
+     "https://cloud.debian.org/images/cloud/bookworm/latest/debian-12-nocloud-amd64.qcow2")
+    (method url-fetch)
+    (sha256
+     (base32
+      "06vlcq2dzgczlyp9lfkkdf3dgvfjp22lh5xz0mnl0bdgzq61sykb"))))
+
+(define %test-foreign-install
+  (system-test
+   (name "debian-install")
+   (description
+    "Test installation of Guix on Debian using the @file{guix-install.sh}
+script.")
+   (value (run-foreign-install-test debian-12-qcow2 name))))
+
+%test-foreign-install