download: Use 'with-imported-modules'.

* guix/cvs-download.scm (cvs-fetch): Use 'with-imported-modules' instead
of the #:modules argument of 'gexp->derivation'.
* guix/download.scm (url-fetch): Likewise.
* guix/git-download.scm (git-fetch): Likewise.
* guix/hg-download.scm (hg-fetch): Likewise.
* guix/svn-download.scm (svn-fetch): Likewise.
This commit is contained in:
Ludovic Courtès 2016-07-12 00:56:37 +02:00
parent 99b231dee6
commit e9b046fdda
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 79 additions and 78 deletions

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in> ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; ;;;
@ -60,13 +60,15 @@ (define* (cvs-fetch ref hash-algo hash
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 build (define build
#~(begin (with-imported-modules '((guix build cvs)
(use-modules (guix build cvs)) (guix build utils))
(cvs-fetch '#$(cvs-reference-root-directory ref) #~(begin
'#$(cvs-reference-module ref) (use-modules (guix build cvs))
'#$(cvs-reference-revision ref) (cvs-fetch '#$(cvs-reference-root-directory ref)
#$output '#$(cvs-reference-module ref)
#:cvs-command (string-append #+cvs "/bin/cvs")))) '#$(cvs-reference-revision ref)
#$output
#:cvs-command (string-append #+cvs "/bin/cvs")))))
(mlet %store-monad ((guile (package->derivation guile system))) (mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "cvs-checkout") build (gexp->derivation (or name "cvs-checkout") build
@ -74,8 +76,6 @@ (define build
#:hash-algo hash-algo #:hash-algo hash-algo
#:hash hash #:hash hash
#:recursive? #t #:recursive? #t
#:modules '((guix build cvs)
(guix build utils))
#:guile-for-build guile #:guile-for-build guile
#:local-build? #t))) #:local-build? #t)))

View file

@ -286,33 +286,39 @@ (define need-gnutls?
(any https? url))))) (any https? url)))))
(define builder (define builder
#~(begin (with-imported-modules '((guix build download)
#+(if need-gnutls? (guix build utils)
(guix ftp-client)
(guix base32)
(guix base64))
#~(begin
#+(if need-gnutls?
;; Add GnuTLS to the inputs and to the load path. ;; Add GnuTLS to the inputs and to the load path.
#~(eval-when (load expand eval) #~(eval-when (load expand eval)
(set! %load-path (set! %load-path
(cons (string-append #+(gnutls-package) (cons (string-append #+(gnutls-package)
"/share/guile/site/" "/share/guile/site/"
(effective-version)) (effective-version))
%load-path))) %load-path)))
#~#t) #~#t)
(use-modules (guix build download) (use-modules (guix build download)
(guix base32)) (guix base32))
(let ((value-from-environment (lambda (variable) (let ((value-from-environment (lambda (variable)
(call-with-input-string (call-with-input-string
(getenv variable) (getenv variable)
read)))) read))))
(url-fetch (value-from-environment "guix download url") (url-fetch (value-from-environment "guix download url")
#$output #$output
#:mirrors (call-with-input-file #$%mirror-file read) #:mirrors (call-with-input-file #$%mirror-file read)
;; Content-addressed mirrors. ;; Content-addressed mirrors.
#:hashes (value-from-environment "guix download hashes") #:hashes
#:content-addressed-mirrors (value-from-environment "guix download hashes")
(primitive-load #$%content-addressed-mirror-file))))) #:content-addressed-mirrors
(primitive-load #$%content-addressed-mirror-file))))))
(let ((uri (and (string? url) (string->uri url)))) (let ((uri (and (string? url) (string->uri url))))
(if (or (and (string? url) (not uri)) (if (or (and (string? url) (not uri))
@ -325,11 +331,6 @@ (define builder
#:system system #:system system
#:hash-algo hash-algo #:hash-algo hash-algo
#:hash hash #:hash hash
#:modules '((guix build download)
(guix build utils)
(guix ftp-client)
(guix base32)
(guix base64))
;; Use environment variables and a fixed script ;; Use environment variables and a fixed script
;; name so there's only one script in store for ;; name so there's only one script in store for

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -68,23 +68,25 @@ (define inputs
'())) '()))
(define build (define build
#~(begin (with-imported-modules '((guix build git)
(use-modules (guix build git) (guix build utils))
(guix build utils) #~(begin
(ice-9 match)) (use-modules (guix build git)
(guix build utils)
(ice-9 match))
;; The 'git submodule' commands expects Coreutils, sed, ;; The 'git submodule' commands expects Coreutils, sed,
;; grep, etc. to be in $PATH. ;; grep, etc. to be in $PATH.
(set-path-environment-variable "PATH" '("bin") (set-path-environment-variable "PATH" '("bin")
(match '#+inputs (match '#+inputs
(((names dirs) ...) (((names dirs) ...)
dirs))) dirs)))
(git-fetch '#$(git-reference-url ref) (git-fetch '#$(git-reference-url ref)
'#$(git-reference-commit ref) '#$(git-reference-commit ref)
#$output #$output
#:recursive? '#$(git-reference-recursive? ref) #:recursive? '#$(git-reference-recursive? ref)
#:git-command (string-append #+git "/bin/git")))) #:git-command (string-append #+git "/bin/git")))))
(mlet %store-monad ((guile (package->derivation guile system))) (mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "git-checkout") build (gexp->derivation (or name "git-checkout") build
@ -93,8 +95,6 @@ (define build
#:hash-algo hash-algo #:hash-algo hash-algo
#:hash hash #:hash hash
#:recursive? #t #:recursive? #t
#:modules '((guix build git)
(guix build utils))
#:guile-for-build guile #:guile-for-build guile
#:local-build? #t))) #:local-build? #t)))

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -60,15 +60,17 @@ (define* (hg-fetch ref hash-algo hash
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 build (define build
#~(begin (with-imported-modules '((guix build hg)
(use-modules (guix build hg) (guix build utils))
(guix build utils) #~(begin
(ice-9 match)) (use-modules (guix build hg)
(guix build utils)
(ice-9 match))
(hg-fetch '#$(hg-reference-url ref) (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")))))
(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
@ -77,8 +79,6 @@ (define build
#:hash-algo hash-algo #:hash-algo hash-algo
#:hash hash #:hash hash
#:recursive? #t #:recursive? #t
#:modules '((guix build hg)
(guix build utils))
#:guile-for-build guile))) #:guile-for-build guile)))
;;; hg-download.scm ends here ;;; hg-download.scm ends here

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in> ;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -59,14 +59,16 @@ (define* (svn-fetch ref hash-algo hash
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 build (define build
#~(begin (with-imported-modules '((guix build svn)
(use-modules (guix build svn)) (guix build utils))
(svn-fetch '#$(svn-reference-url ref) #~(begin
'#$(svn-reference-revision ref) (use-modules (guix build svn))
#$output (svn-fetch '#$(svn-reference-url ref)
#:svn-command (string-append #+svn "/bin/svn") '#$(svn-reference-revision ref)
#:user-name #$(svn-reference-user-name ref) #$output
#:password #$(svn-reference-password ref)))) #:svn-command (string-append #+svn "/bin/svn")
#:user-name #$(svn-reference-user-name ref)
#:password #$(svn-reference-password ref)))))
(mlet %store-monad ((guile (package->derivation guile system))) (mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "svn-checkout") build (gexp->derivation (or name "svn-checkout") build
@ -74,8 +76,6 @@ (define build
#:hash-algo hash-algo #:hash-algo hash-algo
#:hash hash #:hash hash
#:recursive? #t #:recursive? #t
#:modules '((guix build svn)
(guix build utils))
#:guile-for-build guile #:guile-for-build guile
#:local-build? #t))) #:local-build? #t)))