Toggle diff (337 lines)
diff --git a/Makefile.am b/Makefile.am
index 85b9ab36d..d2660b0a7 100644
@@ -110,7 +110,6 @@ MODULES = \
guix/build/ant-build-system.scm \
guix/build/download.scm \
- guix/build/download-nar.scm \
guix/build/cargo-build-system.scm \
guix/build/cmake-build-system.scm \
guix/build/dub-build-system.scm \
diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm
index 13f01fb1e..000000000
--- a/guix/build/download-nar.scm
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
-;;; This file is part of GNU Guix.
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;; GNU General Public License for more details.
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-(define-module (guix build download-nar)
- #:use-module (guix build download)
- #:use-module (guix build utils)
- #:use-module (guix serialization)
- #:use-module (guix zlib)
- #:use-module (guix progress)
- #:use-module (srfi srfi-11)
- #:use-module (srfi srfi-26)
- #:use-module (ice-9 format)
- #:use-module (ice-9 match)
- #:export (download-nar))
-;;; Download a normalized archive or "nar", similar to what 'guix substitute'
-;;; does. The intent here is to use substitute servers as content-addressed
-;;; mirrors of VCS checkouts. This is mostly useful for users who have
-;;; disabled substitutes.
-(define (urls-for-item item)
- "Return the fallback nar URL for ITEM--e.g.,
-\"/gnu/store/cabbag3…-foo-1.2-checkout\"."
- ;; Here we hard-code nar URLs without checking narinfos. That's probably OK
- ;; TODO: Use HTTPS? The downside is the extra dependency.
- (let ((bases '("http://mirror.hydra.gnu.org/guix"
- "http://berlin.guixsd.org"))
- (item (basename item)))
- (append (map (cut string-append <> "/nar/gzip/" item) bases)
- (map (cut string-append <> "/nar/" item) bases))))
-(define (restore-gzipped-nar port item size)
- "Restore the gzipped nar read from PORT, of SIZE bytes (compressed), to
- ;; Since PORT is typically a non-file port (for instance because 'http-get'
- ;; returns a delimited port), create a child process so we're back to a file
- ;; port that can be passed to 'call-with-gzip-input-port'.
- (match (primitive-fork)
- (call-with-gzip-input-port input
- (cut restore-file <> item)))
- (print-exception (current-error-port)
- (stack-ref (make-stack #t) 1)
- (dump-port* port output
- #:reporter (progress-reporter/file item size
- store-path-abbreviation))
- (error "nar decompression failed" status)))))))))
-(define (download-nar item)
- "Download and extract the normalized archive for ITEM. Return #t on
- ;; Let progress reports go through.
- (setvbuf (current-error-port) _IONBF)
- (setvbuf (current-output-port) _IONBF)
- (let loop ((urls (urls-for-item item)))
- (format #t "Trying content-addressed mirror at ~a...~%"
- (uri-host (string->uri url)))
- (let-values (((port size)
- (http-fetch (string->uri url)))
- (format #t "Downloading from ~a (~,2h MiB)...~%" url
- (format #t "Downloading from ~a...~%" url))
- (if (string-contains url "/gzip")
- (restore-gzipped-nar port item size)
- ;; FIXME: Add progress report.
- (restore-file port item)
diff --git a/guix/cvs-download.scm b/guix/cvs-download.scm
index 8b46f8ef8..85744c5b5 100644
--- a/guix/cvs-download.scm
+++ b/guix/cvs-download.scm
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 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 © 2015 Mark H Weaver <mhw@netris.org>
#:use-module (guix store)
#:use-module (guix monads)
- #:use-module (guix modules)
#:use-module (guix packages)
#:use-module (ice-9 match)
"Return a fixed-output derivation that fetches REF, a <cvs-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."
- (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
- (scheme-file "config.scm"
- (define-module (guix config)
- #+(file-append zlib "/lib/libz")))))
- (cons `((guix config) => ,config.scm)
- (source-module-closure '((guix build cvs)
- (guix build download-nar))))))
- (with-imported-modules modules
+ (with-imported-modules '((guix build cvs)
- (use-modules (guix build cvs)
- (guix build download-nar))
- (or (cvs-fetch '#$(cvs-reference-root-directory ref)
- '#$(cvs-reference-module ref)
- '#$(cvs-reference-revision ref)
- #:cvs-command (string-append #+cvs "/bin/cvs"))
- (download-nar #$output)))))
+ (use-modules (guix build cvs))
+ (cvs-fetch '#$(cvs-reference-root-directory ref)
+ '#$(cvs-reference-module ref)
+ '#$(cvs-reference-revision ref)
+ #:cvs-command (string-append #+cvs "/bin/cvs")))))
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "cvs-checkout") build
diff --git a/guix/git-download.scm b/guix/git-download.scm
index 731e549b3..7397cbe7f 100644
--- a/guix/git-download.scm
+++ b/guix/git-download.scm
#:use-module (guix monads)
#:use-module (guix records)
#:use-module (guix packages)
- #:use-module (guix modules)
#:autoload (guix build-system gnu) (standard-packages)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
@@ -78,31 +77,12 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
- (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
- (scheme-file "config.scm"
- (define-module (guix config)
- #+(file-append zlib "/lib/libz")))))
- (cons `((guix config) => ,config.scm)
- (source-module-closure '((guix build git)
- (guix build download-nar))))))
- (with-imported-modules modules
+ (with-imported-modules '((guix build git)
(use-modules (guix build git)
- (guix build download-nar)
;; The 'git submodule' commands expects Coreutils, sed,
@@ -112,13 +92,12 @@ HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if #f."
- (or (git-fetch (getenv "git url") (getenv "git commit")
- #:recursive? (call-with-input-string
- (getenv "git recursive?")
- #:git-command (string-append #+git "/bin/git"))
- (download-nar #$output)))))
+ (git-fetch (getenv "git url") (getenv "git commit")
+ #:recursive? (call-with-input-string
+ (getenv "git recursive?")
+ #:git-command (string-append #+git "/bin/git")))))
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "git-checkout") build
diff --git a/guix/hg-download.scm b/guix/hg-download.scm
index 6b25b87b6..842098090 100644
--- a/guix/hg-download.scm
+++ b/guix/hg-download.scm
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; This file is part of GNU Guix.
#:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix records)
- #:use-module (guix modules)
#:use-module (guix packages)
#:autoload (guix build-system gnu) (standard-packages)
#:use-module (ice-9 match)
"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."
- (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
- (scheme-file "config.scm"
- (define-module (guix config)
- #+(file-append zlib "/lib/libz")))))
- (cons `((guix config) => ,config.scm)
- (source-module-closure '((guix build hg)
- (guix build download-nar))))))
- (with-imported-modules modules
+ (with-imported-modules '((guix build hg)
(use-modules (guix build hg)
- (guix build download-nar))
- (or (hg-fetch '#$(hg-reference-url ref)
- '#$(hg-reference-changeset ref)
- #:hg-command (string-append #+hg "/bin/hg"))
- (download-nar #$output)))))
+ (hg-fetch '#$(hg-reference-url ref)
+ '#$(hg-reference-changeset ref)
+ #:hg-command (string-append #+hg "/bin/hg")))))
(mlet %store-monad ((guile (package->derivation guile system)))
(gexp->derivation (or name "hg-checkout") build