diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2024-01-26 14:41:37 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2024-02-12 12:03:53 +0100 |
| commit | 29f3089c841f00144f24f5c32296aebf22d752cc (patch) | |
| tree | 097248568c3a7a737be1d210e02fd03fb9111f1f | |
| parent | 1b72e1430794fd09bb2be1d72f482a40c0f9196e (diff) | |
| download | guix-29f3089c841f00144f24f5c32296aebf22d752cc.tar.gz guix-29f3089c841f00144f24f5c32296aebf22d752cc.zip | |
lint: archival: Check with ‘lookup-directory-by-nar-hash’.
While this method is new and nar-sha256 ExtIDs are currently available
only for new visits, it is fundamentally more reliable than the other
methods, which is why it comes first.
* guix/lint.scm (check-archival)[lookup-by-nar-hash]: New procedure.
Call ‘lookup-by-nar-hash’ before the other lookup methods.
* tests/lint.scm ("archival: content available")
("archival: content unavailable but disarchive available")
("archival: missing revision")
("archival: revision available"): Add a 404 response corresponding to
the ‘lookup-external-id’ request.
* tests/lint.scm ("archival: nar-sha256 extid available"): New test.
Change-Id: I4a81d6e022a3b72e6484726549d7fbae627f8e73
| -rw-r--r-- | guix/lint.scm | 30 | ||||
| -rw-r--r-- | tests/lint.scm | 33 |
2 files changed, 47 insertions, 16 deletions
diff --git a/guix/lint.scm b/guix/lint.scm index 861e352b93..c95de85e69 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org> -;;; Copyright © 2013-2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> @@ -1658,24 +1658,31 @@ try again later") (or (not (request-rate-limit-reached? url method)) (throw skip-key #t))) + (define (lookup-by-nar-hash hash) + (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?) + ((and (? origin? origin) (= origin-uri (? git-reference? reference))) (define url (git-reference-url reference)) (define commit (git-reference-commit reference)) - - (match (if (commit-id? commit) - (or (lookup-revision commit) - (lookup-origin-revision url commit)) - (lookup-origin-revision url commit)) - ((? revision? revision) + (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. @@ -1704,9 +1711,10 @@ try again later") (if (and=> (origin-hash origin) ;XXX: for ungoogled-chromium content-hash-value) ;& icecat (let ((hash (origin-hash origin))) - (match (lookup-content (content-hash-value hash) - (symbol->string - (content-hash-algorithm hash))) + (match (or (lookup-by-nar-hash hash) + (lookup-content (content-hash-value hash) + (symbol->string + (content-hash-algorithm hash)))) (#f ;; If SWH doesn't have HASH as is, it may be because it's ;; a hand-crafted tarball. In that case, check whether diff --git a/tests/lint.scm b/tests/lint.scm index a52a82237b..87213fcc78 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com> ;;; Copyright © 2014, 2015, 2016 Eric Bavier <bavier@member.fsf.org> -;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014-2024 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org> ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com> ;;; Copyright © 2017 Alex Kost <alezost@gmail.com> @@ -1358,7 +1358,8 @@ ;; https://archive.softwareheritage.org/api/1/content/ (content "{ \"checksums\": {}, \"data_url\": \"xyz\", \"length\": 42 }")) - (with-http-server `((200 ,content)) + (with-http-server `((404 "") ;extid + (200 ,content)) (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) @@ -1378,7 +1379,8 @@ \"type\": \"file\", \"name\": \"README\" \"length\": 42 } ]")) - (with-http-server `((404 "") ;lookup-content + (with-http-server `((404 "") ;lookup-directory-by-nar-hash + (404 "") ;lookup-content (200 ,disarchive) ;Disarchive database lookup (200 ,directory)) ;lookup-directory (mock ((guix download) %disarchive-mirrors (list (%local-url))) @@ -1397,7 +1399,8 @@ \"save_request_date\": \"2014-11-17T22:09:38+01:00\", \"save_request_status\": \"accepted\", \"save_task_status\": \"scheduled\" }") - (warnings (with-http-server `((404 "No revision.") ;lookup-revision + (warnings (with-http-server `((404 "No extid.") ;lookup-directory-by-nar-hash + (404 "No revision.") ;lookup-revision (404 "No origin.") ;lookup-origin (200 ,save)) ;save-origin (parameterize ((%swh-base-url (%local-url))) @@ -1415,7 +1418,27 @@ ;; https://archive.softwareheritage.org/api/1/revision/ (revision "{ \"author\": {}, \"parents\": [], \"date\": \"2014-11-17T22:09:38+01:00\" }")) - (with-http-server `((200 ,revision)) + (with-http-server `((404 "No directory.") ;lookup-directory-by-nar-hash + (200 ,revision)) + (parameterize ((%swh-base-url (%local-url))) + (check-archival (dummy-package "x" (source origin))))))) + +(test-equal "archival: nar-sha256 extid available" + '() + (let* ((origin (origin + (method git-fetch) + (uri (git-reference + (url "http://example.org/foo.git") + (commit "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))) + (sha256 (make-bytevector 32)))) + ;; https://archive.softwareheritage.org/api/1/extid/doc/ + (extid "{ \"extid_type\": \"nar-sha256\", + \"extid\": \"1234\", + \"extid_version\": 0, + \"target\": \"swh:1:dir:cabba93\", + \"target_url\": \"boo\" + }")) + (with-http-server `((200 ,extid)) (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) |