From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms5.migadu.com with LMTPS id 0JI+GDdpOGOcKgAAbAwnHQ (envelope-from ) for ; Sat, 01 Oct 2022 18:22:15 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id IAhMGDdpOGOBfAAAauVa8A (envelope-from ) for ; Sat, 01 Oct 2022 18:22:15 +0200 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id EA00F16683 for ; Sat, 1 Oct 2022 18:22:14 +0200 (CEST) Received: from localhost ([::1]:35400 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oefFl-0005lO-Nq for larch@yhetil.org; Sat, 01 Oct 2022 12:22:13 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:33294) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oefFc-0005kw-Ae for guix-patches@gnu.org; Sat, 01 Oct 2022 12:22:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46556) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oefFa-00060i-UQ for guix-patches@gnu.org; Sat, 01 Oct 2022 12:22:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oefFa-0003oG-QS for guix-patches@gnu.org; Sat, 01 Oct 2022 12:22:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#58231] [PATCH 2/2] packages: Raise an exception for invalid 'license' values. Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 01 Oct 2022 16:22:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58231 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 58231@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 58231-submit@debbugs.gnu.org id=B58231.166464127514582 (code B ref 58231); Sat, 01 Oct 2022 16:22:02 +0000 Received: (at 58231) by debbugs.gnu.org; 1 Oct 2022 16:21:15 +0000 Received: from localhost ([127.0.0.1]:45633 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oefEp-0003n7-FV for submit@debbugs.gnu.org; Sat, 01 Oct 2022 12:21:15 -0400 Received: from eggs.gnu.org ([209.51.188.92]:60684) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oefEn-0003mj-NT for 58231@debbugs.gnu.org; Sat, 01 Oct 2022 12:21:14 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:46414) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1oefEi-0005wq-80; Sat, 01 Oct 2022 12:21:08 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:References:In-Reply-To:Date:Subject:To: From; bh=I2nmzHNK9HXGeBXQ3+ODQXEZ49PlbKednOcnPUpGNtE=; b=LxxvMVSWe+S3S1lZXQir 6hsbyK+7ssC2FyPEtJhldfkryF12P9XJY3duGZ2n8/kbF2BieJSwh1ATYM46fu+lBLUJrYlFcn0Nt 9sQ7pJJIEW7rmB3ZR2jKnp2iLh/CSQybAHW8Zr8u+WioauYS6iTk6uBDFG2peI30sXuMUtqgw8VmH 4gHianNbTibfAk1Z8tB/5byji09xhAjduPfWCfGXEzOBTyougS0I0DziQinUsUAwywBPcES7TNJnJ k1hDvGriQ+vTSDPGeSW91vRmOyB6fjCNn+1GMTgDEvu815sTgNVR4sex6pInJ2j47MX5AVfhZ9usI jWelwbNv1P7ZUA==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:58544 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oefEh-00088x-QX; Sat, 01 Oct 2022 12:21:08 -0400 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Date: Sat, 1 Oct 2022 18:20:58 +0200 Message-Id: <20221001162058.8214-2-ludo@gnu.org> X-Mailer: git-send-email 2.37.3 In-Reply-To: <20221001162058.8214-1-ludo@gnu.org> References: <20221001162058.8214-1-ludo@gnu.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1664641335; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=I2nmzHNK9HXGeBXQ3+ODQXEZ49PlbKednOcnPUpGNtE=; b=tV+GH90jx6/cBsNuEX6/rmZqU2gwDfcliQZ8PmbCPX83DqXFLm4+CXEqynw7Jrd13mfL+t 7dkAci90ueFZDRPbrvfNcHV85OXsMscZ8MguTvrskhdR8oWUAG9s55BJOVZehyK7cja1fJ JqF7Brlc2sWSHoesuJa1wt7mqAGg6tSUzRe1HV60PNXlfWJvYLJWzepTX4mJvifpQD4I/m EA00wAW2NgDsshB8mEmrTMaOThbkUR3VYi4y6BbVx7Gm5+keXHaeaMMScFWEk6ojgLFscz U8KyVTjtcPnUxoVzZKAjU3P5LcWSNu1fQZva6icF2Hwt7EUFWYNJGQDftJ4u1A== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1664641335; a=rsa-sha256; cv=none; b=hSEl00gL82AEhNe06iCBwxViH9QzmxAwJmnzDf9tL+TS0A9cUVXjlTl1P+m7yBZTvLIUuy fpS9xn7xj6rx50PdpAgY203TUmqV6CUgskgw5febWaCiNWJ5Jol5VLaxZV3o2o8qZ+7HqT 8bk6hs6OXndeVK0cYXjDuUs0Qrn83/ipjZAzAEs7RZEOXugSZAmcU0auu3/7t1WLokxxtv GpJkOgoKi7TZDJ5zfunu1HmN0b9MY5873EfrKNfiWH4lb6VEuk5PzYk0IfGWTUoypHU/O2 r+1zQ9xT5dbhR7+mj3/yy0AuChxYpKSt2cGXXniBWek9cFXBd+rJYnRCR/KAAA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=LxxvMVSW; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -1.84 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=gnu.org header.s=fencepost-gnu-org header.b=LxxvMVSW; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: EA00F16683 X-Spam-Score: -1.84 X-Migadu-Scanner: scn0.migadu.com X-TUID: s/fPVmzM74C7 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. ()[license]: Add 'sanitize' option. (&package-license-error): New error condition type. * tests/packages.scm ("license type checking"): New test. --- guix/packages.scm | 40 +++++++++++++++++++++++++++++++++++++++- tests/packages.scm | 7 +++++++ 2 files changed, 46 insertions(+), 1 deletion(-) 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 @@ (define-module (guix packages) #: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 @@ (define-module (guix packages) &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 @@ (define ensure-thread-safe-texinfo-parser! ((_ 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 . + (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 make-package @@ -574,7 +607,8 @@ (define-record-type* (sanitize validate-texinfo)) ; one-line description (description package-description (sanitize validate-texinfo)) ; one or two paragraphs - (license package-license) ; (list of) + (license package-license ; (list of) + (sanitize validate-license)) (home-page package-home-page) (supported-systems package-supported-systems ; list of strings (default %supported-systems)) @@ -737,6 +771,10 @@ (define-condition-type &package-error &error 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)) diff --git a/tests/packages.scm b/tests/packages.scm index 6cbc34ba0b..dc03b13417 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -94,6 +94,13 @@ (define %store (write (dummy-package "foo" (location #f))))))) +(test-equal "license type checking" + 'bad-license + (guard (c ((package-license-error? c) + (package-error-invalid-license c))) + (dummy-package "foo" + (license 'bad-license)))) + (test-assert "hidden-package" (and (hidden-package? (hidden-package (dummy-package "foo"))) (not (hidden-package? (dummy-package "foo"))))) -- 2.37.3