[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/01: download: Work around bogus HTTP handling in Guile 2.2 <= 2.2.2.
From: |
Ludovic Courtès |
Subject: |
01/01: download: Work around bogus HTTP handling in Guile 2.2 <= 2.2.2. |
Date: |
Fri, 10 Nov 2017 17:12:27 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit 59da6f04f45b36696a9385babab3080d7d854fba
Author: Ludovic Courtès <address@hidden>
Date: Fri Nov 10 23:07:49 2017 +0100
download: Work around bogus HTTP handling in Guile 2.2 <= 2.2.2.
Reported by Konrad Hinsen <address@hidden>
at <https://lists.gnu.org/archive/html/guix-devel/2017-11/msg00070.html>.
* guix/build/download.scm (write-request-line) [guile-2.2]: New
procedure.
---
guix/build/download.scm | 50 +++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 50 insertions(+)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 61c9c6d..790576b 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -513,6 +513,56 @@ port if PORT is a TLS session record port."
(let ((declare-relative-uri-header! (variable-ref var)))
(declare-relative-uri-header! "Location")))))
+;; XXX: Work around broken proxy handling on Guile 2.2 <= 2.2.2, fixed in
+;; Guile commit 7d0d9e2c25c1e872cfc7d14ab5139915f1813d56. See bug report at
+;; <https://lists.gnu.org/archive/html/guix-devel/2017-11/msg00070.html>.
+(cond-expand
+ (guile-2.2
+ (when (<= (string->number (micro-version)) 2)
+ (let ()
+ (define put-symbol (@@ (web http) put-symbol))
+ (define put-non-negative-integer
+ (@@ (web http) put-non-negative-integer))
+ (define write-http-version
+ (@@ (web http) write-http-version))
+
+ (define (write-request-line method uri version port)
+ "Write the first line of an HTTP request to PORT."
+ (put-symbol port method)
+ (put-char port #\space)
+ (when (http-proxy-port? port)
+ (let ((scheme (uri-scheme uri))
+ (host (uri-host uri))
+ (host-port (uri-port uri)))
+ (when (and scheme host)
+ (put-symbol port scheme)
+ (put-string port "://")
+ (cond
+ ((string-index host #\:) ;<---- The fix is here!
+ (put-char #\[ port)
+ (put-string port host
+ (put-char port #\])))
+ (else
+ (put-string port host)))
+ (unless ((@@ (web uri) default-port?) scheme host-port)
+ (put-char port #\:)
+ (put-non-negative-integer port host-port)))))
+ (let ((path (uri-path uri))
+ (query (uri-query uri)))
+ (if (string-null? path)
+ (put-string port "/")
+ (put-string port path))
+ (when query
+ (put-string port "?")
+ (put-string port query)))
+ (put-char port #\space)
+ (write-http-version version port)
+ (put-string port "\r\n"))
+
+ (module-set! (resolve-module '(web http)) 'write-request-line
+ write-request-line))))
+ (else #t))
+
(define (resolve-uri-reference ref base)
"Resolve the URI reference REF, interpreted relative to the BASE URI, into a
target URI, according to the algorithm specified in RFC 3986 section 5.2.2.