hg-download: Support falling back to SWH.

* guix/hg-download.scm (hg-fetch): Fall back to fetching the source from SWH
if the upstream source is missing.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Xinglu Chen 2021-06-12 13:57:22 +02:00 committed by Ludovic Courtès
parent c4ff492879
commit 69d7333217
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

@ -66,6 +66,13 @@
"Return a fixed-output derivation that fetches REF, a <hg-reference>
object. The output is expected to have recursive hash HASH of type
HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
(define inputs
;; The 'swh-download' procedure requires tar and gzip.
`(("gzip" ,(module-ref (resolve-interface '(gnu packages compression))
'gzip))
("tar" ,(module-ref (resolve-interface '(gnu packages base))
'tar))))
(define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) 'guile-zlib))
@ -78,7 +85,8 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
(define modules
(delete '(guix config)
(source-module-closure '((guix build hg)
(guix build download-nar)))))
(guix build download-nar)
(guix swh)))))
(define build
(with-imported-modules modules
@ -86,13 +94,30 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
guile-zlib)
#~(begin
(use-modules (guix build hg)
(guix build download-nar))
(guix build utils) ;for `set-path-environment-variable'
(guix build download-nar)
(guix swh)
(ice-9 match))
(set-path-environment-variable "PATH" '("bin")
(match '#+inputs
(((names dirs outputs ...) ...)
dirs)))
(or (hg-fetch '#$(hg-reference-url ref)
'#$(hg-reference-changeset ref)
#$output
#:hg-command (string-append #+hg "/bin/hg"))
(download-nar #$output))))))
(download-nar #$output)
;; As a last resort, attempt to download from Software Heritage.
;; Disable X.509 certificate verification to avoid depending
;; on nss-certs--we're authenticating the checkout anyway.
(parameterize ((%verify-swh-certificate? #f))
(format (current-error-port)
"Trying to download from Software Heritage...~%")
(swh-download #$(hg-reference-url ref)
#$(hg-reference-changeset ref)
#$output)))))))
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "hg-checkout") build