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
This commit is contained in:
Ludovic Courtès 2024-01-26 14:41:37 +01:00
parent 1b72e14307
commit 29f3089c84
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 46 additions and 15 deletions

View file

@ -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))
(define hash
(origin-hash origin))
(match (if (commit-id? commit)
(or (lookup-revision commit)
(lookup-origin-revision url commit))
(lookup-origin-revision url commit))
((? revision? revision)
(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