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
master
Ludovic Courtès
parent
1b72e14307
commit
29f3089c84
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
|
||||
|
|
|
|||
Reference in New Issue