me
/
guix
Archived
1
0
Fork 0
Code

http-client: Avoid name clash with 'open-connection-for-uri' in 2.2.0. 

* guix/build/download.scm (open-connection-for-uri): Add note about
same-named binding in Guile 2.2.0.
* guix/http-client.scm: Use 'guix:open-connection-for-uri' for the
procedure coming from (guix build download).
* guix/scripts/lint.scm: Likewise.
* guix/scripts/substitute.scm: Likewise.
master
Ludovic Courtès 2017-03-17 23:41:37 +01:00
parent 36626c556e
commit 4fd06a4dd1
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
4 changed files with 26 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
guix/build/download.scm
View File

@ -464,6 +464,9 @@ ETIMEDOUT error is raised."
"Like 'open-socket-for-uri', but also handle HTTPS connections. The "Like 'open-socket-for-uri', but also handle HTTPS connections. The
resulting port must be closed with 'close-connection'. When resulting port must be closed with 'close-connection'. When
VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." 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? (define https?
(eq? 'https (uri-scheme uri))) (eq? 'https (uri-scheme uri)))

10
guix/http-client.scm
View File

@ -38,7 +38,9 @@
#:select (mkdir-p dump-port)) #:select (mkdir-p dump-port))
#:use-module ((guix build download) #:use-module ((guix build download)
#:select (open-socket-for-uri #: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) #:re-export (open-socket-for-uri)
#:export (&http-get-error #:export (&http-get-error
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) (let loop ((uri (if (string? uri)
(string->uri uri) (string->uri uri)
uri))) uri)))
(let ((port (or port (open-connection-for-uri uri (let ((port (or port (guix:open-connection-for-uri uri
#:verify-certificate? #:verify-certificate?
verify-certificate?))) verify-certificate?)))
(headers (match (uri-userinfo uri) (headers (match (uri-userinfo uri)
((? string? str) ((? string? str)
(cons (cons 'Authorization (cons (cons 'Authorization

6
guix/scripts/lint.scm
View File

@ -44,7 +44,8 @@
#:use-module (web uri) #:use-module (web uri)
#:use-module ((guix build download) #:use-module ((guix build download)
#:select (maybe-expand-mirrors #:select (maybe-expand-mirrors
open-connection-for-uri (open-connection-for-uri
. guix:open-connection-for-uri)
close-connection)) close-connection))
#:use-module (web request) #:use-module (web request)
#:use-module (web response) #:use-module (web response)
@ -377,7 +378,8 @@ for connections to complete; when TIMEOUT is #f, wait as long as needed."
((or 'http 'https) ((or 'http 'https)
(catch #t (catch #t
(lambda () (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))) (request (build-request uri #:headers headers)))
(define response (define response
(dynamic-wind (dynamic-wind

23
guix/scripts/substitute.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -34,7 +34,8 @@
#:use-module ((guix build download) #:use-module ((guix build download)
#:select (current-terminal-columns #:select (current-terminal-columns
progress-proc uri-abbreviation nar-uri-abbreviation progress-proc uri-abbreviation nar-uri-abbreviation
open-connection-for-uri (open-connection-for-uri
. guix:open-connection-for-uri)
close-connection close-connection
store-path-abbreviation byte-count->string)) store-path-abbreviation byte-count->string))
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
@ -210,8 +211,8 @@ provide."
(close-connection port)))) (close-connection port))))
(begin (begin
(when (or (not port) (port-closed? port)) (when (or (not port) (port-closed? port))
(set! port (open-connection-for-uri uri (set! port (guix:open-connection-for-uri
#:verify-certificate? #f)) uri #:verify-certificate? #f))
(unless (or buffered? (not (file-port? port))) (unless (or buffered? (not (file-port? port)))
(setvbuf port _IONBF))) (setvbuf port _IONBF)))
(http-fetch uri #:text? #f #:port port (http-fetch uri #:text? #f #:port port
@ -247,9 +248,10 @@ failure, return #f and #f."
read-cache-info) read-cache-info)
#f)) #f))
((http https) ((http https)
(let ((port (open-connection-for-uri uri (let ((port (guix:open-connection-for-uri
#:verify-certificate? #f uri
#:timeout %fetch-timeout))) #:verify-certificate? #f
#:timeout %fetch-timeout)))
(guard (c ((http-get-error? c) (guard (c ((http-get-error? c)
(warning (_ "while fetching '~a': ~a (~s)~%") (warning (_ "while fetching '~a': ~a (~s)~%")
(uri->string (http-get-error-uri c)) (uri->string (http-get-error-uri c))
@ -533,9 +535,10 @@ initial connection on which HTTP requests are sent."
(result seed)) (result seed))
;; (format (current-error-port) "connecting (~a requests left)..." ;; (format (current-error-port) "connecting (~a requests left)..."
;; (length requests)) ;; (length requests))
(let ((p (or port (open-connection-for-uri base-uri (let ((p (or port (guix:open-connection-for-uri
#:verify-certificate? base-uri
verify-certificate?)))) #:verify-certificate?
verify-certificate?))))
;; For HTTPS, P is not a file port and does not support 'setvbuf'. ;; For HTTPS, P is not a file port and does not support 'setvbuf'.
(when (file-port? p) (when (file-port? p)
(setvbuf p _IOFBF (expt 2 16))) (setvbuf p _IOFBF (expt 2 16)))