| 1 | ;;; GNU Guix --- Functional package management for GNU |
| 2 | ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
| 3 | ;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr> |
| 4 | ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> |
| 5 | ;;; Copyright © 2016 Alex Griffin <a@ajgrf.com> |
| 6 | ;;; Copyright © 2016 David Craven <david@craven.ch> |
| 7 | ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> |
| 8 | ;;; Copyright © 2019 Guy Fleury Iteriteka <hoonandon@gmail.com> |
| 9 | ;;; |
| 10 | ;;; This file is part of GNU Guix. |
| 11 | ;;; |
| 12 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
| 13 | ;;; under the terms of the GNU General Public License as published by |
| 14 | ;;; the Free Software Foundation; either version 3 of the License, or (at |
| 15 | ;;; your option) any later version. |
| 16 | ;;; |
| 17 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
| 18 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
| 19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 20 | ;;; GNU General Public License for more details. |
| 21 | ;;; |
| 22 | ;;; You should have received a copy of the GNU General Public License |
| 23 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
| 24 | |
| 25 | (define-module (guix download) |
| 26 | #:use-module (ice-9 match) |
| 27 | #:use-module (guix derivations) |
| 28 | #:use-module (guix packages) |
| 29 | #:use-module (guix store) |
| 30 | #:use-module ((guix build download) #:prefix build:) |
| 31 | #:use-module (guix monads) |
| 32 | #:use-module (guix gexp) |
| 33 | #:use-module (guix utils) |
| 34 | #:use-module (web uri) |
| 35 | #:use-module (srfi srfi-1) |
| 36 | #:use-module (srfi srfi-26) |
| 37 | #:export (%mirrors |
| 38 | url-fetch |
| 39 | url-fetch/executable |
| 40 | url-fetch/tarbomb |
| 41 | url-fetch/zipbomb |
| 42 | download-to-store)) |
| 43 | |
| 44 | ;;; Commentary: |
| 45 | ;;; |
| 46 | ;;; Produce fixed-output derivations with data fetched over HTTP or FTP. |
| 47 | ;;; |
| 48 | ;;; Code: |
| 49 | |
| 50 | (define %mirrors |
| 51 | ;; Mirror lists used when `mirror://' URLs are passed. |
| 52 | (let* ((gnu-mirrors |
| 53 | '(;; This one redirects to a (supposedly) nearby and (supposedly) |
| 54 | ;; up-to-date mirror. |
| 55 | "https://ftpmirror.gnu.org/gnu/" |
| 56 | |
| 57 | "ftp://ftp.cs.tu-berlin.de/pub/gnu/" |
| 58 | "ftp://ftp.funet.fi/pub/mirrors/ftp.gnu.org/gnu/" |
| 59 | |
| 60 | ;; This one is the master repository, and thus it's always |
| 61 | ;; up-to-date. |
| 62 | "http://ftp.gnu.org/pub/gnu/"))) |
| 63 | `((gnu ,@gnu-mirrors) |
| 64 | (gcc |
| 65 | "ftp://ftp.nluug.nl/mirror/languages/gcc/" |
| 66 | "ftp://ftp.fu-berlin.de/unix/languages/gcc/" |
| 67 | "ftp://ftp.irisa.fr/pub/mirrors/gcc.gnu.org/gcc/" |
| 68 | "ftp://gcc.gnu.org/pub/gcc/" |
| 69 | ,@(map (cut string-append <> "/gcc") gnu-mirrors)) |
| 70 | (gnupg |
| 71 | "http://artfiles.org/gnupg.org" |
| 72 | "http://www.crysys.hu/" |
| 73 | "https://gnupg.org/ftp/gcrypt/" |
| 74 | "ftp://mirrors.dotsrc.org/gcrypt/" |
| 75 | "ftp://mirror.cict.fr/gnupg/" |
| 76 | "ftp://ftp.franken.de/pub/crypt/mirror/ftp.gnupg.org/gcrypt/" |
| 77 | "ftp://ftp.freenet.de/pub/ftp.gnupg.org/gcrypt/" |
| 78 | "ftp://ftp.hi.is/pub/mirrors/gnupg/" |
| 79 | "ftp://ftp.heanet.ie/mirrors/ftp.gnupg.org/gcrypt/" |
| 80 | "ftp://ftp.bit.nl/mirror/gnupg/" |
| 81 | "ftp://ftp.surfnet.nl/pub/security/gnupg/" |
| 82 | "ftp://ftp.iasi.roedu.net/pub/mirrors/ftp.gnupg.org/" |
| 83 | "ftp://ftp.sunet.se/pub/security/gnupg/" |
| 84 | "ftp://mirror.switch.ch/mirror/gnupg/" |
| 85 | "ftp://mirror.tje.me.uk/pub/mirrors/ftp.gnupg.org/" |
| 86 | "ftp://ftp.mirrorservice.org/sites/ftp.gnupg.org/gcrypt/" |
| 87 | "ftp://ftp.ring.gr.jp/pub/net/gnupg/" |
| 88 | "ftp://ftp.gnupg.org/gcrypt/") |
| 89 | (gnome |
| 90 | "http://ftp.belnet.be/ftp.gnome.org/" |
| 91 | "http://ftp.linux.org.uk/mirrors/ftp.gnome.org/" |
| 92 | "http://ftp.gnome.org/pub/GNOME/" |
| 93 | "https://download.gnome.org/" |
| 94 | "http://mirror.yandex.ru/mirrors/ftp.gnome.org/") |
| 95 | (hackage |
| 96 | "http://hackage.haskell.org/") |
| 97 | (savannah ; http://download0.savannah.gnu.org/mirmon/savannah/ |
| 98 | "http://download.savannah.gnu.org/releases/" |
| 99 | "http://nongnu.freemirror.org/nongnu/" |
| 100 | "http://ftp.cc.uoc.gr/mirrors/nongnu.org/" |
| 101 | "http://ftp.twaren.net/Unix/NonGNU/" |
| 102 | "http://mirror.csclub.uwaterloo.ca/nongnu/" |
| 103 | "http://nongnu.askapache.com/" |
| 104 | "http://savannah.c3sl.ufpr.br/" |
| 105 | "http://download.savannah.gnu.org/releases-noredirect/" |
| 106 | "http://download-mirror.savannah.gnu.org/releases/" |
| 107 | "ftp://ftp.twaren.net/Unix/NonGNU/" |
| 108 | "ftp://mirror.csclub.uwaterloo.ca/nongnu/" |
| 109 | "ftp://mirror.publicns.net/pub/nongnu/" |
| 110 | "ftp://savannah.c3sl.ufpr.br/") |
| 111 | (sourceforge ; https://sourceforge.net/p/forge/documentation/Mirrors/ |
| 112 | "http://downloads.sourceforge.net/project/" |
| 113 | "http://ufpr.dl.sourceforge.net/project/" |
| 114 | "http://heanet.dl.sourceforge.net/project/" |
| 115 | "http://freefr.dl.sourceforge.net/project/" |
| 116 | "http://internode.dl.sourceforge.net/project/" |
| 117 | "http://jaist.dl.sourceforge.net/project/" |
| 118 | "http://kent.dl.sourceforge.net/project/" |
| 119 | "http://liquidtelecom.dl.sourceforge.net/project/" |
| 120 | ;; "http://nbtelecom.dl.sourceforge.net/project/" ;never returns 404s |
| 121 | "http://nchc.dl.sourceforge.net/project/" |
| 122 | "http://ncu.dl.sourceforge.net/project/" |
| 123 | "http://netcologne.dl.sourceforge.net/project/" |
| 124 | "http://netix.dl.sourceforge.net/project/" |
| 125 | "http://pilotfiber.dl.sourceforge.net/project/" |
| 126 | "http://superb-sea2.dl.sourceforge.net/project/" |
| 127 | "http://tenet.dl.sourceforge.net/project/" |
| 128 | "http://vorboss.dl.sourceforge.net/project/" |
| 129 | "http://netassist.dl.sourceforge.net/project/") |
| 130 | (netfilter.org ; https://www.netfilter.org/mirrors.html |
| 131 | "http://ftp.netfilter.org/pub/" |
| 132 | "ftp://ftp.es.netfilter.org/mirrors/netfilter/" |
| 133 | "ftp://ftp.hu.netfilter.org/" |
| 134 | "ftp://www.lt.netfilter.org/pub/") |
| 135 | (kernel.org |
| 136 | "http://linux-kernel.uio.no/pub/" |
| 137 | "http://kernel.osuosl.org/pub/" |
| 138 | "http://ftp.be.debian.org/pub/" |
| 139 | "http://mirror.linux.org.au/" |
| 140 | "ftp://ftp.funet.fi/pub/mirrors/ftp.kernel.org/pub/") |
| 141 | (apache ; from http://www.apache.org/mirrors/dist.html |
| 142 | "http://www.eu.apache.org/dist/" |
| 143 | "http://www.us.apache.org/dist/" |
| 144 | "https://ftp.nluug.nl/internet/apache/" |
| 145 | "http://apache.mirror.iweb.ca/" |
| 146 | "http://mirrors.ircam.fr/pub/apache/" |
| 147 | "http://apache.mirrors.ovh.net/ftp.apache.org/dist/" |
| 148 | "http://apache-mirror.rbc.ru/pub/apache/" |
| 149 | "ftp://ftp.osuosl.org/pub/apache/" |
| 150 | "http://mirrors.ibiblio.org/apache/" |
| 151 | |
| 152 | ;; As a last resort, try the archive. |
| 153 | "http://archive.apache.org/dist/") |
| 154 | (xorg ; from http://www.x.org/wiki/Releases/Download |
| 155 | "http://www.x.org/releases/" ; main mirrors |
| 156 | "http://mirror.csclub.uwaterloo.ca/x.org/" ; North America |
| 157 | "http://xorg.mirrors.pair.com/" |
| 158 | "http://mirror.us.leaseweb.net/xorg/" |
| 159 | "ftp://mirror.csclub.uwaterloo.ca/x.org/" |
| 160 | "ftp://xorg.mirrors.pair.com/" |
| 161 | "ftp://artfiles.org/x.org/" ; Europe |
| 162 | "ftp://ftp.chg.ru/pub/X11/x.org/" |
| 163 | "ftp://ftp.fu-berlin.de/unix/X11/FTP.X.ORG/" |
| 164 | "ftp://ftp.gwdg.de/pub/x11/x.org/" |
| 165 | "ftp://ftp.mirrorservice.org/sites/ftp.x.org/" |
| 166 | "ftp://ftp.ntua.gr/pub/X11/" |
| 167 | "ftp://ftp.piotrkosoft.net/pub/mirrors/ftp.x.org/" |
| 168 | "ftp://ftp.portal-to-web.de/pub/mirrors/x.org/" |
| 169 | "ftp://ftp.solnet.ch/mirror/x.org/" |
| 170 | "ftp://mi.mirror.garr.it/mirrors/x.org/" |
| 171 | "ftp://mirror.cict.fr/x.org/" |
| 172 | "ftp://mirror.switch.ch/mirror/X11/" |
| 173 | "ftp://mirrors.ircam.fr/pub/x.org/" |
| 174 | "ftp://x.mirrors.skynet.be/pub/ftp.x.org/" |
| 175 | "http://x.cs.pu.edu.tw/" ; East Asia |
| 176 | "ftp://ftp.cs.cuhk.edu.hk/pub/X11" |
| 177 | "ftp://ftp.u-aizu.ac.jp/pub/x11/x.org/" |
| 178 | "ftp://ftp.yz.yamagata-u.ac.jp/pub/X11/x.org/" |
| 179 | "ftp://ftp.kaist.ac.kr/x.org/" |
| 180 | "ftp://mirrors.go-part.com/xorg/" |
| 181 | "ftp://ftp.is.co.za/pub/x.org") ; South Africa |
| 182 | (cpan |
| 183 | "http://www.cpan.org/" |
| 184 | "http://cpan.metacpan.org/" |
| 185 | ;; A selection of HTTP mirrors from http://www.cpan.org/SITES.html. |
| 186 | ;; Europe. |
| 187 | "http://ftp.belnet.be/mirror/ftp.cpan.org/" |
| 188 | "http://mirrors.nic.cz/CPAN/" |
| 189 | "http://mirror.ibcp.fr/pub/CPAN/" |
| 190 | "http://ftp.ntua.gr/pub/lang/perl/" |
| 191 | "http://mirror.as43289.net/pub/CPAN/" |
| 192 | "http://cpan.cs.uu.nl/" |
| 193 | "http://cpan.uib.no/" |
| 194 | "http://cpan-mirror.rbc.ru/pub/CPAN/" |
| 195 | "http://mirror.sbb.rs/CPAN/" |
| 196 | "http://cpan.lnx.sk/" |
| 197 | "http://ftp.rediris.es/mirror/CPAN/" |
| 198 | "http://mirror.ox.ac.uk/sites/www.cpan.org/" |
| 199 | ;; Africa. |
| 200 | "http://mirror.liquidtelecom.com/CPAN/" |
| 201 | "http://cpan.mirror.ac.za/" |
| 202 | "http://mirror.is.co.za/pub/cpan/" |
| 203 | "http://cpan.saix.net/" |
| 204 | "http://mirror.ucu.ac.ug/cpan/" |
| 205 | ;; North America. |
| 206 | "http://mirrors.gossamer-threads.com/CPAN/" |
| 207 | "http://mirror.csclub.uwaterloo.ca/CPAN/" |
| 208 | "http://mirrors.ucr.ac.cr/CPAN/" |
| 209 | "http://www.msg.com.mx/CPAN/" |
| 210 | "http://mirrors.namecheap.com/CPAN/" |
| 211 | "http://mirror.uic.edu/CPAN/" |
| 212 | "http://mirror.datapipe.net/CPAN/" |
| 213 | "http://mirror.cc.columbia.edu/pub/software/cpan/" |
| 214 | "http://mirror.uta.edu/CPAN/" |
| 215 | ;; South America. |
| 216 | "http://cpan.mmgdesigns.com.ar/" |
| 217 | "http://mirror.nbtelecom.com.br/CPAN/" |
| 218 | "http://linorg.usp.br/CPAN/" |
| 219 | "http://cpan.dcc.uchile.cl/" |
| 220 | "http://mirror.cedia.org.ec/CPAN/" |
| 221 | ;; Oceania. |
| 222 | "http://cpan.mirror.serversaustralia.com.au/" |
| 223 | "http://mirror.waia.asn.au/pub/cpan/" |
| 224 | "http://mirror.as24220.net/pub/cpan/" |
| 225 | "http://cpan.lagoon.nc/pub/CPAN/" |
| 226 | "http://cpan.inspire.net.nz/" |
| 227 | ;; Asia. |
| 228 | "http://mirror.dhakacom.com/CPAN/" |
| 229 | "http://mirrors.ustc.edu.cn/CPAN/" |
| 230 | "http://ftp.cuhk.edu.hk/pub/packages/perl/CPAN/" |
| 231 | "http://kambing.ui.ac.id/cpan/" |
| 232 | "http://cpan.hostiran.ir/" |
| 233 | "http://ftp.nara.wide.ad.jp/pub/CPAN/" |
| 234 | "http://mirror.neolabs.kz/CPAN/" |
| 235 | "http://cpan.nctu.edu.tw/" |
| 236 | "http://cpan.ulak.net.tr/" |
| 237 | "http://mirrors.vinahost.vn/CPAN/") |
| 238 | (cran |
| 239 | ;; Arbitrary mirrors from http://cran.r-project.org/mirrors.html |
| 240 | ;; This one automatically redirects to servers worldwide |
| 241 | "http://cran.r-project.org/" |
| 242 | "http://cran.rstudio.com/" |
| 243 | "http://cran.univ-lyon1.fr/" |
| 244 | "http://cran.ism.ac.jp/" |
| 245 | "http://cran.stat.auckland.ac.nz/" |
| 246 | "http://cran.mirror.ac.za/" |
| 247 | "http://cran.csie.ntu.edu.tw/") |
| 248 | (imagemagick |
| 249 | ;; from http://www.imagemagick.org/script/download.php |
| 250 | ;; (without mirrors that are unavailable or not up to date) |
| 251 | ;; mirrors keeping old versions at the top level |
| 252 | "https://sunsite.icm.edu.pl/packages/ImageMagick/" |
| 253 | ;; mirrors moving old versions to "legacy" |
| 254 | "http://mirror.checkdomain.de/imagemagick/" |
| 255 | "http://ftp.surfnet.nl/pub/ImageMagick/" |
| 256 | "http://mirror.searchdaimon.com/ImageMagick" |
| 257 | "http://mirror.is.co.za/pub/imagemagick/" |
| 258 | "http://www.imagemagick.org/download/" |
| 259 | "ftp://mirror.aarnet.edu.au/pub/imagemagick/" |
| 260 | "ftp://ftp.kddlabs.co.jp/graphics/ImageMagick/" |
| 261 | "ftp://ftp.u-aizu.ac.jp/pub/graphics/image/ImageMagick/imagemagick.org/" |
| 262 | "ftp://ftp.nluug.nl/pub/ImageMagick/" |
| 263 | "ftp://ftp.tpnet.pl/pub/graphics/ImageMagick/" |
| 264 | "ftp://ftp.fifi.org/pub/ImageMagick/" |
| 265 | ;; one legacy location as a last resort |
| 266 | "http://www.imagemagick.org/download/legacy/") |
| 267 | (debian |
| 268 | "http://ftp.de.debian.org/debian/" |
| 269 | "http://ftp.fr.debian.org/debian/" |
| 270 | "http://ftp.debian.org/debian/" |
| 271 | "http://archive.debian.org/debian/") |
| 272 | (kde |
| 273 | "http://download.kde.org" |
| 274 | "http://download.kde.org/Attic" ; for when it gets archived. |
| 275 | ;; Mirrors from http://files.kde.org/extra/mirrors.html |
| 276 | ;; Europe |
| 277 | "http://mirror.easyname.at/kde" |
| 278 | "http://mirror.karneval.cz/pub/kde" |
| 279 | "http://ftp.fi.muni.cz/pub/kde/" |
| 280 | "http://mirror.oss.maxcdn.com/kde/" |
| 281 | "http://ftp5.gwdg.de/pub/linux/kde/" |
| 282 | "http://ftp-stud.fht-esslingen.de/Mirrors/ftp.kde.org/pub/kde/" |
| 283 | "http://mirror.klaus-uwe.me/kde/ftp/" |
| 284 | "http://kde.beta.mirror.ga/" |
| 285 | "http://kde.alpha.mirror.ga/" |
| 286 | "http://mirror.netcologne.de/kde" |
| 287 | "http://vesta.informatik.rwth-aachen.de/ftp/pub/mirror/kde/" |
| 288 | "http://ftp.rz.uni-wuerzburg.de/pub/unix/kde/" |
| 289 | "http://mirrors.dotsrc.org/kde/" |
| 290 | "http://ftp.funet.fi/pub/mirrors/ftp.kde.org/pub/kde/" |
| 291 | "http://kde-mirror.freenux.org/" |
| 292 | "http://mirrors.ircam.fr/pub/KDE/" |
| 293 | "http://www-ftp.lip6.fr/pub/X11/kde/" |
| 294 | "http://fr2.rpmfind.net/linux/KDE/" |
| 295 | "http://kde.mirror.anlx.net/" |
| 296 | "http://www.mirrorservice.org/sites/ftp.kde.org/pub/kde/" |
| 297 | "http://ftp.heanet.ie/mirrors/ftp.kde.org/" |
| 298 | "http://ftp.nluug.nl/pub/windowing/kde/" |
| 299 | "http://ftp.surfnet.nl/windowing/kde/" |
| 300 | "http://ftp.icm.edu.pl/pub/unix/kde/" |
| 301 | "http://ftp.pbone.net/pub/kde/" |
| 302 | "http://piotrkosoft.net/pub/mirrors/ftp.kde.org/" |
| 303 | "http://mirrors.fe.up.pt/pub/kde/" |
| 304 | "http://ftp.iasi.roedu.net/pub/mirrors/ftp.kde.org/" |
| 305 | "http://ftp.acc.umu.se/mirror/kde.org/ftp/" |
| 306 | "http://kde.ip-connect.vn.ua/" |
| 307 | ;; North America |
| 308 | "http://mirror.its.dal.ca/kde/" |
| 309 | "http://mirror.csclub.uwaterloo.ca/kde/" |
| 310 | "http://mirror.cc.columbia.edu/pub/software/kde/" |
| 311 | "http://kde.mirrors.hoobly.com/" |
| 312 | "http://ftp.ussg.iu.edu/kde/" |
| 313 | "http://mirrors.mit.edu/kde/" |
| 314 | "http://kde.mirrors.tds.net/pub/kde/" |
| 315 | ;; Oceania |
| 316 | "http://ftp.kddlabs.co.jp/pub/X11/kde/" |
| 317 | "http://kde.mirror.uber.com.au/") |
| 318 | (openbsd |
| 319 | "https://ftp.openbsd.org/pub/OpenBSD/" |
| 320 | ;; Anycast CDN redirecting to your friendly local mirror. |
| 321 | "https://mirrors.evowise.com/pub/OpenBSD/" |
| 322 | ;; Other HTTPS mirrors from https://www.openbsd.org/ftp.html |
| 323 | "https://mirror.aarnet.edu.au/pub/OpenBSD/" |
| 324 | "https://ftp2.eu.openbsd.org/pub/OpenBSD/" |
| 325 | "https://openbsd.c3sl.ufpr.br/pub/OpenBSD/" |
| 326 | "https://openbsd.ipacct.com/pub/OpenBSD/" |
| 327 | "https://ftp.OpenBSD.org/pub/OpenBSD/" |
| 328 | "https://openbsd.cs.toronto.edu/pub/OpenBSD/" |
| 329 | "https://openbsd.delfic.org/pub/OpenBSD/" |
| 330 | "https://openbsd.mirror.netelligent.ca/pub/OpenBSD/" |
| 331 | "https://mirrors.ucr.ac.cr/pub/OpenBSD/" |
| 332 | "https://mirrors.dotsrc.org/pub/OpenBSD/" |
| 333 | "https://mirror.one.com/pub/OpenBSD/" |
| 334 | "https://ftp.fr.openbsd.org/pub/OpenBSD/" |
| 335 | "https://ftp2.fr.openbsd.org/pub/OpenBSD/" |
| 336 | "https://mirrors.ircam.fr/pub/OpenBSD/" |
| 337 | "https://ftp.spline.de/pub/OpenBSD/" |
| 338 | "https://mirror.hs-esslingen.de/pub/OpenBSD/" |
| 339 | "https://ftp.halifax.rwth-aachen.de/openbsd/" |
| 340 | "https://ftp.hostserver.de/pub/OpenBSD/" |
| 341 | "https://ftp.fau.de/pub/OpenBSD/" |
| 342 | "https://ftp.cc.uoc.gr/pub/OpenBSD/" |
| 343 | "https://openbsd.hk/pub/OpenBSD/" |
| 344 | "https://ftp.heanet.ie/pub/OpenBSD/" |
| 345 | "https://openbsd.mirror.garr.it/pub/OpenBSD/" |
| 346 | "https://mirror.litnet.lt/pub/OpenBSD/" |
| 347 | "https://mirror.meerval.net/pub/OpenBSD/" |
| 348 | "https://ftp.nluug.nl/pub/OpenBSD/" |
| 349 | "https://ftp.bit.nl/pub/OpenBSD/" |
| 350 | "https://mirrors.dalenys.com/pub/OpenBSD/" |
| 351 | "https://ftp.icm.edu.pl/pub/OpenBSD/" |
| 352 | "https://ftp.rnl.tecnico.ulisboa.pt/pub/OpenBSD/" |
| 353 | "https://mirrors.pidginhost.com/pub/OpenBSD/" |
| 354 | "https://mirror.yandex.ru/pub/OpenBSD/" |
| 355 | "https://ftp.eu.openbsd.org/pub/OpenBSD/" |
| 356 | "https://ftp.yzu.edu.tw/pub/OpenBSD/" |
| 357 | "https://www.mirrorservice.org/pub/OpenBSD/" |
| 358 | "https://anorien.csc.warwick.ac.uk/pub/OpenBSD/" |
| 359 | "https://mirror.bytemark.co.uk/pub/OpenBSD/" |
| 360 | "https://mirrors.sonic.net/pub/OpenBSD/" |
| 361 | "https://ftp3.usa.openbsd.org/pub/OpenBSD/" |
| 362 | "https://mirrors.syringanetworks.net/pub/OpenBSD/" |
| 363 | "https://openbsd.mirror.constant.com/pub/OpenBSD/" |
| 364 | "https://ftp4.usa.openbsd.org/pub/OpenBSD/" |
| 365 | "https://ftp5.usa.openbsd.org/pub/OpenBSD/" |
| 366 | "https://mirror.esc7.net/pub/OpenBSD/") |
| 367 | (mate |
| 368 | "https://pub.mate-desktop.org/releases/" |
| 369 | "http://pub.mate-desktop.org/releases/")))) |
| 370 | |
| 371 | (define %mirror-file |
| 372 | ;; Copy of the list of mirrors to a file. This allows us to keep a single |
| 373 | ;; copy in the store, and computing it here avoids repeated calls to |
| 374 | ;; 'object->string'. |
| 375 | (plain-file "mirrors" (object->string %mirrors))) |
| 376 | |
| 377 | (define %content-addressed-mirrors |
| 378 | ;; List of content-addressed mirrors. Each mirror is represented as a |
| 379 | ;; procedure that takes a file name, an algorithm (symbol) and a hash |
| 380 | ;; (bytevector), and returns a URL or #f. |
| 381 | '(begin |
| 382 | (use-modules (guix base32)) |
| 383 | |
| 384 | (define (guix-publish host) |
| 385 | (lambda (file algo hash) |
| 386 | ;; Files served by 'guix publish' are accessible under a single |
| 387 | ;; hash algorithm. |
| 388 | (string-append "https://" host "/file/" |
| 389 | file "/" (symbol->string algo) "/" |
| 390 | (bytevector->nix-base32-string hash)))) |
| 391 | |
| 392 | ;; XXX: (guix base16) appeared in March 2017 (and thus 0.13.0) so old |
| 393 | ;; installations of the daemon might lack it. Thus, load it lazily to |
| 394 | ;; avoid gratuitous errors. See <https://bugs.gnu.org/33542>. |
| 395 | (module-autoload! (current-module) |
| 396 | '(guix base16) '(bytevector->base16-string)) |
| 397 | |
| 398 | (list (guix-publish "ci.guix.gnu.org") |
| 399 | (lambda (file algo hash) |
| 400 | ;; 'tarballs.nixos.org' supports several algorithms. |
| 401 | (string-append "https://tarballs.nixos.org/" |
| 402 | (symbol->string algo) "/" |
| 403 | (bytevector->nix-base32-string hash))) |
| 404 | (lambda (file algo hash) |
| 405 | ;; Software Heritage usually archives VCS history rather than |
| 406 | ;; tarballs, but tarballs are sometimes available (and can be |
| 407 | ;; explicitly stored there.) For example, see |
| 408 | ;; <https://archive.softwareheritage.org/api/1/content/sha256:92d0fa1c311cacefa89853bdb53c62f4110cdfda3820346b59cbd098f40f955e/>. |
| 409 | (string-append "https://archive.softwareheritage.org/api/1/content/" |
| 410 | (symbol->string algo) ":" |
| 411 | (bytevector->base16-string hash) "/raw/"))))) |
| 412 | |
| 413 | (define %content-addressed-mirror-file |
| 414 | ;; Content-addressed mirrors stored in a file. |
| 415 | (plain-file "content-addressed-mirrors" |
| 416 | (object->string %content-addressed-mirrors))) |
| 417 | |
| 418 | (define built-in-builders* |
| 419 | (store-lift built-in-builders)) |
| 420 | |
| 421 | (define* (built-in-download file-name url |
| 422 | #:key system hash-algo hash |
| 423 | mirrors content-addressed-mirrors |
| 424 | executable? |
| 425 | (guile 'unused)) |
| 426 | "Download FILE-NAME from URL using the built-in 'download' builder. When |
| 427 | EXECUTABLE? is true, make the downloaded file executable. |
| 428 | |
| 429 | This is an \"out-of-band\" download in that the returned derivation does not |
| 430 | explicitly depend on Guile, GnuTLS, etc. Instead, the daemon performs the |
| 431 | download by itself using its own dependencies." |
| 432 | (mlet %store-monad ((mirrors (lower-object mirrors)) |
| 433 | (content-addressed-mirrors |
| 434 | (lower-object content-addressed-mirrors))) |
| 435 | (raw-derivation file-name "builtin:download" '() |
| 436 | #:system system |
| 437 | #:hash-algo hash-algo |
| 438 | #:hash hash |
| 439 | #:recursive? executable? |
| 440 | #:sources (list mirrors content-addressed-mirrors) |
| 441 | |
| 442 | ;; Honor the user's proxy and locale settings. |
| 443 | #:leaked-env-vars '("http_proxy" "https_proxy" |
| 444 | "LC_ALL" "LC_MESSAGES" "LANG" |
| 445 | "COLUMNS") |
| 446 | |
| 447 | #:env-vars `(("url" . ,(object->string url)) |
| 448 | ("mirrors" . ,mirrors) |
| 449 | ("content-addressed-mirrors" |
| 450 | . ,content-addressed-mirrors) |
| 451 | ,@(if executable? |
| 452 | '(("executable" . "1")) |
| 453 | '())) |
| 454 | |
| 455 | ;; Do not offload this derivation because we cannot be |
| 456 | ;; sure that the remote daemon supports the 'download' |
| 457 | ;; built-in. We may remove this limitation when support |
| 458 | ;; for that built-in is widespread. |
| 459 | #:local-build? #t))) |
| 460 | |
| 461 | (define* (url-fetch url hash-algo hash |
| 462 | #:optional name |
| 463 | #:key (system (%current-system)) |
| 464 | (guile (default-guile)) |
| 465 | executable?) |
| 466 | "Return a fixed-output derivation that fetches URL (a string, or a list of |
| 467 | strings denoting alternate URLs), which is expected to have hash HASH of type |
| 468 | HASH-ALGO (a symbol). By default, the file name is the base name of URL; |
| 469 | optionally, NAME can specify a different file name. When EXECUTABLE? is true, |
| 470 | make the downloaded file executable. |
| 471 | |
| 472 | When one of the URL starts with mirror://, then its host part is |
| 473 | interpreted as the name of a mirror scheme, taken from %MIRROR-FILE. |
| 474 | |
| 475 | Alternately, when URL starts with file://, return the corresponding file name |
| 476 | in the store." |
| 477 | (define file-name |
| 478 | (match url |
| 479 | ((head _ ...) |
| 480 | (basename head)) |
| 481 | (_ |
| 482 | (basename url)))) |
| 483 | |
| 484 | (let ((uri (and (string? url) (string->uri url)))) |
| 485 | (if (or (and (string? url) (not uri)) |
| 486 | (and uri (memq (uri-scheme uri) '(#f file)))) |
| 487 | (interned-file (if uri (uri-path uri) url) |
| 488 | (or name file-name)) |
| 489 | (mlet %store-monad ((builtins (built-in-builders*))) |
| 490 | ;; The "download" built-in builder was added in guix-daemon in |
| 491 | ;; Nov. 2016 and made it in the 0.12.0 release of Dec. 2016. We now |
| 492 | ;; require it. |
| 493 | (unless (member "download" builtins) |
| 494 | (error "'guix-daemon' is too old, please upgrade" builtins)) |
| 495 | |
| 496 | (built-in-download (or name file-name) url |
| 497 | #:guile guile |
| 498 | #:system system |
| 499 | #:hash-algo hash-algo |
| 500 | #:hash hash |
| 501 | #:executable? executable? |
| 502 | #:mirrors %mirror-file |
| 503 | #:content-addressed-mirrors |
| 504 | %content-addressed-mirror-file))))) |
| 505 | |
| 506 | (define* (url-fetch/executable url hash-algo hash |
| 507 | #:optional name |
| 508 | #:key (system (%current-system)) |
| 509 | (guile (default-guile))) |
| 510 | "Like 'url-fetch', but make the downloaded file executable." |
| 511 | (url-fetch url hash-algo hash name |
| 512 | #:system system |
| 513 | #:guile guile |
| 514 | #:executable? #t)) |
| 515 | |
| 516 | (define* (url-fetch/tarbomb url hash-algo hash |
| 517 | #:optional name |
| 518 | #:key (system (%current-system)) |
| 519 | (guile (default-guile))) |
| 520 | "Similar to 'url-fetch' but unpack the file from URL in a directory of its |
| 521 | own. This helper makes it easier to deal with \"tar bombs\"." |
| 522 | (define file-name |
| 523 | (match url |
| 524 | ((head _ ...) |
| 525 | (basename head)) |
| 526 | (_ |
| 527 | (basename url)))) |
| 528 | (define gzip |
| 529 | (module-ref (resolve-interface '(gnu packages compression)) 'gzip)) |
| 530 | (define tar |
| 531 | (module-ref (resolve-interface '(gnu packages base)) 'tar)) |
| 532 | |
| 533 | (mlet %store-monad ((drv (url-fetch url hash-algo hash |
| 534 | (string-append "tarbomb-" |
| 535 | (or name file-name)) |
| 536 | #:system system |
| 537 | #:guile guile)) |
| 538 | (guile (package->derivation guile system))) |
| 539 | ;; Take the tar bomb, and simply unpack it as a directory. |
| 540 | ;; Use ungrafted tar/gzip so that the resulting tarball doesn't depend on |
| 541 | ;; whether grafts are enabled. |
| 542 | (gexp->derivation (or name file-name) |
| 543 | (with-imported-modules '((guix build utils)) |
| 544 | #~(begin |
| 545 | (use-modules (guix build utils)) |
| 546 | (mkdir #$output) |
| 547 | (setenv "PATH" (string-append #$gzip "/bin")) |
| 548 | (chdir #$output) |
| 549 | (invoke (string-append #$tar "/bin/tar") |
| 550 | "xf" #$drv))) |
| 551 | #:system system |
| 552 | #:guile-for-build guile |
| 553 | #:graft? #f |
| 554 | #:local-build? #t))) |
| 555 | |
| 556 | (define* (url-fetch/zipbomb url hash-algo hash |
| 557 | #:optional name |
| 558 | #:key (system (%current-system)) |
| 559 | (guile (default-guile))) |
| 560 | "Similar to 'url-fetch' but unpack the zip file at URL in a directory of its |
| 561 | own. This helper makes it easier to deal with \"zip bombs\"." |
| 562 | (define file-name |
| 563 | (match url |
| 564 | ((head _ ...) |
| 565 | (basename head)) |
| 566 | (_ |
| 567 | (basename url)))) |
| 568 | (define unzip |
| 569 | (module-ref (resolve-interface '(gnu packages compression)) 'unzip)) |
| 570 | |
| 571 | (mlet %store-monad ((drv (url-fetch url hash-algo hash |
| 572 | (string-append "zipbomb-" |
| 573 | (or name file-name)) |
| 574 | #:system system |
| 575 | #:guile guile)) |
| 576 | (guile (package->derivation guile system))) |
| 577 | ;; Take the zip bomb, and simply unpack it as a directory. |
| 578 | ;; Use ungrafted unzip so that the resulting tarball doesn't depend on |
| 579 | ;; whether grafts are enabled. |
| 580 | (gexp->derivation (or name file-name) |
| 581 | (with-imported-modules '((guix build utils)) |
| 582 | #~(begin |
| 583 | (use-modules (guix build utils)) |
| 584 | (mkdir #$output) |
| 585 | (chdir #$output) |
| 586 | (invoke (string-append #$unzip "/bin/unzip") |
| 587 | #$drv))) |
| 588 | #:system system |
| 589 | #:guile-for-build guile |
| 590 | #:graft? #f |
| 591 | #:local-build? #t))) |
| 592 | |
| 593 | (define* (download-to-store store url #:optional (name (basename url)) |
| 594 | #:key (log (current-error-port)) recursive? |
| 595 | (verify-certificate? #t)) |
| 596 | "Download from URL to STORE, either under NAME or URL's basename if |
| 597 | omitted. Write progress reports to LOG. RECURSIVE? has the same effect as |
| 598 | the same-named parameter of 'add-to-store'. VERIFY-CERTIFICATE? determines |
| 599 | whether or not to validate HTTPS server certificates." |
| 600 | (define uri |
| 601 | (string->uri url)) |
| 602 | |
| 603 | (if (or (not uri) (memq (uri-scheme uri) '(file #f))) |
| 604 | (add-to-store store name recursive? "sha256" |
| 605 | (if uri (uri-path uri) url)) |
| 606 | (call-with-temporary-output-file |
| 607 | (lambda (temp port) |
| 608 | (let ((result |
| 609 | (parameterize ((current-output-port log)) |
| 610 | (build:url-fetch url temp |
| 611 | #:mirrors %mirrors |
| 612 | #:verify-certificate? |
| 613 | verify-certificate?)))) |
| 614 | (close port) |
| 615 | (and result |
| 616 | (add-to-store store name recursive? "sha256" temp))))))) |
| 617 | |
| 618 | ;;; download.scm ends here |