diff options
| -rw-r--r-- | guix/build/download.scm | 3 | ||||
| -rw-r--r-- | guix/http-client.scm | 10 | ||||
| -rw-r--r-- | guix/scripts/lint.scm | 6 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 23 |
4 files changed, 26 insertions, 16 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm index d956a9f33e..36c815c167 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -464,6 +464,9 @@ ETIMEDOUT error is raised." "Like 'open-socket-for-uri', but also handle HTTPS connections. The resulting port must be closed with 'close-connection'. When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." + ;; Note: Guile 2.2.0's (web client) has a same-named export that's actually + ;; undefined. See Guile commit 011669af3b428e5626f7bbf66b11d57d9768c047. + (define https? (eq? 'https (uri-scheme uri))) diff --git a/guix/http-client.scm b/guix/http-client.scm index 855ae95a43..6874c51db6 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -38,7 +38,9 @@ #:select (mkdir-p dump-port)) #:use-module ((guix build download) #:select (open-socket-for-uri - open-connection-for-uri resolve-uri-reference)) + (open-connection-for-uri + . guix:open-connection-for-uri) + resolve-uri-reference)) #:re-export (open-socket-for-uri) #:export (&http-get-error http-get-error? @@ -234,9 +236,9 @@ Raise an '&http-get-error' condition if downloading fails." (let loop ((uri (if (string? uri) (string->uri uri) uri))) - (let ((port (or port (open-connection-for-uri uri - #:verify-certificate? - verify-certificate?))) + (let ((port (or port (guix:open-connection-for-uri uri + #:verify-certificate? + verify-certificate?))) (headers (match (uri-userinfo uri) ((? string? str) (cons (cons 'Authorization diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 776e7332c5..66c82f0409 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -44,7 +44,8 @@ #:use-module (web uri) #:use-module ((guix build download) #:select (maybe-expand-mirrors - open-connection-for-uri + (open-connection-for-uri + . guix:open-connection-for-uri) close-connection)) #:use-module (web request) #:use-module (web response) @@ -377,7 +378,8 @@ for connections to complete; when TIMEOUT is #f, wait as long as needed." ((or 'http 'https) (catch #t (lambda () - (let ((port (open-connection-for-uri uri #:timeout timeout)) + (let ((port (guix:open-connection-for-uri + uri #:timeout timeout)) (request (build-request uri #:headers headers))) (define response (dynamic-wind diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 524b019a31..faeb019120 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> ;;; ;;; This file is part of GNU Guix. @@ -34,7 +34,8 @@ #:use-module ((guix build download) #:select (current-terminal-columns progress-proc uri-abbreviation nar-uri-abbreviation - open-connection-for-uri + (open-connection-for-uri + . guix:open-connection-for-uri) close-connection store-path-abbreviation byte-count->string)) #:use-module (ice-9 rdelim) @@ -210,8 +211,8 @@ provide." (close-connection port)))) (begin (when (or (not port) (port-closed? port)) - (set! port (open-connection-for-uri uri - #:verify-certificate? #f)) + (set! port (guix:open-connection-for-uri + uri #:verify-certificate? #f)) (unless (or buffered? (not (file-port? port))) (setvbuf port _IONBF))) (http-fetch uri #:text? #f #:port port @@ -247,9 +248,10 @@ failure, return #f and #f." read-cache-info) #f)) ((http https) - (let ((port (open-connection-for-uri uri - #:verify-certificate? #f - #:timeout %fetch-timeout))) + (let ((port (guix:open-connection-for-uri + uri + #:verify-certificate? #f + #:timeout %fetch-timeout))) (guard (c ((http-get-error? c) (warning (_ "while fetching '~a': ~a (~s)~%") (uri->string (http-get-error-uri c)) @@ -533,9 +535,10 @@ initial connection on which HTTP requests are sent." (result seed)) ;; (format (current-error-port) "connecting (~a requests left)..." ;; (length requests)) - (let ((p (or port (open-connection-for-uri base-uri - #:verify-certificate? - verify-certificate?)))) + (let ((p (or port (guix:open-connection-for-uri + base-uri + #:verify-certificate? + verify-certificate?)))) ;; For HTTPS, P is not a file port and does not support 'setvbuf'. (when (file-port? p) (setvbuf p _IOFBF (expt 2 16))) |