diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-01-20 22:28:38 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-01-20 22:54:36 +0100 |
commit | 483f11589efe7f9bfab561dc48f26b01096e7996 (patch) | |
tree | 26c6cf1d3410033063753bc1c73029e1f1995921 /guix/download.scm | |
parent | e509d1527d231b6460a20762e13b57cba2e43485 (diff) |
download: Add HTTPS support.
* guix/build/download.scm: Autoload (gnutls).
(tls-wrap): New procedure.
(open-connection-for-uri): Add support for `https'. Wrap the socket
with `tls-wrap' in that case.
(url-fetch): Add `https'.
* guix/download.scm (gnutls-derivation): New procedure.
(url-fetch)[need-gnutls?]: New variable.
Call `gnutls-derivation' when NEED-GNUTLS? is true, and add its output
to the `GUILE_LOAD_PATH' env. var. in that case.
Diffstat (limited to 'guix/download.scm')
-rw-r--r-- | guix/download.scm | 55 |
1 files changed, 46 insertions, 9 deletions
diff --git a/guix/download.scm b/guix/download.scm index cf68ade74b..316bee97db 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +22,8 @@ #: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 url-fetch)) @@ -91,6 +93,11 @@ "http://kernel.osuosl.org/pub/" "ftp://ftp.funet.fi/pub/mirrors/ftp.kernel.org/pub/")))) +(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 @@ -129,13 +136,43 @@ must be a list of symbol/URL-list pairs." (_ (basename url)))) - (build-expression->derivation store (or name file-name) system - builder '() - #:hash-algo hash-algo - #:hash hash - #:modules '((guix build download) - (guix build utils) - (guix ftp-client)) - #:guile-for-build guile-for-build)) + (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))) + ((gnutls) + (and gnutls-drv + (derivation-output-path + (assoc-ref (derivation-outputs gnutls-drv) + "out")))) + ((env-vars) + (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 + builder + (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 |