>From 9bcf90b99a79f9f3e126cde5fe1cf51b0dfa58aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 15 Dec 2017 10:03:39 +0100 Subject: [PATCH 2/2] Revert "download: Download a nar when a VCS checkout fails." This reverts commit 37ce440dcffa9ff4f5401bacbc9619bd8ea561c1, which is useless now that substitutes are always enabled for content-addressed items. --- Makefile.am | 1 - guix/build/download-nar.scm | 125 -------------------------------------------- guix/cvs-download.scm | 38 ++++---------- guix/git-download.scm | 37 +++---------- guix/hg-download.scm | 36 ++++--------- 5 files changed, 26 insertions(+), 211 deletions(-) delete mode 100644 guix/build/download-nar.scm diff --git a/Makefile.am b/Makefile.am index 85b9ab36d..d2660b0a7 100644 --- a/Makefile.am +++ b/Makefile.am @@ -110,7 +110,6 @@ MODULES = \ guix/ui.scm \ 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 deleted file mode 100644 index 13f01fb1e..000000000 --- a/guix/build/download-nar.scm +++ /dev/null @@ -1,125 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès -;;; -;;; 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 . - -(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 (web uri) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) - #:use-module (ice-9 format) - #:use-module (ice-9 match) - #:export (download-nar)) - -;;; Commentary: -;;; -;;; 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. -;;; -;;; Code: - -(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 - ;; though. - ;; 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 -ITEM." - ;; 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 (pipe) - ((input . output) - (match (primitive-fork) - (0 - (dynamic-wind - (const #t) - (lambda () - (close-port output) - (close-port port) - (catch #t - (lambda () - (call-with-gzip-input-port input - (cut restore-file <> item))) - (lambda (key . args) - (print-exception (current-error-port) - (stack-ref (make-stack #t) 1) - key args) - (primitive-exit 1)))) - (lambda () - (primitive-exit 0)))) - (child - (close-port input) - (dump-port* port output - #:reporter (progress-reporter/file item size - #:abbreviation - store-path-abbreviation)) - (close-port output) - (newline) - (match (waitpid child) - ((_ . status) - (unless (zero? status) - (error "nar decompression failed" status))))))))) - -(define (download-nar item) - "Download and extract the normalized archive for ITEM. Return #t on -success, #f otherwise." - ;; Let progress reports go through. - (setvbuf (current-error-port) _IONBF) - (setvbuf (current-output-port) _IONBF) - - (let loop ((urls (urls-for-item item))) - (match urls - ((url rest ...) - (format #t "Trying content-addressed mirror at ~a...~%" - (uri-host (string->uri url))) - (let-values (((port size) - (catch #t - (lambda () - (http-fetch (string->uri url))) - (lambda args - (values #f #f))))) - (if (not port) - (loop rest) - (begin - (if size - (format #t "Downloading from ~a (~,2h MiB)...~%" url - (/ size (expt 2 20.))) - (format #t "Downloading from ~a...~%" url)) - (if (string-contains url "/gzip") - (restore-gzipped-nar port item size) - (begin - ;; FIXME: Add progress report. - (restore-file port item) - (close-port port))) - #t)))) - (() - #f)))) 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 @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2014 Sree Harsha Totakura ;;; Copyright © 2015 Mark H Weaver ;;; @@ -23,7 +23,6 @@ #:use-module (guix gexp) #:use-module (guix store) #:use-module (guix monads) - #:use-module (guix modules) #:use-module (guix packages) #:use-module (ice-9 match) #:export (cvs-reference @@ -60,35 +59,16 @@ "Return a fixed-output derivation that fetches REF, a 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 zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module (guix config) - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) - - (define modules - (cons `((guix config) => ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build cvs) - (guix build download-nar)))))) (define build - (with-imported-modules modules + (with-imported-modules '((guix build cvs) + (guix build utils)) #~(begin - (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) - #$output - #: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) + #$output + #: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 @@ -25,7 +25,6 @@ #: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." (standard-packages) '())) - (define zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module (guix config) - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) - - (define modules - (cons `((guix config) => ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build git) - (guix build utils) - (guix build download-nar)))))) - (define build - (with-imported-modules modules + (with-imported-modules '((guix build git) + (guix build utils)) #~(begin (use-modules (guix build git) (guix build utils) - (guix build download-nar) (ice-9 match)) ;; 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." (((names dirs) ...) dirs))) - (or (git-fetch (getenv "git url") (getenv "git commit") - #$output - #:recursive? (call-with-input-string - (getenv "git recursive?") - read) - #:git-command (string-append #+git "/bin/git")) - (download-nar #$output))))) + (git-fetch (getenv "git url") (getenv "git commit") + #$output + #:recursive? (call-with-input-string + (getenv "git recursive?") + read) + #: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 @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016 Ludovic Courtès ;;; Copyright © 2016 Ricardo Wurmus ;;; ;;; This file is part of GNU Guix. @@ -22,7 +22,6 @@ #: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) @@ -60,35 +59,18 @@ "Return a fixed-output derivation that fetches REF, a 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 zlib - (module-ref (resolve-interface '(gnu packages compression)) 'zlib)) - - (define config.scm - (scheme-file "config.scm" - #~(begin - (define-module (guix config) - #:export (%libz)) - - (define %libz - #+(file-append zlib "/lib/libz"))))) - - (define modules - (cons `((guix config) => ,config.scm) - (delete '(guix config) - (source-module-closure '((guix build hg) - (guix build download-nar)))))) - (define build - (with-imported-modules modules + (with-imported-modules '((guix build hg) + (guix build utils)) #~(begin (use-modules (guix build hg) - (guix build download-nar)) + (guix build utils) + (ice-9 match)) - (or (hg-fetch '#$(hg-reference-url ref) - '#$(hg-reference-changeset ref) - #$output - #:hg-command (string-append #+hg "/bin/hg")) - (download-nar #$output))))) + (hg-fetch '#$(hg-reference-url ref) + '#$(hg-reference-changeset ref) + #$output + #:hg-command (string-append #+hg "/bin/hg"))))) (mlet %store-monad ((guile (package->derivation guile system))) (gexp->derivation (or name "hg-checkout") build -- 2.15.1