system, home: Validate ‘services’ field value.

This guides newcomers who might stick a single (service …) form
in this field.

* gnu/services.scm (validate-service-list): New macro.
(%validate-service-list): New procedure.
* gnu/system.scm (<operating-system>)[services]: Add ‘sanitize’.
* gnu/home.scm (<home-environment>)[services]: Add ‘sanitize’.

Change-Id: I9e29bd9a078e87b627ab766fd669ba9de79f8473
This commit is contained in:
Ludovic Courtès 2024-02-23 21:22:55 +01:00
parent b5018807ee
commit 29de2edfbb
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 24 additions and 5 deletions

View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in>
;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -67,7 +67,8 @@ (define-record-type* <home-environment> home-environment
this-home-environment))) this-home-environment)))
(services home-environment-user-services (services home-environment-user-services
(default '())) (default '())
(sanitize validate-service-list))
(location home-environment-location ; <location> (location home-environment-location ; <location>
(default (and=> (current-source-location) (default (and=> (current-source-location)

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
@ -91,6 +91,8 @@ (define-module (gnu services)
for-home for-home
for-home? for-home?
validate-service-list
service-error? service-error?
missing-value-service-error? missing-value-service-error?
missing-value-service-error-type missing-value-service-error-type
@ -1271,4 +1273,19 @@ (define-syntax-rule (for-home exp ...)
(syntax-parameterize ((for-home? (identifier-syntax #t))) (syntax-parameterize ((for-home? (identifier-syntax #t)))
exp ...)) exp ...))
(define-with-syntax-properties (validate-service-list (value properties))
(%validate-service-list value properties))
(define (%validate-service-list value properties)
(match value
(((? service?) ...) value)
(_
(raise
(make-compound-condition
(condition
(&error-location
(location (source-properties->location properties))))
(formatted-message
(G_ "'services' field must contain a list of services")))))))
;;; services.scm ends here. ;;; services.scm ends here.

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013-2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
@ -294,7 +294,8 @@ (define-record-type* <operating-system> operating-system
this-operating-system))) this-operating-system)))
(services operating-system-user-services ; list of services (services operating-system-user-services ; list of services
(thunked) ;allow for system-dependent services (thunked) ;allow for system-dependent services
(default %base-services)) (default %base-services)
(sanitize validate-service-list))
(pam-services operating-system-pam-services ; list of PAM services (pam-services operating-system-pam-services ; list of PAM services
(default (base-pam-services))) (default (base-pam-services)))