amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: Adjust tests for ‘shepherd-system-log-service-type’.

Browse source 
This is a followup to 8492a3c896.

* gnu/services/virtualization.scm (%minimal-vm-syslog-config): Remove.
(%system-log-message-destination): New variable.
(%virtual-build-machine-operating-system): Use it, and modify
‘shepherd-system-log-service-type’ instead of ‘syslog-service-type’.
* gnu/tests/base.scm (%avahi-os): Likewise.
* gnu/tests/install.scm (%syslog-conf): Remove.
(operating-system-with-console-syslog): Modify
‘shepherd-system-log-service-type’ instead of ‘syslog-service-type’.
* gnu/tests/nfs.scm (%nfs-os, run-nfs-full-test): Likewise.
* gnu/tests/reconfigure.scm (run-kexec-test): Likewise.

Change-Id: I142d34ad27594a538f5b75daf087e48c690171b8
This commit is contained in:
Ludovic Courtès 2025-03-10 00:21:26 +01:00
parent ac26813108
commit d0510dcd82
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 63 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

35
gnu/services/virtualization.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com> ;;; Copyright © 2017 Ryan Moe <ryan.moe@gmail.com>
;;; Copyright © 2018, 2020-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018, 2020-2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020, 2021, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2020, 2021, 2023, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si> ;;; Copyright © 2021 Timotej Lazar <timotej.lazar@araneo.si>
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com> ;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
@ -1289,17 +1289,20 @@ that will be listening to receive secret keys on ADDRESS."
(_ #f)) (_ #f))
(virtual-build-machine-port-forwardings config))) (virtual-build-machine-port-forwardings config)))
(define %minimal-vm-syslog-config (define %system-log-message-destination
;; Minimal syslog configuration for a VM. ;; Shepherd system log message destination procedure. Log most messages to
(plain-file "vm-syslog.conf" "\ ;; the console, which goes to the serial output, allowing the host to log
# Log most messages to the console, which goes to the serial ;; it.
# output, allowing the host to log it. #~(lambda (message)
*.info;auth.notice;authpriv.none -/dev/console (cond ((= (system-log-priority debug)
(system-log-message-priority message))
# The rest. '("/var/log/debug"))
*.=debug -/var/log/debug ((member (system-log-message-facility message)
authpriv.*;auth.info /var/log/secure (list (system-log-facility authorization)
")) (system-log-facility authorization/private)))
'("/var/log/secure"))
(else
'("/dev/console")))))
(define %virtual-build-machine-operating-system (define %virtual-build-machine-operating-system
(operating-system (operating-system
@ -1349,10 +1352,10 @@ authpriv.*;auth.info /var/log/secure
(inherit config) (inherit config)
(authorize-key? #f) (authorize-key? #f)
(use-substitutes? #f))) (use-substitutes? #f)))
(syslog-service-type config => (shepherd-system-log-service-type
(syslog-configuration config =>
(config-file (system-log-configuration
%minimal-vm-syslog-config))) (message-destination %system-log-message-destination)))
(delete mingetty-service-type) (delete mingetty-service-type)
(delete console-font-service-type)))))) (delete console-font-service-type))))))

14
gnu/tests/base.scm
View file

@ -984,14 +984,12 @@ non-ASCII names from /tmp.")
(inherit config) (inherit config)
(debug-level 3) (debug-level 3)
(log-file "/dev/console"))) (log-file "/dev/console")))
(syslog-service-type config (shepherd-system-log-service-type
=> config
(syslog-configuration =>
(inherit config) (system-log-configuration
(config-file (inherit config)
(plain-file (message-destination #~(const '("/dev/console"))))))))))
"syslog.conf"
"*.* /dev/console\n")))))))))
(define (run-nss-mdns-test) (define (run-nss-mdns-test)
;; Test resolution of '.local' names via libc. Start the marionette service ;; Test resolution of '.local' names via libc. Start the marionette service

35
gnu/tests/install.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016-2023, 2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017, 2019, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
@ -52,6 +52,7 @@
#:use-module (gnu packages xorg) #:use-module (gnu packages xorg)
#:use-module (gnu services desktop) #:use-module (gnu services desktop)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (gnu services shepherd)
#:use-module (gnu services xorg) #:use-module (gnu services xorg)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
@ -1783,27 +1784,25 @@ build (current-guix) and then store a couple of full system images.")
;;; Installation through the graphical interface. ;;; Installation through the graphical interface.
;;; ;;;
(define %syslog-conf
;; Syslog configuration that dumps to /dev/console, so we can see the
;; installer's messages during the test.
(computed-file "syslog.conf"
#~(begin
(copy-file #$%default-syslog.conf #$output)
(chmod #$output #o644)
(let ((port (open-file #$output "a")))
(display "\n*.info /dev/console\n" port)
#t))))
(define (operating-system-with-console-syslog os) (define (operating-system-with-console-syslog os)
"Return OS with a syslog service that writes to /dev/console." "Return OS with a syslog service that writes to /dev/console."
(operating-system (operating-system
(inherit os) (inherit os)
(services (modify-services (operating-system-user-services os) (services
(syslog-service-type config (modify-services (operating-system-user-services os)
=> (shepherd-system-log-service-type
(syslog-configuration config
(inherit config) =>
(config-file %syslog-conf))))))) (system-log-configuration
(inherit config)
(message-destination
#~(lambda (message)
(let ((destinations ((default-message-destination-procedure)
message)))
(if (<= (system-log-message-priority message)
(system-log-priority info))
(cons "/dev/console" destinations)
destinations))))))))))
(define %root-password "foo") (define %root-password "foo")

31
gnu/tests/nfs.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2017, 2020, 2021 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016-2017, 2020-2021, 2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 John Darrington <jmd@gnu.org> ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
@ -33,6 +33,7 @@
#:use-module (gnu services base) #:use-module (gnu services base)
#:use-module (gnu services nfs) #:use-module (gnu services nfs)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (gnu services shepherd)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
#:use-module (gnu packages onc-rpc) #:use-module (gnu packages onc-rpc)
#:use-module (gnu packages nfs) #:use-module (gnu packages nfs)
@ -170,14 +171,12 @@
(services (services
;; Enable debugging output. ;; Enable debugging output.
(modify-services (operating-system-user-services os) (modify-services (operating-system-user-services os)
(syslog-service-type config (shepherd-system-log-service-type
=> config
(syslog-configuration =>
(inherit config) (system-log-configuration
(config-file (inherit config)
(plain-file (message-destination #~(const '("/dev/console"))))))))))
"syslog.conf"
"*.* /dev/console\n")))))))))
(define (run-nfs-server-test) (define (run-nfs-server-test)
"Run a test of an OS running a service of NFS-SERVICE-TYPE." "Run a test of an OS running a service of NFS-SERVICE-TYPE."
@ -287,14 +286,12 @@ directories can be mounted.")
"*(rw,insecure,no_subtree_check,\ "*(rw,insecure,no_subtree_check,\
crossmnt,fsid=root,no_root_squash,insecure,async)"))))) crossmnt,fsid=root,no_root_squash,insecure,async)")))))
(modify-services (operating-system-user-services os) (modify-services (operating-system-user-services os)
(syslog-service-type config (shepherd-system-log-service-type
=> config
(syslog-configuration =>
(inherit config) (system-log-configuration
(config-file (inherit config)
(plain-file (message-destination #~(const '("/dev/console")))))))))
"syslog.conf"
"*.* /dev/console\n"))))))))
#:requirements '(nscd) #:requirements '(nscd)
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
(guix combinators))))) (guix combinators)))))

15
gnu/tests/reconfigure.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org> ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2024-2025 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -190,13 +190,12 @@ Shepherd (PID 1) by unloading obsolete services and loading new services."
(operating-system (operating-system
(inherit %simple-os) (inherit %simple-os)
(services (modify-services %base-services (services (modify-services %base-services
(syslog-service-type (shepherd-system-log-service-type
config => (syslog-configuration config
(inherit config) =>
(config-file (system-log-configuration
(plain-file (inherit config)
"syslog.conf" (message-destination #~(const '("/dev/console"))))))))
"*.* /dev/console\n")))))))
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
(guix combinators)))) (guix combinators))))