me
/
guix
Archived
1
0
Fork 0
Code

services: configuration: Report the location of field type errors. 

Previously field type errors would be reported in a non-standard way,
and without any source location information.  This fixes it.

* gnu/services/configuration.scm (configuration-field-error): Add a
'loc' parameter and honor it.  Use 'formatted-message' instead of plain
'format'.
(define-configuration-helper)[field-sanitizer]: New procedure.
Use it.  Use STEM as the identifier of the syntactic constructor of the
record type.  Add a 'sanitize' property to each field.  Remove now
useless STEM macro that would call 'validate-configuration'.
* gnu/services/mail.scm (serialize-listener-configuration): Adjust to
new 'configuration-field-error' prototype.
* tests/services/configuration.scm ("wrong type for a field"): New test.
* po/guix/POTFILES.in: Add gnu/services/configuration.scm.
Ludovic Courtès 2022-06-18 22:37:20 +02:00
parent 43137d058f
commit fb7e6ccba7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 58 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
gnu/services/configuration.scm
View File

@ -27,7 +27,8 @@
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module ((guix utils) #:select (source-properties->location))
#:use-module ((guix diagnostics) #:select (formatted-message location-file))
#:use-module ((guix diagnostics)
#:select (formatted-message location-file &error-location))
#:use-module ((guix modules) #:select (file-name->module-name))
#:use-module (guix i18n)
#:autoload (texinfo) (texi-fragment->stexi)
@ -87,9 +88,17 @@
(define (configuration-error message)
(raise (condition (&message (message message))
(&configuration-error))))
(define (configuration-field-error field val)
(configuration-error
(format #f "Invalid value for field ~a: ~s" field val)))
(define (configuration-field-error loc field value)
(raise (apply
make-compound-condition
(formatted-message (G_ "invalid value ~s for field '~a'")
value field)
(condition (&configuration-error))
(if loc
(list (condition
(&error-location (location loc))))
'()))))
(define (configuration-missing-field kind field)
(configuration-error
(format #f "~a configuration missing required field ~a" kind field)))
@ -210,9 +219,33 @@ does not have a default value" field kind)))
(id #'stem #'serialize- type))))))
#'(field-type ...)
#'((custom-serializer ...) ...))))
(define (field-sanitizer name pred)
;; Define a macro for use as a record field sanitizer, where NAME
;; is the name of the field and PRED is the predicate that tells
;; whether a value is valid for this field.
#`(define-syntax #,(id #'stem #'validate- #'stem #'- name)
(lambda (s)
;; Make sure the given VALUE, for field NAME, passes PRED.
(syntax-case s ()
((_ value)
(with-syntax ((name #'#,name)
(pred #'#,pred)
(loc (datum->syntax #'value
(syntax-source #'value))))
#'(if (pred value)
value
(configuration-field-error
(and=> 'loc source-properties->location)
'name value))))))))
#`(begin
;; Define field validation macros.
#,@(map field-sanitizer
#'(field ...)
#'(field-predicate ...))
(define-record-type* #,(id #'stem #'< #'stem #'>)
#,(id #'stem #'% #'stem)
stem
#,(id #'stem #'make- #'stem)
#,(id #'stem #'stem #'?)
(%location #,(id #'stem #'stem #'-location)
@ -220,10 +253,13 @@ does not have a default value" field kind)))
source-properties->location))
(innate))
#,@(map (lambda (name getter def)
#`(#,name #,getter (default #,def)))
#`(#,name #,getter (default #,def)
(sanitize
#,(id #'stem #'validate- #'stem #'- name))))
#'(field ...)
#'(field-getter ...)
#'(field-default ...)))
(define #,(id #'stem #'stem #'-fields)
(list (configuration-field
(name 'field)
@ -240,12 +276,7 @@ does not have a default value" field kind)))
'#,(id #'stem #'% #'stem) 'field)
field-default)))
(documentation doc))
...))
(define-syntax-rule (stem arg (... ...))
(let ((conf (#,(id #'stem #'% #'stem) arg (... ...))))
(validate-configuration conf
#,(id #'stem #'stem #'-fields))
conf))))))))
...))))))))
(define no-serialization ;syntactic keyword for 'define-configuration'
'(no serialization))

2
gnu/services/mail.scm
View File

@ -285,7 +285,7 @@ the section name.")
(serialize-fifo-listener-configuration field-name val))
((inet-listener-configuration? val)
(serialize-inet-listener-configuration field-name val))
(else (configuration-field-error field-name val))))
(else (configuration-field-error #f field-name val))))
(define (listener-configuration-list? val)
(and (list? val) (and-map listener-configuration? val)))
(define (serialize-listener-configuration-list field-name val)

1
po/guix/POTFILES.in
View File

@ -4,6 +4,7 @@ gnu.scm
gnu/packages.scm
gnu/services.scm
gnu/system.scm
gnu/services/configuration.scm
gnu/services/shepherd.scm
gnu/home/services.scm
gnu/home/services/ssh.scm

13
tests/services/configuration.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,6 +20,7 @@
(define-module (tests services configuration)
#:use-module (gnu services configuration)
#:use-module (guix diagnostics)
#:use-module (guix gexp)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64))
@ -43,6 +45,17 @@
80
(port-configuration-port (port-configuration)))
(test-equal "wrong type for a field"
'("configuration.scm" 57 11) ;error location
(guard (c ((configuration-error? c)
(let ((loc (error-location c)))
(list (basename (location-file loc))
(location-line loc)
(location-column loc)))))
(port-configuration
;; This is line 56; the test relies on line/column numbers!
(port "This is not a number!"))))
(define-configuration port-configuration-cs
(port (number 80) "The port number." empty-serializer))