guix/download.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix download)
  20   #:use-module (ice-9 match)
  21   #:use-module (guix derivations)
  22   #:use-module (guix packages)
  23   #:use-module ((guix store) #:select (derivation-path?))
  24   #:use-module (guix utils)
  25   #:use-module (srfi srfi-26)
  26   #:export (%mirrors
  27             url-fetch))
  28
  29 ;;; Commentary:
  30 ;;;
  31 ;;; Produce fixed-output derivations with data fetched over HTTP or FTP.
  32 ;;;
  33 ;;; Code:
  34
  35 (define %mirrors
  36   ;; Mirror lists used when `mirror://' URLs are passed.
  37   (let* ((gnu-mirrors
  38           '(;; This one redirects to a (supposedly) nearby and (supposedly)
  39             ;; up-to-date mirror.
  40             "http://ftpmirror.gnu.org/"
  41
  42             "ftp://ftp.cs.tu-berlin.de/pub/gnu/"
  43             "ftp://ftp.chg.ru/pub/gnu/"
  44             "ftp://ftp.funet.fi/pub/mirrors/ftp.gnu.org/gnu/"
  45
  46             ;; This one is the master repository, and thus it's always
  47             ;; up-to-date.
  48             "http://ftp.gnu.org/pub/gnu/")))
  49     `((gnu ,@gnu-mirrors)
  50       (gcc
  51        "ftp://ftp.nluug.nl/mirror/languages/gcc/"
  52        "ftp://ftp.fu-berlin.de/unix/languages/gcc/"
  53        "ftp://ftp.irisa.fr/pub/mirrors/gcc.gnu.org/gcc/"
  54        "ftp://gcc.gnu.org/pub/gcc/"
  55        ,@(map (cut string-append <> "/gcc") gnu-mirrors))
  56       (gnupg
  57        "ftp://gd.tuwien.ac.at/privacy/gnupg/"
  58        "ftp://gnupg.x-zone.org/pub/gnupg/"
  59        "ftp://ftp.gnupg.cz/pub/gcrypt/"
  60        "ftp://sunsite.dk/pub/security/gcrypt/"
  61        "http://gnupg.wildyou.net/"
  62        "http://ftp.gnupg.zone-h.org/"
  63        "ftp://ftp.jyu.fi/pub/crypt/gcrypt/"
  64        "ftp://trumpetti.atm.tut.fi/gcrypt/"
  65        "ftp://mirror.cict.fr/gnupg/"
  66        "ftp://ftp.strasbourg.linuxfr.org/pub/gnupg/")
  67       (savannah
  68        "http://download.savannah.gnu.org/releases/"
  69        "ftp://ftp.twaren.net/Unix/NonGNU/"
  70        "ftp://mirror.csclub.uwaterloo.ca/nongnu/"
  71        "ftp://mirror.publicns.net/pub/nongnu/"
  72        "ftp://savannah.c3sl.ufpr.br/"
  73        "http://ftp.cc.uoc.gr/mirrors/nongnu.org/"
  74        "http://ftp.twaren.net/Unix/NonGNU/"
  75        "http://mirror.csclub.uwaterloo.ca/nongnu/"
  76        "http://nongnu.askapache.com/"
  77        "http://savannah.c3sl.ufpr.br/"
  78        "http://www.centervenus.com/mirrors/nongnu/")
  79       (sourceforge
  80        "http://prdownloads.sourceforge.net/"
  81        "http://heanet.dl.sourceforge.net/sourceforge/"
  82        "http://surfnet.dl.sourceforge.net/sourceforge/"
  83        "http://dfn.dl.sourceforge.net/sourceforge/"
  84        "http://mesh.dl.sourceforge.net/sourceforge/"
  85        "http://ovh.dl.sourceforge.net/sourceforge/"
  86        "http://osdn.dl.sourceforge.net/sourceforge/")
  87       (kernel.org
  88        "http://www.all.kernel.org/pub/"
  89        "http://ramses.wh2.tu-dresden.de/pub/mirrors/kernel.org/"
  90        "http://linux-kernel.uio.no/pub/"
  91        "http://kernel.osuosl.org/pub/"
  92        "ftp://ftp.funet.fi/pub/mirrors/ftp.kernel.org/pub/"))))
  93
  94
  95 (define* (url-fetch store url hash-algo hash
  96                     #:optional name
  97                     #:key (system (%current-system)) guile
  98                     (mirrors %mirrors))
  99   "Return the path of a fixed-output derivation in STORE that fetches
 100 URL (a string, or a list of strings denoting alternate URLs), which is
 101 expected to have hash HASH of type HASH-ALGO (a symbol).  By default,
 102 the file name is the base name of URL; optionally, NAME can specify a
 103 different file name.
 104
 105 When one of the URL starts with mirror://, then its host part is
 106 interpreted as the name of a mirror scheme, taken from MIRRORS; MIRRORS
 107 must be a list of symbol/URL-list pairs."
 108   (define builder
 109     `(begin
 110        (use-modules (guix build download))
 111        (url-fetch ',url %output
 112                   #:mirrors ',mirrors)))
 113
 114   (define guile-for-build
 115     (match guile
 116       ((? package?)
 117        (package-derivation store guile system))
 118       ((and (? string?) (? derivation-path?))
 119        guile)
 120       (#f                                         ; the default
 121        (let* ((distro (resolve-interface '(distro packages base)))
 122               (guile  (module-ref distro 'guile-final)))
 123          (package-derivation store guile system)))))
 124
 125   (define file-name
 126     (match url
 127       ((head _ ...)
 128        (basename head))
 129       (_
 130        (basename url))))
 131
 132   (build-expression->derivation store (or name file-name) system
 133                                 builder '()
 134                                 #:hash-algo hash-algo
 135                                 #:hash hash
 136                                 #:modules '((guix build download)
 137                                             (guix build utils)
 138                                             (guix ftp-client))
 139                                 #:guile-for-build guile-for-build))
 140
 141 ;;; download.scm ends here