From 8cb162bcde91d3b39453de576caadb9a6f8f8733 Mon Sep 17 00:00:00 2001 Message-ID: <8cb162bcde91d3b39453de576caadb9a6f8f8733.1718990517.git.zimon.toutoune@gmail.com> From: Simon Tournier Date: Fri, 21 Jun 2024 19:17:57 +0200 Subject: [PATCH] guix: lint: Honor 'no-archival?' package property. * guix/lint.scm (check-archival): Skip the checker if the package is marked. * doc/guix.texi: Document it. Change-Id: I2e21b60ee4f02255f298740a2e9ebb1717e490ff --- doc/guix.texi | 15 ++++- guix/lint.scm | 154 ++++++++++++++++++++++++++------------------------ 2 files changed, 93 insertions(+), 76 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 769ca1399f..5c1cb89686 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -71,7 +71,7 @@ Copyright @copyright{} 2019 Alex Griffin@* Copyright @copyright{} 2019, 2020, 2021, 2022 Guillaume Le Vaillant@* Copyright @copyright{} 2020 Liliana Marie Prikler@* -Copyright @copyright{} 2019, 2020, 2021, 2022, 2023 Simon Tournier@* +Copyright @copyright{} 2019, 2020, 2021, 2022, 2023, 2024 Simon Tournier@* Copyright @copyright{} 2020 Wiktor Żelazny@* Copyright @copyright{} 2020 Damien Cassou@* Copyright @copyright{} 2020 Jakub Kądziołka@* @@ -15380,6 +15380,19 @@ Invoking guix lint prints a message and the @code{archival} checker stops doing anything until that limit has been reset. +Sometimes it is not desired to send a request for archiving each time +@command{guix lint} is run. The package might be marked to skip the +@code{archival} checker by honoring the @code{no-archival?} property in +package definition: + +@lisp +(define-public python-scikit-learn + (package + (name "python-scikit-learn") + ;; @dots{} + (properties '((no-archival? . #t))))) +@end lisp + @item cve @cindex security vulnerabilities @cindex CVE, Common Vulnerabilities and Exposures diff --git a/guix/lint.scm b/guix/lint.scm index 68d532968d..4c33ec6598 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1717,84 +1717,88 @@ (define (check-archival package) (lookup-directory-by-nar-hash (content-hash-value hash) (content-hash-algorithm hash))) - (parameterize ((%allow-request? skip-when-limit-reached)) - (catch #t - (lambda () - (match (package-source package) - (#f ;no source - '()) - ((and (? origin? origin) - (= origin-uri (? git-reference? reference))) - (define url - (git-reference-url reference)) - (define commit - (git-reference-commit reference)) - (define hash - (origin-hash origin)) - - (match (or (lookup-by-nar-hash hash) - (if (commit-id? commit) - (or (lookup-revision commit) - (lookup-origin-revision url commit)) - (lookup-origin-revision url commit))) - ((or (? string?) (? revision?)) - '()) - (#f - ;; Revision is missing from the archive, attempt to save it. - (save-package-source package)))) - ((? origin? origin) - (if (and=> (origin-hash origin) ;XXX: for ungoogled-chromium - content-hash-value) ;& icecat - (let ((hash (origin-hash origin))) - (match (or (lookup-by-nar-hash hash) - (lookup-content (content-hash-value hash) - (symbol->string - (content-hash-algorithm hash)))) - (#f - ;; If ORIGIN is a version-control checkout, save it now. - ;; If not, check whether HASH is in the Disarchive - ;; database ("Save Code Now" does not accept tarballs). - (if (vcs-origin origin) - (save-package-source package) - (match (lookup-disarchive-spec hash) - (#f - (list (make-warning package - (G_ "source not archived on Software \ + (if (not (assq 'no-archival? (package-properties package))) + (parameterize ((%allow-request? skip-when-limit-reached)) + (catch #t + (lambda () + (match (package-source package) + (#f ;no source + '()) + ((and (? origin? origin) + (= origin-uri (? git-reference? reference))) + (define url + (git-reference-url reference)) + (define commit + (git-reference-commit reference)) + (define hash + (origin-hash origin)) + + (match (or (lookup-by-nar-hash hash) + (if (commit-id? commit) + (or (lookup-revision commit) + (lookup-origin-revision url commit)) + (lookup-origin-revision url commit))) + ((or (? string?) (? revision?)) + '()) + (#f + ;; Revision is missing from the archive, attempt to save it. + (save-package-source package)))) + ((? origin? origin) + (if (and=> (origin-hash origin) ;XXX: for ungoogled-chromium + content-hash-value) ;& icecat + (let ((hash (origin-hash origin))) + (match (or (lookup-by-nar-hash hash) + (lookup-content (content-hash-value hash) + (symbol->string + (content-hash-algorithm hash)))) + (#f + ;; If ORIGIN is a version-control checkout, save it now. + ;; If not, check whether HASH is in the Disarchive + ;; database ("Save Code Now" does not accept tarballs). + (if (vcs-origin origin) + (save-package-source package) + (match (lookup-disarchive-spec hash) + (#f + (list (make-warning package + (G_ "source not archived on Software \ Heritage and missing from the Disarchive database") - #:field 'source))) - (directory-ids - (match (find (lambda (id) - (not (lookup-directory id))) - directory-ids) - (#f '()) - (id - (list (make-warning package - (G_ "\ + #:field 'source))) + (directory-ids + (match (find (lambda (id) + (not (lookup-directory id))) + directory-ids) + (#f '()) + (id + (list (make-warning package + (G_ "\ Disarchive entry refers to non-existent SWH directory '~a'") - (list id) - #:field 'source)))))))) - ((? content?) - '()) - ((? string? swhid) - '()))) - '())) - ((? local-file?) - '()) - (_ - (list (make-warning package - (G_ "\ + (list id) + #:field 'source)))))))) + ((? content?) + '()) + ((? string? swhid) + '()))) + '())) + ((? local-file?) + '()) + (_ + (list (make-warning package + (G_ "\ source is not an origin, it cannot be archived") - #:field 'source))))) - (match-lambda* - (('swh-error url method response) - (swh-response->warning package url method response)) - ((key . args) - (if (eq? key skip-key) - '() - (with-networking-fail-safe - (G_ "while connecting to Software Heritage") - '() - (apply throw key args)))))))) + #:field 'source))))) + (match-lambda* + (('swh-error url method response) + (swh-response->warning package url method response)) + ((key . args) + (if (eq? key skip-key) + '() + (with-networking-fail-safe + (G_ "while connecting to Software Heritage") + '() + (apply throw key args))))))) + (list + (make-warning package + (G_ "skip archiving as marked by package"))))) (define (check-haskell-stackage package) "Check whether PACKAGE is a Haskell package ahead of the current base-commit: bc8a41f4a8d9f1f0525d7bc97c67ed3c8aea3111 -- 2.41.0