kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

hg-download: Support falling back to SWH.

Browse Source 
* 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
1 changed files with 28 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
guix/hg-download.scm
View File

@ -66,6 +66,13 @@
"Return a fixed-output derivation that fetches REF, a <hg-reference> "Return a fixed-output derivation that fetches REF, a <hg-reference>
object. The output is expected to have recursive hash HASH of type 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." 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 (define guile-zlib
(module-ref (resolve-interface '(gnu packages guile)) '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 (define modules
(delete '(guix config) (delete '(guix config)
(source-module-closure '((guix build hg) (source-module-closure '((guix build hg)
(guix build download-nar))))) (guix build download-nar)
(guix swh)))))
(define build (define build
(with-imported-modules modules (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) guile-zlib)
#~(begin #~(begin
(use-modules (guix build hg) (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) (or (hg-fetch '#$(hg-reference-url ref)
'#$(hg-reference-changeset ref) '#$(hg-reference-changeset ref)
#$output #$output
#:hg-command (string-append #+hg "/bin/hg")) #: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))) (mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "hg-checkout") build (gexp->derivation (or name "hg-checkout") build