diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2024-02-23 21:22:55 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2024-03-22 11:40:33 +0100 |
| commit | 29de2edfbbed21ac016f73a45d399795fc2e4dfb (patch) | |
| tree | 54db192b7526446c974cdb317d753694e32cd19b | |
| parent | b5018807ee4b09962507b67f7506cbdc70d6c810 (diff) | |
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
| -rw-r--r-- | gnu/home.scm | 5 | ||||
| -rw-r--r-- | gnu/services.scm | 19 | ||||
| -rw-r--r-- | gnu/system.scm | 5 |
3 files changed, 24 insertions, 5 deletions
diff --git a/gnu/home.scm b/gnu/home.scm index 2fefe7ba53c..b390c8d5348 100644 --- a/gnu/home.scm +++ b/gnu/home.scm | |||
| @@ -1,6 +1,6 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> | 2 | ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> |
| 3 | ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org> | 3 | ;;; Copyright © 2022, 2024 Ludovic Courtès <ludo@gnu.org> |
| 4 | ;;; | 4 | ;;; |
| 5 | ;;; This file is part of GNU Guix. | 5 | ;;; This file is part of GNU Guix. |
| 6 | ;;; | 6 | ;;; |
| @@ -67,7 +67,8 @@ | |||
| 67 | this-home-environment))) | 67 | this-home-environment))) |
| 68 | 68 | ||
| 69 | (services home-environment-user-services | 69 | (services home-environment-user-services |
| 70 | (default '())) | 70 | (default '()) |
| 71 | (sanitize validate-service-list)) | ||
| 71 | 72 | ||
| 72 | (location home-environment-location ; <location> | 73 | (location home-environment-location ; <location> |
| 73 | (default (and=> (current-source-location) | 74 | (default (and=> (current-source-location) |
diff --git a/gnu/services.scm b/gnu/services.scm index 59481af10f3..88593e80913 100644 --- a/gnu/services.scm +++ b/gnu/services.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2015-2024 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> | 3 | ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> |
| 4 | ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 4 | ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> |
| 5 | ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> | 5 | ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net> |
| @@ -91,6 +91,8 @@ | |||
| 91 | for-home | 91 | for-home |
| 92 | for-home? | 92 | for-home? |
| 93 | 93 | ||
| 94 | validate-service-list | ||
| 95 | |||
| 94 | service-error? | 96 | service-error? |
| 95 | missing-value-service-error? | 97 | missing-value-service-error? |
| 96 | missing-value-service-error-type | 98 | missing-value-service-error-type |
| @@ -1271,4 +1273,19 @@ Home service rather than a System service." | |||
| 1271 | (syntax-parameterize ((for-home? (identifier-syntax #t))) | 1273 | (syntax-parameterize ((for-home? (identifier-syntax #t))) |
| 1272 | exp ...)) | 1274 | exp ...)) |
| 1273 | 1275 | ||
| 1276 | (define-with-syntax-properties (validate-service-list (value properties)) | ||
| 1277 | (%validate-service-list value properties)) | ||
| 1278 | |||
| 1279 | (define (%validate-service-list value properties) | ||
| 1280 | (match value | ||
| 1281 | (((? service?) ...) value) | ||
| 1282 | (_ | ||
| 1283 | (raise | ||
| 1284 | (make-compound-condition | ||
| 1285 | (condition | ||
| 1286 | (&error-location | ||
| 1287 | (location (source-properties->location properties)))) | ||
| 1288 | (formatted-message | ||
| 1289 | (G_ "'services' field must contain a list of services"))))))) | ||
| 1290 | |||
| 1274 | ;;; services.scm ends here. | 1291 | ;;; services.scm ends here. |
diff --git a/gnu/system.scm b/gnu/system.scm index aede35775ef..aef81d8ccfa 100644 --- a/gnu/system.scm +++ b/gnu/system.scm | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | ;;; GNU Guix --- Functional package management for GNU | 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org> | 2 | ;;; Copyright © 2013-2022, 2024 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> | 3 | ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> |
| 4 | ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> | 4 | ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com> |
| 5 | ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> | 5 | ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> |
| @@ -294,7 +294,8 @@ VERSION is the target version of the boot-parameters record." | |||
| 294 | this-operating-system))) | 294 | this-operating-system))) |
| 295 | (services operating-system-user-services ; list of services | 295 | (services operating-system-user-services ; list of services |
| 296 | (thunked) ;allow for system-dependent services | 296 | (thunked) ;allow for system-dependent services |
| 297 | (default %base-services)) | 297 | (default %base-services) |
| 298 | (sanitize validate-service-list)) | ||
| 298 | 299 | ||
| 299 | (pam-services operating-system-pam-services ; list of PAM services | 300 | (pam-services operating-system-pam-services ; list of PAM services |
| 300 | (default (base-pam-services))) | 301 | (default (base-pam-services))) |
