You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

178 lines
6.9 KiB

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 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
;;; 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 download)
#:use-module (ice-9 match)
#:use-module (guix derivations)
#:use-module (guix packages)
#:use-module ((guix store) #:select (derivation-path?))
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:export (%mirrors
;;; Commentary:
;;; Produce fixed-output derivations with data fetched over HTTP or FTP.
;;; Code:
(define %mirrors
;; Mirror lists used when `mirror://' URLs are passed.
(let* ((gnu-mirrors
'(;; This one redirects to a (supposedly) nearby and (supposedly)
;; up-to-date mirror.
;; This one is the master repository, and thus it's always
;; up-to-date.
`((gnu ,@gnu-mirrors)
,@(map (cut string-append <> "/gcc") gnu-mirrors))
(define (gnutls-derivation store system)
"Return the GnuTLS derivation for SYSTEM."
(let* ((module (resolve-interface '(gnu packages gnutls)))
(gnutls (module-ref module 'gnutls)))
(package-derivation store gnutls system)))
(define* (url-fetch store url hash-algo hash
#:optional name
#:key (system (%current-system)) guile
(mirrors %mirrors))
"Return the path of a fixed-output derivation in STORE 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 one of the URL starts with mirror://, then its host part is
interpreted as the name of a mirror scheme, taken from MIRRORS; MIRRORS
must be a list of symbol/URL-list pairs."
(define builder
(use-modules (guix build download))
(url-fetch ',url %output
#:mirrors ',mirrors)))
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
((and (? string?) (? derivation-path?))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages base)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(define file-name
(match url
((head _ ...)
(basename head))
(basename url))))
(define need-gnutls?
;; True if any of the URLs need TLS support.
(let ((https? (cut string-prefix? "https://" <>)))
(match url
((? string?)
(https? url))
((url ...)
(any https? url)))))
(let*-values (((gnutls-drv-path gnutls-drv)
(if need-gnutls?
(gnutls-derivation store system)
(values #f #f)))
(and gnutls-drv
(assoc-ref (derivation-outputs gnutls-drv)
(if gnutls
(let ((dir (string-append gnutls "/share/guile/site")))
;; XXX: `GUILE_LOAD_COMPILED_PATH' is overridden
;; by `build-expression->derivation', so we can't
;; set it here.
`(("GUILE_LOAD_PATH" . ,dir)))
(build-expression->derivation store (or name file-name) system
(if gnutls-drv
`(("gnutls" ,gnutls-drv-path))
#:hash-algo hash-algo
#:hash hash
#:modules '((guix build download)
(guix build utils)
(guix ftp-client))
#:guile-for-build guile-for-build
#:env-vars env-vars)))
;;; download.scm ends here