;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 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 © 2016, 2017, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2019 Guy Fleury Iteriteka <hoonandon@gmail.com>
;;;
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module (guix store)
- #:use-module ((guix build download) #:prefix build:)
+ #:autoload (guix build download) (url-fetch)
#:use-module (guix monads)
#:use-module (guix gexp)
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (%mirrors
- url-fetch
+ %disarchive-mirrors
+ %download-fallback-test
+ (url-fetch* . url-fetch)
url-fetch/executable
url-fetch/tarbomb
url-fetch/zipbomb
"ftp://ftp.ring.gr.jp/pub/net/gnupg/"
"ftp://ftp.gnupg.org/gcrypt/")
(gnome
- "http://ftp.belnet.be/ftp.gnome.org/"
- "http://ftp.linux.org.uk/mirrors/ftp.gnome.org/"
- "http://ftp.gnome.org/pub/GNOME/"
"https://download.gnome.org/"
+ "http://ftp.gnome.org/pub/GNOME/"
"http://mirror.yandex.ru/mirrors/ftp.gnome.org/")
(hackage
"http://hackage.haskell.org/")
- (savannah
- "http://download.savannah.gnu.org/releases/"
- "http://ftp.cc.uoc.gr/mirrors/nongnu.org/"
- "http://ftp.twaren.net/Unix/NonGNU/"
- "http://mirror.csclub.uwaterloo.ca/nongnu/"
- "http://nongnu.askapache.com/"
- "http://savannah.c3sl.ufpr.br/"
+ (savannah ; http://download0.savannah.gnu.org/mirmon/savannah/
+ "https://download.savannah.gnu.org/releases/"
+ "https://nongnu.freemirror.org/nongnu/"
+ "https://ftp.cc.uoc.gr/mirrors/nongnu.org/"
+ "http://ftp.twaren.net/Unix/NonGNU/" ; https appears unsupported
+ "https://mirror.csclub.uwaterloo.ca/nongnu/"
+ "https://nongnu.askapache.com/"
+ "https://savannah.c3sl.ufpr.br/"
"http://download.savannah.gnu.org/releases-noredirect/"
- "http://download-mirror.savannah.gnu.org/releases/"
+ "https://download-mirror.savannah.gnu.org/releases/"
"ftp://ftp.twaren.net/Unix/NonGNU/"
"ftp://mirror.csclub.uwaterloo.ca/nongnu/"
"ftp://mirror.publicns.net/pub/nongnu/"
(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://cran.stat.auckland.ac.nz/"
"http://cran.mirror.ac.za/"
"http://cran.csie.ntu.edu.tw/")
+ (ctan
+ ;; This is the CTAN mirror multiplexor service, which automatically
+ ;; redirect to a mirror in or close to the country of the requester
+ ;; (see: https://ctan.org/mirrors/).
+ "https://mirror.ctan.org/")
(imagemagick
;; from http://www.imagemagick.org/script/download.php
;; (without mirrors that are unavailable or not up to date)
- ;; mirrors keeping old versions at the top level
- "https://sunsite.icm.edu.pl/packages/ImageMagick/"
- ;; mirrors moving old versions to "legacy"
- "http://mirror.checkdomain.de/imagemagick/"
- "http://ftp.surfnet.nl/pub/ImageMagick/"
- "http://mirror.searchdaimon.com/ImageMagick"
- "http://mirror.is.co.za/pub/imagemagick/"
- "http://www.imagemagick.org/download/"
- "ftp://mirror.aarnet.edu.au/pub/imagemagick/"
- "ftp://ftp.kddlabs.co.jp/graphics/ImageMagick/"
- "ftp://ftp.u-aizu.ac.jp/pub/graphics/image/ImageMagick/imagemagick.org/"
+ "https://sunsite.icm.edu.pl/packages/ImageMagick/releases"
+ "http://mirror.checkdomain.de/imagemagick/releases"
+ "ftp://ftp.u-aizu.ac.jp/pub/graphics/image/ImageMagick/imagemagick.org/releases"
"ftp://ftp.nluug.nl/pub/ImageMagick/"
- "ftp://ftp.tpnet.pl/pub/graphics/ImageMagick/"
- "ftp://ftp.fifi.org/pub/ImageMagick/"
- ;; one legacy location as a last resort
- "http://www.imagemagick.org/download/legacy/")
+ "http://www.imagemagick.org/download/releases/"
+ ;; Try this if all else fails (normally contains just the latest version).
+ "http://www.imagemagick.org/download/")
(debian
"http://ftp.de.debian.org/debian/"
"http://ftp.fr.debian.org/debian/"
"http://ftp.debian.org/debian/"
"http://archive.debian.org/debian/")
(kde
- "http://download.kde.org"
- "http://download.kde.org/Attic" ; for when it gets archived.
- ;; Mirrors from http://files.kde.org/extra/mirrors.html
+ "https://download.kde.org/"
+ "https://download.kde.org/Attic/" ; for when it gets archived.
+ ;; I could not find the classic static mirror list anymore. Instead,
+ ;; add ‘.mirrorlist’ to the end of a recent download.kde.org tarball URL.
;; Europe
- "http://mirror.easyname.at/kde"
- "http://mirror.karneval.cz/pub/kde"
- "http://ftp.fi.muni.cz/pub/kde/"
- "http://mirror.oss.maxcdn.com/kde/"
- "http://ftp5.gwdg.de/pub/linux/kde/"
- "http://ftp-stud.fht-esslingen.de/Mirrors/ftp.kde.org/pub/kde/"
- "http://mirror.klaus-uwe.me/kde/ftp/"
- "http://kde.beta.mirror.ga/"
- "http://kde.alpha.mirror.ga/"
- "http://mirror.netcologne.de/kde"
- "http://vesta.informatik.rwth-aachen.de/ftp/pub/mirror/kde/"
- "http://ftp.rz.uni-wuerzburg.de/pub/unix/kde/"
- "http://mirrors.dotsrc.org/kde/"
- "http://ftp.funet.fi/pub/mirrors/ftp.kde.org/pub/kde/"
- "http://kde-mirror.freenux.org/"
- "http://mirrors.ircam.fr/pub/KDE/"
- "http://www-ftp.lip6.fr/pub/X11/kde/"
- "http://fr2.rpmfind.net/linux/KDE/"
+ "https://mirrors.xtom.de/kde/"
+ "https://mirror.lyrahosting.com/pub/kde/"
+ "https://mirrors.xtom.nl/kde/"
+ "https://mirror.hs-esslingen.de/Mirrors/ftp.kde.org/pub/kde/"
+ "https://mirror.kumi.systems/kde/ftp/"
+ "https://mirrors.ircam.fr/pub/KDE/"
+ "https://ftp.gwdg.de/pub/linux/kde/"
+ "https://mirrors.gethosted.online/kde/pub/kde/"
+ "https://fr2.rpmfind.net/linux/KDE/"
+ "https://mirror.faigner.de/kde/ftp/"
+ "https://www.mirrorservice.org/sites/download.kde.org/"
+ "https://mirrors.ukfast.co.uk/sites/kde.org/ftp/"
+ "https://mirrors.dotsrc.org/kde/"
"http://kde.mirror.anlx.net/"
- "http://www.mirrorservice.org/sites/ftp.kde.org/pub/kde/"
- "http://ftp.heanet.ie/mirrors/ftp.kde.org/"
- "http://ftp.nluug.nl/pub/windowing/kde/"
- "http://ftp.surfnet.nl/windowing/kde/"
- "http://ftp.icm.edu.pl/pub/unix/kde/"
- "http://ftp.pbone.net/pub/kde/"
- "http://piotrkosoft.net/pub/mirrors/ftp.kde.org/"
- "http://mirrors.fe.up.pt/pub/kde/"
- "http://ftp.iasi.roedu.net/pub/mirrors/ftp.kde.org/"
- "http://ftp.acc.umu.se/mirror/kde.org/ftp/"
- "http://kde.ip-connect.vn.ua/"
+ "https://mirror.karneval.cz/pub/kde/"
+ "https://ftp.fi.muni.cz/pub/kde/"
+ "https://www-ftp.lip6.fr/pub/X11/kde/"
+ "https://ftp.icm.edu.pl/pub/unix/kde/"
+ "https://kde.mirror.garr.it/kde/ftp/"
+ "https://ftp.acc.umu.se/mirror/kde.org/ftp/"
+ "https://mirrors.up.pt/pub/kde/"
+ "https://mirrors.nav.ro/kde/"
+ "https://mirrors.xtom.ee/kde/"
+ "https://ftp.funet.fi/pub/mirrors/ftp.kde.org/pub/kde/"
+ "https://kde.ip-connect.vn.ua/"
+ "https://mirrors.netix.net/kde/"
+ "https://ftp.cc.uoc.gr/mirrors/kde/"
;; North America
- "http://mirror.its.dal.ca/kde/"
- "http://mirror.csclub.uwaterloo.ca/kde/"
- "http://mirror.cc.columbia.edu/pub/software/kde/"
- "http://kde.mirrors.hoobly.com/"
- "http://ftp.ussg.iu.edu/kde/"
- "http://mirrors.mit.edu/kde/"
- "http://kde.mirrors.tds.net/pub/kde/"
+ "https://mirror.its.dal.ca/kde/"
+ "https://nnenix.mm.fcix.net/kdeftp/"
+ "https://mirrors.mit.edu/kde/"
+ "https://mirror.csclub.uwaterloo.ca/kde/"
+ "https://mirror.fcix.net/kdeftp/"
+ "https://mirrors.ocf.berkeley.edu/kde/"
+ "https://mirrors.xtom.com/kde/"
+ ;; South America
+ "https://kde.c3sl.ufpr.br/"
+ ;; Asia
+ "https://mirrors.bfsu.edu.cn/kde/"
+ "https://ftp-srv2.kddi-research.jp/pub/X11/kde/"
+ "https://mirrors.xtom.jp/kde/"
+ "https://mirrors.xtom.hk/kde/"
+ ;; Africa
+ "http://mirror.retentionrange.co.bw/kde/"
;; Oceania
- "http://ftp.kddlabs.co.jp/pub/X11/kde/"
- "http://kde.mirror.uber.com.au/")
+ "https://mirrors.xtom.au/kde/")
(openbsd
"https://ftp.openbsd.org/pub/OpenBSD/"
;; Anycast CDN redirecting to your friendly local mirror.
;; procedure that takes a file name, an algorithm (symbol) and a hash
;; (bytevector), and returns a URL or #f.
'(begin
- (use-modules (guix base32))
+ (use-modules (guix base16) (guix base32))
(define (guix-publish host)
(lambda (file algo hash)
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.
(plain-file "content-addressed-mirrors"
(object->string %content-addressed-mirrors)))
+(define %no-mirrors-file
+ ;; File specifying an empty list of mirrors, for fallback tests.
+ (plain-file "no-content-addressed-mirrors" (object->string ''())))
+
+(define %disarchive-mirrors
+ ;; TODO: Eventually turn into a procedure that takes a hash algorithm
+ ;; (symbol) and hash (bytevector).
+ '("https://disarchive.guix.gnu.org/"
+ "https://disarchive.ngyro.com/"))
+
+(define %disarchive-mirror-file
+ (plain-file "disarchive-mirrors" (object->string %disarchive-mirrors)))
+
+(define %no-disarchive-mirrors-file
+ ;; File specifying an empty list of Disarchive mirrors, for fallback tests.
+ (plain-file "no-disarchive-mirrors" (object->string '())))
+
(define built-in-builders*
(store-lift built-in-builders))
(define* (built-in-download file-name url
#:key system hash-algo hash
mirrors content-addressed-mirrors
+ disarchive-mirrors
executable?
(guile 'unused))
"Download FILE-NAME from URL using the built-in 'download' builder. When
download by itself using its own dependencies."
(mlet %store-monad ((mirrors (lower-object mirrors))
(content-addressed-mirrors
- (lower-object content-addressed-mirrors)))
+ (lower-object content-addressed-mirrors))
+ (disarchive-mirrors (lower-object disarchive-mirrors)))
(raw-derivation file-name "builtin:download" '()
#:system system
#:hash-algo hash-algo
#:hash hash
#:recursive? executable?
- #:sources (list mirrors content-addressed-mirrors)
+ #:sources (list mirrors
+ content-addressed-mirrors
+ disarchive-mirrors)
;; Honor the user's proxy and locale settings.
#:leaked-env-vars '("http_proxy" "https_proxy"
("mirrors" . ,mirrors)
("content-addressed-mirrors"
. ,content-addressed-mirrors)
+ ("disarchive-mirrors" . ,disarchive-mirrors)
,@(if executable?
'(("executable" . "1"))
'()))
;; for that built-in is widespread.
#:local-build? #t)))
-(define* (url-fetch url hash-algo hash
- #:optional name
- #:key (system (%current-system))
- (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. When EXECUTABLE? is true,
-make the downloaded file executable.
+(define %download-fallback-test
+ ;; Define whether to test one of the download fallback mechanism. Possible
+ ;; values are:
+ ;;
+ ;; - #f, to use the normal download methods, not trying to exercise the
+ ;; fallback mechanism;
+ ;;
+ ;; - 'none, to disable all the fallback mechanisms;
+ ;;
+ ;; - 'content-addressed-mirrors, to purposefully attempt to download from
+ ;; a content-addressed mirror;
+ ;;
+ ;; - 'disarchive-mirrors, to download from Disarchive + Software Heritage.
+ ;;
+ ;; This is meant to be used for testing purposes.
+ (make-parameter (and=> (getenv "GUIX_DOWNLOAD_FALLBACK_TEST")
+ string->symbol)))
+
+(define* (url-fetch* url hash-algo hash
+ #:optional name
+ #:key (system (%current-system))
+ (guile (default-guile))
+ executable?)
+ "Return a fixed-output derivation that fetches data from 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. 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.
-Alternately, when URL starts with file://, return the corresponding file name
-in the store."
+Alternatively, when URL starts with file://, return the corresponding file
+name in the store."
(define file-name
(match url
((head _ ...)
(unless (member "download" builtins)
(error "'guix-daemon' is too old, please upgrade" builtins))
- (built-in-download (or name file-name) url
+ (built-in-download (or name file-name)
+ (match (%download-fallback-test)
+ ((or #f 'none) url)
+ (_ "https://example.org/does-not-exist"))
#:guile guile
#:system system
#:hash-algo hash-algo
#:executable? executable?
#:mirrors %mirror-file
#:content-addressed-mirrors
- %content-addressed-mirror-file)))))
+ (match (%download-fallback-test)
+ ((or #f 'content-addressed-mirrors)
+ %content-addressed-mirror-file)
+ (_ %no-mirrors-file))
+ #:disarchive-mirrors
+ (match (%download-fallback-test)
+ ((or #f 'disarchive-mirrors)
+ %disarchive-mirror-file)
+ (_ %no-disarchive-mirrors-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))
+ (url-fetch* url hash-algo hash name
+ #:system system
+ #:guile guile
+ #:executable? #t))
(define* (url-fetch/tarbomb url hash-algo hash
#:optional name
(define tar
(module-ref (resolve-interface '(gnu packages base)) 'tar))
- (mlet %store-monad ((drv (url-fetch url hash-algo hash
- (string-append "tarbomb-"
- (or name file-name))
- #:system system
- #:guile guile))
+ (mlet %store-monad ((drv (url-fetch* url hash-algo hash
+ (string-append "tarbomb-"
+ (or name file-name))
+ #:system system
+ #: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
#~(begin
(use-modules (guix build utils))
(mkdir #$output)
- (setenv "PATH" (string-append #$gzip "/bin"))
+ (setenv "PATH" (string-append #+gzip "/bin"))
(chdir #$output)
- (invoke (string-append #$tar "/bin/tar")
+ (invoke (string-append #+tar "/bin/tar")
"xf" #$drv)))
#:system system
#:guile-for-build guile
(define unzip
(module-ref (resolve-interface '(gnu packages compression)) 'unzip))
- (mlet %store-monad ((drv (url-fetch url hash-algo hash
- (string-append "zipbomb-"
- (or name file-name))
- #:system system
- #:guile guile))
+ (mlet %store-monad ((drv (url-fetch* url hash-algo hash
+ (string-append "zipbomb-"
+ (or name file-name))
+ #:system system
+ #: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
(use-modules (guix build utils))
(mkdir #$output)
(chdir #$output)
- (invoke (string-append #$unzip "/bin/unzip")
+ (invoke (string-append #+unzip "/bin/unzip")
#$drv)))
#:system system
#:guile-for-build guile
(lambda (temp port)
(let ((result
(parameterize ((current-output-port log))
- (build:url-fetch url temp
- #:mirrors %mirrors
- #:verify-certificate?
- verify-certificate?))))
+ (url-fetch url temp
+ #:mirrors %mirrors
+ #:verify-certificate? verify-certificate?))))
(close port)
(and result
(add-to-store store name recursive? "sha256" temp)))))))
HCoop / jackhill / guix / guix.git / blobdiff