summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2017-03-01 22:11:02 +0100
committerMarius Bakke <mbakke@fastmail.com>2017-03-12 19:39:32 +0100
commit7e81d699de7a2c924a048175516fe1ac3820d8e6 (patch)
tree0fe5baca4c6b0b26ef58277344a91e08ebdfa59b
parent720cb10c15a4606fe0dc3511db4fef325f3d9dc6 (diff)
downloadpatches-7e81d699de7a2c924a048175516fe1ac3820d8e6.tar
patches-7e81d699de7a2c924a048175516fe1ac3820d8e6.tar.gz
pull: Default to HTTPS.
* guix/scripts/pull.scm (%snapshot-url): Use HTTPS. (guix-pull): Authenticate against LE-CERTS when URL is from Savannah.
-rw-r--r--guix/scripts/pull.scm22
1 files changed, 20 insertions, 2 deletions
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index a4824e4fd7..8e31ad620c 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,10 +30,13 @@
#:use-module (guix monads)
#:use-module ((guix build utils)
#:select (with-directory-excursion delete-file-recursively))
+ #:use-module ((guix build download)
+ #:select (%x509-certificate-directory))
#:use-module (gnu packages base)
#:use-module (gnu packages guile)
#:use-module ((gnu packages bootstrap)
#:select (%bootstrap-guile))
+ #:use-module ((gnu packages certs) #:select (le-certs))
#:use-module (gnu packages compression)
#:use-module (gnu packages gnupg)
#:use-module (srfi srfi-1)
@@ -45,7 +49,7 @@
(define %snapshot-url
;; "http://hydra.gnu.org/job/guix/master/tarball/latest/download"
- "http://git.savannah.gnu.org/cgit/guix.git/snapshot/master.tar.gz"
+ "https://git.savannah.gnu.org/cgit/guix.git/snapshot/master.tar.gz"
)
(define-syntax-rule (with-environment-variable variable value body ...)
@@ -221,11 +225,25 @@ contained therein."
(leave (_ "~A: unexpected argument~%") arg))
%default-options))
+ (define (use-le-certs? url)
+ (string-prefix? "https://git.savannah.gnu.org/" url))
+
+ (define (fetch-tarball store url)
+ (download-to-store store url "guix-latest.tar.gz"))
+
(with-error-handling
(let* ((opts (parse-options))
(store (open-connection))
(url (assoc-ref opts 'tarball-url)))
- (let ((tarball (download-to-store store url "guix-latest.tar.gz")))
+ (let ((tarball
+ (if (use-le-certs? url)
+ (let* ((drv (package-derivation store le-certs))
+ (certs (string-append (derivation->output-path drv)
+ "/etc/ssl/certs")))
+ (build-derivations store (list drv))
+ (parameterize ((%x509-certificate-directory certs))
+ (fetch-tarball store url)))
+ (fetch-tarball store url))))
(unless tarball
(leave (_ "failed to download up-to-date source, exiting\n")))
(parameterize ((%guile-for-build