diff options
author | Ludovic Courtès <ludo@gnu.org> | 2022-10-01 16:56:19 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2022-10-10 11:16:07 +0200 |
commit | b6bc4c109b807c646e99ec40360e681122d85b2c (patch) | |
tree | 02afbe98458dd5c23e057dbacb433d77d8072457 /guix/packages.scm | |
parent | 79b390a207adc70a1169c80e52c590d8b358f488 (diff) | |
download | guix-patches-b6bc4c109b807c646e99ec40360e681122d85b2c.tar guix-patches-b6bc4c109b807c646e99ec40360e681122d85b2c.tar.gz |
packages: Raise an exception for invalid 'license' values.
This is written in such a way that the type check turns into a no-op at
macro-expansion time for trivial cases:
> ,optimize (validate-license gpl3+)
$18 = gpl3+
> ,optimize (validate-license (list gpl3+ gpl2+))
$19 = (list gpl3+ gpl2+)
* guix/packages.scm (valid-license-value?, validate-license): New
macros.
(<package>)[license]: Add 'sanitize' option.
(&package-license-error): New error condition type.
* tests/packages.scm ("license type checking"): New test.
Diffstat (limited to 'guix/packages.scm')
-rw-r--r-- | guix/packages.scm | 40 |
1 files changed, 39 insertions, 1 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 94e464cd01..704b4ee710 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -41,6 +41,9 @@ #:use-module (guix search-paths) #:use-module (guix sets) #:use-module (guix deprecation) + #:use-module ((guix diagnostics) + #:select (formatted-message define-with-syntax-properties)) + #:autoload (guix licenses) (license?) #:use-module (guix i18n) #:use-module (ice-9 match) #:use-module (ice-9 vlist) @@ -159,6 +162,8 @@ &package-error package-error? package-error-package + package-license-error? + package-error-invalid-license &package-input-error package-input-error? package-error-invalid-input @@ -533,6 +538,34 @@ Texinfo. Otherwise, return the string." ((_ obj) #'obj))))) +(define-syntax valid-license-value? + (syntax-rules (list package-license) + "Return #t if the given value is a valid license field, #f otherwise." + ;; Arrange so that the answer can be given at macro-expansion time in the + ;; most common cases. + ((_ (list x ...)) + (and (license? x) ...)) + ((_ (package-license _)) + #t) + ((_ obj) + (or (license? obj) + ;; Note: Avoid 'not' below due to <https://bugs.gnu.org/58217>. + (eq? #f obj) ;#f is considered valid + (let ((x obj)) + (and (pair? x) (every license? x))))))) + +(define-with-syntax-properties (validate-license (value properties)) + (unless (valid-license-value? value) + (raise + (make-compound-condition + (condition + (&error-location + (location (source-properties->location properties)))) + (condition + (&package-license-error (package #f) (license value))) + (formatted-message (G_ "~s: invalid package license~%") value)))) + value) + ;; A package. (define-record-type* <package> package make-package @@ -574,7 +607,8 @@ Texinfo. Otherwise, return the string." (sanitize validate-texinfo)) ; one-line description (description package-description (sanitize validate-texinfo)) ; one or two paragraphs - (license package-license) ; (list of) <license> + (license package-license ; (list of) <license> + (sanitize validate-license)) (home-page package-home-page) (supported-systems package-supported-systems ; list of strings (default %supported-systems)) @@ -737,6 +771,10 @@ exist, return #f instead." package-error? (package package-error-package)) +(define-condition-type &package-license-error &package-error + package-license-error? + (license package-error-invalid-license)) + (define-condition-type &package-input-error &package-error package-input-error? (input package-error-invalid-input)) |