;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019 Guy Fleury Iteriteka <hoonandon@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module (srfi srfi-26)
#:export (%mirrors
url-fetch
+ url-fetch/executable
url-fetch/tarbomb
url-fetch/zipbomb
download-to-store))
"http://mirror.yandex.ru/mirrors/ftp.gnome.org/")
(hackage
"http://hackage.haskell.org/")
- (savannah
+ (savannah ; http://download0.savannah.gnu.org/mirmon/savannah/
"http://download.savannah.gnu.org/releases/"
+ "http://nongnu.freemirror.org/nongnu/"
"http://ftp.cc.uoc.gr/mirrors/nongnu.org/"
"http://ftp.twaren.net/Unix/NonGNU/"
"http://mirror.csclub.uwaterloo.ca/nongnu/"
"ftp://ftp.hu.netfilter.org/"
"ftp://www.lt.netfilter.org/pub/")
(kernel.org
- "http://ramses.wh2.tu-dresden.de/pub/mirrors/kernel.org/"
"http://linux-kernel.uio.no/pub/"
"http://kernel.osuosl.org/pub/"
"http://ftp.be.debian.org/pub/"
(apache ; from http://www.apache.org/mirrors/dist.html
"http://www.eu.apache.org/dist/"
"http://www.us.apache.org/dist/"
- "http://apache.belnet.be/"
+ "https://ftp.nluug.nl/internet/apache/"
+ "http://apache.mirror.iweb.ca/"
"http://mirrors.ircam.fr/pub/apache/"
+ "http://apache.mirrors.ovh.net/ftp.apache.org/dist/"
"http://apache-mirror.rbc.ru/pub/apache/"
+ "ftp://ftp.osuosl.org/pub/apache/"
+ "http://mirrors.ibiblio.org/apache/"
;; As a last resort, try the archive.
"http://archive.apache.org/dist/")
"http://mirrors.nic.cz/CPAN/"
"http://mirror.ibcp.fr/pub/CPAN/"
"http://ftp.ntua.gr/pub/lang/perl/"
- "http://kvin.lv/pub/CPAN/"
"http://mirror.as43289.net/pub/CPAN/"
"http://cpan.cs.uu.nl/"
"http://cpan.uib.no/"
;; mirrors keeping old versions at the top level
"https://sunsite.icm.edu.pl/packages/ImageMagick/"
;; mirrors moving old versions to "legacy"
- "http://mirrors-usa.go-parts.com/mirrors/ImageMagick/"
"http://mirror.checkdomain.de/imagemagick/"
"http://ftp.surfnet.nl/pub/ImageMagick/"
"http://mirror.searchdaimon.com/ImageMagick"
"http://mirror.its.dal.ca/kde/"
"http://mirror.csclub.uwaterloo.ca/kde/"
"http://mirror.cc.columbia.edu/pub/software/kde/"
- "http://mirrors-usa.go-parts.com/kde"
"http://kde.mirrors.hoobly.com/"
"http://ftp.ussg.iu.edu/kde/"
"http://mirrors.mit.edu/kde/"
"https://openbsd.mirror.constant.com/pub/OpenBSD/"
"https://ftp4.usa.openbsd.org/pub/OpenBSD/"
"https://ftp5.usa.openbsd.org/pub/OpenBSD/"
- "https://mirror.esc7.net/pub/OpenBSD/"))))
+ "https://mirror.esc7.net/pub/OpenBSD/")
+ (mate
+ "https://pub.mate-desktop.org/releases/"
+ "http://pub.mate-desktop.org/releases/"))))
(define %mirror-file
;; Copy of the list of mirrors to a file. This allows us to keep a single
;; List of content-addressed mirrors. Each mirror is represented as a
;; procedure that takes a file name, an algorithm (symbol) and a hash
;; (bytevector), and returns a URL or #f.
- ;; Note: Avoid 'https' to mitigate <http://bugs.gnu.org/22774>.
- ;; TODO: Add more.
- '(list (lambda (file algo hash)
- ;; Files served by 'guix publish' are accessible under a single
- ;; hash algorithm.
- (string-append "http://mirror.hydra.gnu.org/file/"
- file "/" (symbol->string algo) "/"
- (bytevector->nix-base32-string hash)))
- (lambda (file algo hash)
- ;; 'tarballs.nixos.org' supports several algorithms.
- (string-append "http://tarballs.nixos.org/"
- (symbol->string algo) "/"
- (bytevector->nix-base32-string hash)))))
+ '(begin
+ (use-modules (guix base32))
+
+ (define (guix-publish host)
+ (lambda (file algo hash)
+ ;; Files served by 'guix publish' are accessible under a single
+ ;; hash algorithm.
+ (string-append "https://" host "/file/"
+ file "/" (symbol->string algo) "/"
+ (bytevector->nix-base32-string hash))))
+
+ ;; XXX: (guix base16) appeared in March 2017 (and thus 0.13.0) so old
+ ;; installations of the daemon might lack it. Thus, load it lazily to
+ ;; avoid gratuitous errors. See <https://bugs.gnu.org/33542>.
+ (module-autoload! (current-module)
+ '(guix base16) '(bytevector->base16-string))
+
+ (list (guix-publish "ci.guix.gnu.org")
+ (lambda (file algo hash)
+ ;; 'tarballs.nixos.org' supports several algorithms.
+ (string-append "https://tarballs.nixos.org/"
+ (symbol->string algo) "/"
+ (bytevector->nix-base32-string hash)))
+ (lambda (file algo hash)
+ ;; Software Heritage usually archives VCS history rather than
+ ;; tarballs, but tarballs are sometimes available (and can be
+ ;; explicitly stored there.) For example, see
+ ;; <https://archive.softwareheritage.org/api/1/content/sha256:92d0fa1c311cacefa89853bdb53c62f4110cdfda3820346b59cbd098f40f955e/>.
+ (string-append "https://archive.softwareheritage.org/api/1/content/"
+ (symbol->string algo) ":"
+ (bytevector->base16-string hash) "/raw/")))))
(define %content-addressed-mirror-file
;; Content-addressed mirrors stored in a file.
(object->string %content-addressed-mirrors)))
(define built-in-builders*
- (let ((cache (make-weak-key-hash-table)))
- (lambda ()
- "Return, as a monadic value, the list of built-in builders supported by
-the daemon."
- (lambda (store)
- ;; Memoize the result to avoid repeated RPCs.
- (values (or (hashq-ref cache store)
- (let ((result (built-in-builders store)))
- (hashq-set! cache store result)
- result))
- store)))))
+ (store-lift built-in-builders))
(define* (built-in-download file-name url
#:key system hash-algo hash
mirrors content-addressed-mirrors
+ executable?
(guile 'unused))
- "Download FILE-NAME from URL using the built-in 'download' builder.
+ "Download FILE-NAME from URL using the built-in 'download' builder. When
+EXECUTABLE? is true, make the downloaded file executable.
This is an \"out-of-band\" download in that the returned derivation does not
explicitly depend on Guile, GnuTLS, etc. Instead, the daemon performs the
#:system system
#:hash-algo hash-algo
#:hash hash
- #:inputs `((,mirrors)
- (,content-addressed-mirrors))
+ #:recursive? executable?
+ #:sources (list mirrors content-addressed-mirrors)
;; Honor the user's proxy and locale settings.
#:leaked-env-vars '("http_proxy" "https_proxy"
#:env-vars `(("url" . ,(object->string url))
("mirrors" . ,mirrors)
("content-addressed-mirrors"
- . ,content-addressed-mirrors))
+ . ,content-addressed-mirrors)
+ ,@(if executable?
+ '(("executable" . "1"))
+ '()))
;; Do not offload this derivation because we cannot be
;; sure that the remote daemon supports the 'download'
(define* (url-fetch url hash-algo hash
#:optional name
#:key (system (%current-system))
- (guile (default-guile)))
+ (guile (default-guile))
+ executable?)
"Return a fixed-output derivation that fetches URL (a string, or a list of
strings denoting alternate URLs), which is expected to have hash HASH of type
HASH-ALGO (a symbol). By default, the file name is the base name of URL;
-optionally, NAME can specify a different file name.
+optionally, NAME can specify a different file name. When EXECUTABLE? is true,
+make the downloaded file executable.
When one of the URL starts with mirror://, then its host part is
interpreted as the name of a mirror scheme, taken from %MIRROR-FILE.
#:system system
#:hash-algo hash-algo
#:hash hash
+ #:executable? executable?
#:mirrors %mirror-file
#:content-addressed-mirrors
%content-addressed-mirror-file)))))
+(define* (url-fetch/executable url hash-algo hash
+ #:optional name
+ #:key (system (%current-system))
+ (guile (default-guile)))
+ "Like 'url-fetch', but make the downloaded file executable."
+ (url-fetch url hash-algo hash name
+ #:system system
+ #:guile guile
+ #:executable? #t))
+
(define* (url-fetch/tarbomb url hash-algo hash
#:optional name
#:key (system (%current-system))
(string-append "tarbomb-"
(or name file-name))
#:system system
- #:guile guile)))
+ #:guile guile))
+ (guile (package->derivation guile system)))
;; Take the tar bomb, and simply unpack it as a directory.
;; Use ungrafted tar/gzip so that the resulting tarball doesn't depend on
;; whether grafts are enabled.
(chdir #$output)
(invoke (string-append #$tar "/bin/tar")
"xf" #$drv)))
+ #:system system
+ #:guile-for-build guile
#:graft? #f
#:local-build? #t)))
(string-append "zipbomb-"
(or name file-name))
#:system system
- #:guile guile)))
+ #:guile guile))
+ (guile (package->derivation guile system)))
;; Take the zip bomb, and simply unpack it as a directory.
;; Use ungrafted unzip so that the resulting tarball doesn't depend on
;; whether grafts are enabled.
(chdir #$output)
(invoke (string-append #$unzip "/bin/unzip")
#$drv)))
+ #:system system
+ #:guile-for-build guile
#:graft? #f
#:local-build? #t)))
HCoop / jackhill / guix / guix.git / blobdiff