tests: Fix the git-http test.

The test fails because the fcgiwrap daemon that runs as "fcgiwrap" user cannot
access the /srv/git directory that is root-owned.

* gnu/tests/version-control.scm (run-git-http-test): Change the ownership
of /srv/git so that fcgiwrap can access it.

Change-Id: I01fa98e3311ac0dba88a4af21cee3ae0da986582

Makefile.am

@@ -722,7 +722,7 @@ endif !CAN_RUN_TESTS
 
 check-system: $(GOBJECTS)
 	$(AM_V_at)$(top_builddir)/pre-inst-env			\
-	  guix build -m $(top_srcdir)/etc/manifests/system-tests.scm -K
+          guix repl -- $(top_srcdir)/build-aux/run-system-tests.scm -K
 
 # Public keys used to sign substitutes.
 dist_pkgdata_DATA =				\

build-aux/run-system-tests.scm

@@ -0,0 +1,228 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Mathieu Othacehe <othacehe@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/>.
+
+(use-modules (gnu)
+             (gnu tests)
+             (gnu packages package-management)
+             (guix)
+             (guix colors)
+             ((guix build utils)
+                #:select (delete-file-recursively))
+             (guix store)
+             (guix packages)
+             (guix utils)
+             (guix ui)
+             (guix build syscalls)
+             (srfi srfi-1)
+             (srfi srfi-26)
+             (ice-9 getopt-long)
+             (ice-9 match)
+             (ice-9 exceptions)
+             (ice-9 pretty-print)
+             (ice-9 rdelim)
+             (web uri))
+
+;; Version of the script.
+(define script-version "0.1")
+
+;; Directory for the system test logs.
+(define tmpdir (mkdtemp! "/tmp/system-tests-XXXXXX"))
+
+;; Save the stdout and stderr ports.
+(define output-port (duplicate-port (current-output-port) "w0"))
+(define error-port (duplicate-port (current-error-port) "w0"))
+
+;; List of all the system tests, sorted alphabetically.
+(define all-sorted-tests
+  (sort (all-system-tests)
+        (lambda (a b)
+          (string<? (system-test-name a) (system-test-name b)))))
+
+(define (test->log-file test)
+  "Return the name of the log file for the given system TEST."
+  (format #f "~a/~a.log" tmpdir (system-test-name test)))
+
+(define (print-failure)
+  "Print a failure message."
+  (format output-port
+          (colorize-string "FAIL" (color RED BOLD)))
+  (format output-port "~%"))
+
+(define (print-success)
+  "Print a success message."
+  (format output-port
+          (colorize-string "OK" (color GREEN BOLD)))
+  (format output-port "~%"))
+
+(define* (run-system-test test #:key redirect-output?)
+  "Run the given system-test and redirect the test output to a file.
+Return true if the test is successful and false otherwise."
+  (define log-port
+    (and redirect-output?
+         (open-output-file (test->log-file test))))
+
+  (dynamic-wind
+    (lambda ()
+      (when redirect-output?
+        (redirect-port log-port (current-output-port))
+        (redirect-port log-port (current-warning-port))
+        (redirect-port log-port (current-error-port))))
+    (lambda ()
+      (parameterize ((current-build-output-port
+                      (if redirect-output?
+                          log-port
+                          (current-build-output-port))))
+        (let ((store (open-connection)))
+          (run-with-store store
+            (mlet %store-monad
+                ((drv (lower-object test)))
+              (return
+               (guard (c ((store-protocol-error? c)
+                          (print-failure)
+                          #f))
+                 (and (build-derivations store (list drv))
+                      (print-success)))))))))
+    (lambda ()
+      (and redirect-output?
+           (close-port log-port)))))
+
+(define* (print-results results #:key keep-logs)
+  "Use RESULTS, a list of booleans, to print out the test results.  If
+some tests are failing, exit with the error code 1.  Otherwise, exit with
+success."
+  (let* ((ok-count (count identity results))
+         (fail-count (- (length results) ok-count)))
+    (format output-port "~%")
+    (if keep-logs
+        (format output-port "Test results are available in ~a~%" tmpdir)
+        (delete-file-recursively tmpdir))
+    (if (= fail-count 0)
+        (begin
+          (format output-port "All system tests are successful.~%")
+          (exit 0))
+        (begin
+          (format output-port "~a failing test~a~%" fail-count
+                  (if (> fail-count 1) "s" ""))
+          (exit 1)))))
+
+(define* (run-tests tests #:key keep-logs redirect-output?)
+  "Run all the given TESTS.  If KEEP-LOGS is set to true, keep the system test
+log files."
+  (let* ((count (length tests))
+         (indexes (iota count)))
+    (print-results
+     (map (lambda (index test)
+            (format output-port "Running ~a (~a/~a): "
+                    (system-test-name test)
+                    (1+ index) count)
+            (force-output output-port)
+            (run-system-test test #:redirect-output? redirect-output?))
+          indexes tests)
+     #:keep-logs keep-logs)))
+
+(define (subset-tests tests subset)
+  "Return the subset of TESTS that are also in the given SUBSET list."
+  (filter
+   (lambda (test)
+     (let ((name (system-test-name test)))
+       (member name subset)))
+   tests))
+
+(define (exclude-tests tests excludes)
+  "Return the given TESTS list without the tests that are part of the EXCLUDES
+list."
+  (filter
+   (lambda (test)
+     (let ((name (system-test-name test)))
+       (not (member name excludes))))
+   tests))
+
+(define (show-help)
+  (display "Usage: run-system-tests.scm [OPTIONS]
+Run the system tests.\n")
+  (display " --tests=TEST1,TEST2,...           run only TEST1 and TEST2")
+  (newline)
+  (display " --exclude-tests=TEST1,TEST2,...   run all tests but TEST1 and TEST2")
+  (newline)
+  (display " --list-tests                      list all the system tests")
+  (newline)
+  (display " -n, --no-redirect                 do not redirect the test logs")
+  (newline)
+  (display " -K, --keep-logs                   keep the test logs")
+  (newline)
+  (display " -h, --help                        display this help and exit")
+  (newline)
+  (display " -V, --version                     display verson information and exit")
+  (newline))
+
+(define %options
+  '((tests                          (value #t))
+    (exclude-tests                  (value #t))
+    (list-tests                     (value #f))
+    (keep-logs    (single-char #\K) (value #f))
+    (no-redirect  (single-char #\n) (value #f))
+    (help         (single-char #\h) (value #f))
+    (version      (single-char #\V) (value #f))))
+
+(define (main . args)
+  (define guix-source
+    (canonicalize-path
+     (string-append (current-source-directory) "/..")))
+
+  ;; Use the local Guix as the current-guix-package so that we do not compute
+  ;; the Guix derivation over and over.
+  (define guix-local
+    (package
+      (inherit guix)
+      (source (local-file guix-source #:recursive? #t))
+      (arguments
+     (substitute-keyword-arguments (package-arguments guix)
+       ((#:tests? #f #f) #f)))))
+
+  (let* ((opts (getopt-long (command-line) %options))
+         (option (cut option-ref opts <> <>))
+         (keep-logs (option 'keep-logs #f))
+         (no-redirect (option 'no-redirect #f)))
+    (cond
+     ((option 'help #f)
+      (show-help))
+     ((option 'version #f)
+      (format #t "run-system-tests.scm ~A~%" script-version))
+     ((option 'list-tests #f)
+      (format #t "System tests:~%~{- ~a~%~}"
+              (map (lambda (test)
+                     (system-test-name test))
+                   all-sorted-tests)))
+     (else
+      (let* ((subset
+              (and=> (option 'tests #f)
+                     (cut string-split <> #\,)))
+             (excludes
+              (and=> (option 'exclude-tests #f)
+                     (cut string-split <> #\,)))
+             (tests
+              (cond
+               (excludes (exclude-tests all-sorted-tests excludes))
+               (subset (subset-tests all-sorted-tests subset))
+               (else all-sorted-tests))))
+        (parameterize ((current-guix-package guix-local))
+          (run-tests tests
+                     #:keep-logs keep-logs
+                     #:redirect-output? (not no-redirect))))))))
+
+(apply main (cdr (command-line)))

gnu/installer/final.scm

@@ -220,6 +220,11 @@ or #f.  Return #t on success and #f on failure."
 
              (setenv "PATH" "/run/current-system/profile/bin/")
 
+             (for-each (lambda (line)
+                         (installer-log-line "~a" line))
+                       (with-input-from-file (%installer-configuration-file)
+                         read-lines))
+
              (set! ret (run-command install-command #:tty? #t)))
            (lambda ()
              ;; Stop guix-daemon so that it does no keep the MNT namespace

gnu/installer/newt/network.scm

@@ -112,35 +112,29 @@ network devices were found. Do you want to continue anyway?"))
              full-value
              (+ value 1)))))))
 
-(define (url-alive? url)
-  (false-if-exception
-   (begin
-     (http-request url)
-     #t)))
-
-(define (common-urls-alive? urls)
-  (dynamic-wind
-    (lambda ()
-      (sigaction SIGALRM
-        (lambda _ #f))
-      (alarm 3))
-    (lambda ()
-      (any url-alive?
-           urls))
-    (lambda ()
-      (alarm 0))))
-
 (define (wait-service-online)
   "Display a newt scale until connman detects an Internet access. Do
 FULL-VALUE tentatives, spaced by 1 second."
+  (define (url-alive? url)
+    (false-if-exception
+     (= (response-code (http-request url))
+        200)))
+
+  (define (ci-available?)
+    (dynamic-wind
+      (lambda ()
+        (sigaction SIGALRM
+          (lambda _ #f))
+        (alarm 3))
+      (lambda ()
+        (or (url-alive? "https://bordeaux.guix.gnu.org")
+            (url-alive? "https://ci.guix.gnu.org")))
+      (lambda ()
+        (alarm 0))))
+
   (define (online?)
     (or (and (connman-online?)
-             (common-urls-alive?
-              (list
-               "https://bordeaux.guix.gnu.org"
-               "https://ci.guix.gnu.org"
-               "https://guix.gnu.org"
-               "https://gnu.org")))
+             (ci-available?))
         (file-exists? "/tmp/installer-assume-online")))
 
   (let* ((full-value 5))
@@ -155,45 +149,11 @@ FULL-VALUE tentatives, spaced by 1 second."
            full-value
            (+ value 1))))
     (unless (online?)
-      (case (choice-window
-             (G_ "Internet access")
-             (G_ "Continue")
-             (G_ "Try again?")
-             (G_ "
-The selected network does not seem to provide access to the \
-Internet. The install process requires Internet access. \
-Do you want to continue anyway?"))
-        ((2) (abort-to-prompt 'installer-step 'abort))))))
-
-(define (check-substitute-availability)
-  "Check that at least one of the Guix substitute servers is available."
-  (define (substitutes-available?)
-    (common-urls-alive?
-     (list
-      "https://bordeaux.guix.gnu.org/nix-cache-info"
-      "https://ci.guix.gnu.org/nix-cache-info")))
-
-  (let* ((full-value 5))
-    (run-scale-page
-     #:title (G_ "Checking substitutes")
-     #:info-text (G_ "Checking if Guix substitutes are available...")
-     #:scale-full-value full-value
-     #:scale-update-proc
-     (lambda (value)
-       (sleep 1)
-       (if (substitutes-available?)
-           full-value
-           (+ value 1))))
-    (unless (substitutes-available?)
-      (case (choice-window
-             (G_ "Substitute availability")
-             (G_ "Continue")
-             (G_ "Try again?")
-             (G_ "
-None of the Guix substitute servers are available.
-You can proceed with the install, but you will
-have to build most of the packages you install locally."))
-        ((2) (abort-to-prompt 'installer-step 'abort))))))
+      (run-error-page
+       (G_ "The selected network does not provide access to the \
+Internet and the Guix substitute server, please try again.")
+       (G_ "Connection error"))
+      (abort-to-prompt 'installer-step 'abort))))
 
 (define (run-network-page)
   "Run a page to allow the user to configure connman so that it can access the
@@ -232,11 +192,7 @@ Internet."
      (installer-step
       (id 'wait-online)
       (compute (lambda _
-                 (wait-service-online))))
-     (installer-step
-      (id 'check-substitutes)
-      (compute (lambda _
-                 (check-substitute-availability))))))
+                 (wait-service-online))))))
   (run-installer-steps
    #:steps network-steps
    #:rewind-strategy 'start))

gnu/installer/services.scm

@@ -82,7 +82,7 @@
       (snippet '((service mate-desktop-service-type))))
      (desktop-environment
       (name "Icewm")
-      (snippet '((specification->package "icewm"))))
+      (packages '((specification->package "icewm"))))
      (desktop-environment
       (name "Openbox")
       (packages '((specification->package "openbox"))))

gnu/local.mk

@@ -955,6 +955,7 @@ MODULES_NOT_COMPILED +=				\
 
 patchdir = $(guilemoduledir)/%D%/packages/patches
 dist_patch_DATA =						\
+  %D%/packages/patches/389-ds-base-legacy-version.patch		\
   %D%/packages/patches/8mq-enable-imx_hab_handler.patch		\
   %D%/packages/patches/8mq-move-stack-to-ocram_s.patch		\
   %D%/packages/patches/abcl-fix-build-xml.patch	\

gnu/packages/openldap.scm

@@ -236,6 +236,7 @@ servers from Python programs.")
               (sha256
                (base32
                 "1sdvfbjfg0091f47562gw3gdc2vgvvhyhdi21lrpwnw9lqc8xdxk"))
+              (patches (search-patches "389-ds-base-legacy-version.patch"))
               (modules '((guix build utils)))
               (snippet
                ;; Put '#define f_type' after '#include <sys/statvfs.h>' to
@@ -273,6 +274,12 @@ servers from Python programs.")
       #~(modify-phases %standard-phases
           (add-after 'unpack 'fix-references
             (lambda _
+              ;; Add the NSS bin output to the search path, so that certutil
+              ;; can be found below.  As nss:bin does not have a sub "/bin"
+              ;; directory it cannot be found directly.
+              (let ((path (getenv "PATH"))
+                    (nss (string-append ":" #$nss:bin)))
+                (setenv "PATH" (string-append path ":" nss)))
               ;; Avoid dependency on systemd-detect-virt
               (substitute* "src/lib389/lib389/instance/setup.py"
                 (("container_result = subprocess.*") "container_result = 1\n")

gnu/packages/package-management.scm

@@ -198,8 +198,8 @@
   ;; Note: the 'update-guix-package.scm' script expects this definition to
   ;; start precisely like this.
   (let ((version "1.4.0")
-        (commit "d671b750f147d63792fbde93c9b17138492a40f5")
-        (revision 46))
+        (commit "c41e44ba577d92aceac16c13c5152036dc3ae358")
+        (revision 47))
     (package
       (name "guix")
 
@@ -215,7 +215,7 @@
                       (commit commit)))
                 (sha256
                  (base32
-                  "1mrfm0mf9jxzv7q34dyrqspjwb3yi95v7fd3jx89yffvcdd42x21"))
+                  "01lmws2j39lqvbspdb9a89cc3xmnl03qnycvfga3l59myi3rf44m"))
                 (file-name (string-append "guix-" version "-checkout"))))
       (build-system gnu-build-system)
       (arguments

gnu/packages/patches/389-ds-base-legacy-version.patch

@@ -0,0 +1,40 @@
+LegacyVersion does not exist anymore in packaging.version 25.0
+(https://github.com/pypa/packaging/pull/407). This patch is needed until
+389-ds-base is updated to a newer version.
+
+diff --git a/src/lib389/lib389/utils_orig.py b/src/lib389/lib389/utils.py
+index da966ed..30f127d 100644
+--- a/src/lib389/lib389/utils.py
++++ b/src/lib389/lib389/utils.py
+@@ -46,7 +46,12 @@ try:
+     from pkg_resources.extern.packaging.version import LegacyVersion
+ # Fallback to a normal 'packaging' module in case 'setuptools' is stripped
+ except:
+-    from packaging.version import LegacyVersion
++    from packaging.version import Version
++
++    # Define a stub LegacyVersion for compatibility.
++    class LegacyVersion(Version):
++        def __init__(self, v):
++            super().__init__(v)
+ from socket import getfqdn
+ from ldapurl import LDAPUrl
+ from contextlib import closing
+diff --git a/src/lib389/lib389/nss_ssl_orig.py b/src/lib389/lib389/nss_ssl.py
+index 3561597..6622a46 100644
+--- a/src/lib389/lib389/nss_ssl_orig.py
++++ b/src/lib389/lib389/nss_ssl.py
+@@ -31,7 +31,12 @@ try:
+     from pkg_resources.extern.packaging.version import LegacyVersion
+ # Fallback to a normal 'packaging' module in case 'setuptools' is stripped
+ except:
+-    from packaging.version import LegacyVersion
++    from packaging.version import Version
++
++    # Define a stub LegacyVersion for compatibility.
++    class LegacyVersion(Version):
++        def __init__(self, v):
++            super().__init__(v)
+ 
+ KEYBITS = 4096
+ CA_NAME = 'Self-Signed-CA'

gnu/system/install.scm

@@ -33,14 +33,8 @@
   #:use-module (guix store)
   #:use-module (guix modules)
   #:use-module ((guix packages) #:select (package-version supported-package?))
-  #:autoload   (guix channels) (channel? channel-commit)
   #:use-module (guix platform)
   #:use-module (guix utils)
-  #:use-module (guix packages)
-  #:use-module ((guix channels)
-                #:select (%default-guix-channel
-                          channel
-                          channel-commit))
   #:use-module (gnu installer)
   #:use-module (gnu system locale)
   #:use-module (gnu services avahi)
@@ -354,15 +348,6 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
     (define bare-bones-os
       (load "examples/bare-bones.tmpl"))
 
-    (define (guix-package-commit guix)
-      ;; Extract the commit of the GUIX package.
-      (match (package-source guix)
-        ((? channel? source)
-         (channel-commit source))
-        (_
-         (apply (lambda* (#:key commit #:allow-other-keys) commit)
-                (package-arguments guix)))))
-
     (append
      ;; Generic services
      (list (service virtual-terminal-service-type)
@@ -407,13 +392,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
 
                      ;; Install and run the current Guix rather than an older
                      ;; snapshot.
-                     (guix (let ((guix (current-guix)))
-                             (package
-                               (inherit guix)
-                               ;; Do not leak the local checkout URL.
-                               (source (channel
-                                        (inherit %default-guix-channel)
-                                        (commit (guix-package-commit guix)))))))))
+                     (guix (current-guix))))
 
            ;; Start udev so that useful device nodes are available.
            ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for

gnu/tests/base.scm

@@ -345,7 +345,7 @@ info --version")
               ;; after we switched to TTY1, we won't be able to login. Make
               ;; sure to wait long enough before switching to TTY1.
               (when #$desktop?
-                (sleep 30))
+                (sleep 60))
 
               (marionette-control "sendkey ctrl-alt-f1" marionette)
               ;; Wait for the 'term-tty1' service to be running (using

gnu/tests/mail.scm

@@ -99,8 +99,8 @@ match from any for local action inbound
 
           (test-assert "mbox is empty"
             (marionette-eval
-             '(and (file-exists? "/var/spool/mail")
-                   (not (file-exists? "/var/spool/mail/root")))
+             '(and (file-exists? "/var/mail")
+                   (not (file-exists? "/var/mail/root")))
              marionette))
 
           (test-eq "accept an email"
@@ -150,7 +150,7 @@ match from any for local action inbound
 
                 (let wait ((n 20))
                   (cond ((queue-empty?)
-                         (file-exists? "/var/spool/mail/root"))
+                         (file-exists? "/var/mail/root"))
                         ((zero? n)
                          (error "root mailbox didn't show up"))
                         (else

gnu/tests/version-control.scm

@@ -65,6 +65,12 @@
 
           (mkdir-p "/srv/git")
           (rename-file "/tmp/test-repo/.git" "/srv/git/test")
+          ;; Make sure that the gitile user can access the /srv/git directory
+          ;; and its child.
+          (let ((user (getpw "gitile")))
+            (for-each (lambda (dir)
+                        (chown dir (passwd:uid user) (passwd:gid user)))
+                      '("/srv/git" "/srv/git/test")))
           (with-output-to-file "/srv/git/test/git-daemon-export-ok"
             (lambda _
               (display "")))))))
@@ -280,6 +286,14 @@ HTTP-PORT."
           (test-equal "clone"
             '#$README-contents
             (begin
+              ;; Make sure that the fcgiwrap user can access the /srv/git
+              ;; directory and its child.
+              (marionette-eval
+               '(let ((user (getpw (pk "fcgiwrap"))))
+                  (for-each (lambda (dir)
+                              (chown dir (passwd:uid user) (passwd:gid user)))
+                            '("/srv/git" "/srv/git/test")))
+               marionette)
               (invoke #$(file-append git "/bin/git") "clone" "-v"
                       "http://localhost:8080/git/test" "/tmp/clone")
               (call-with-input-file "/tmp/clone/README"