[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/05: download: Remove (web http) workarounds no longer relevant.
|
From: |
guix-commits |
|
Subject: |
03/05: download: Remove (web http) workarounds no longer relevant. |
|
Date: |
Wed, 11 Mar 2020 13:42:20 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit d8a822f4620857bb31b24d71ff80840442ec694b
Author: Ludovic Courtès <address@hidden>
AuthorDate: Wed Mar 11 16:19:38 2020 +0100
download: Remove (web http) workarounds no longer relevant.
* guix/build/download.scm <top level>: Remove workarounds for
<https://bugs.gnu.org/23421> and for
<https://lists.gnu.org/archive/html/guix-devel/2017-11/msg00070.html>.
---
guix/build/download.scm | 129 ------------------------------------------------
1 file changed, 129 deletions(-)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 0f2d5f4..c647d00 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -457,135 +457,6 @@ VERIFY-CERTIFICATE? is true, verify HTTPS server
certificates."
'set-port-encoding!
(lambda (p e) #f))
-;; XXX: Work around <http://bugs.gnu.org/23421>, fixed in Guile commit
-;; 16050431f29d56f80c4a8253506fc851b8441840. Guile's date validation
-;; procedure rejects dates in which the hour is not padded with a zero but
-;; with whitespace.
-(begin
- (define-syntax string-match?
- (lambda (x)
- (syntax-case x ()
- ((_ str pat) (string? (syntax->datum #'pat))
- (let ((p (syntax->datum #'pat)))
- #`(let ((s str))
- (and
- (= (string-length s) #,(string-length p))
- #,@(let lp ((i 0) (tests '()))
- (if (< i (string-length p))
- (let ((c (string-ref p i)))
- (lp (1+ i)
- (case c
- ((#\.) ; Whatever.
- tests)
- ((#\d) ; Digit.
- (cons #`(char-numeric? (string-ref s #,i))
- tests))
- ((#\a) ; Alphabetic.
- (cons #`(char-alphabetic? (string-ref s #,i))
- tests))
- (else ; Literal.
- (cons #`(eqv? (string-ref s #,i) #,c)
- tests)))))
- tests)))))))))
-
- (define (parse-rfc-822-date str space zone-offset)
- (let ((parse-non-negative-integer (@@ (web http)
parse-non-negative-integer))
- (parse-month (@@ (web http) parse-month))
- (bad-header (@@ (web http) bad-header)))
- ;; We could verify the day of the week but we don't.
- (cond ((string-match? (substring str 0 space) "aaa, dd aaa dddd
dd:dd:dd")
- (let ((date (parse-non-negative-integer str 5 7))
- (month (parse-month str 8 11))
- (year (parse-non-negative-integer str 12 16))
- (hour (parse-non-negative-integer str 17 19))
- (minute (parse-non-negative-integer str 20 22))
- (second (parse-non-negative-integer str 23 25)))
- (make-date 0 second minute hour date month year zone-offset)))
- ((string-match? (substring str 0 space) "aaa, d aaa dddd dd:dd:dd")
- (let ((date (parse-non-negative-integer str 5 6))
- (month (parse-month str 7 10))
- (year (parse-non-negative-integer str 11 15))
- (hour (parse-non-negative-integer str 16 18))
- (minute (parse-non-negative-integer str 19 21))
- (second (parse-non-negative-integer str 22 24)))
- (make-date 0 second minute hour date month year zone-offset)))
-
- ;; The next two clauses match dates that have a space instead of
- ;; a leading zero for hours, like " 8:49:37".
- ((string-match? (substring str 0 space) "aaa, dd aaa dddd
d:dd:dd")
- (let ((date (parse-non-negative-integer str 5 7))
- (month (parse-month str 8 11))
- (year (parse-non-negative-integer str 12 16))
- (hour (parse-non-negative-integer str 18 19))
- (minute (parse-non-negative-integer str 20 22))
- (second (parse-non-negative-integer str 23 25)))
- (make-date 0 second minute hour date month year zone-offset)))
- ((string-match? (substring str 0 space) "aaa, d aaa dddd d:dd:dd")
- (let ((date (parse-non-negative-integer str 5 6))
- (month (parse-month str 7 10))
- (year (parse-non-negative-integer str 11 15))
- (hour (parse-non-negative-integer str 17 18))
- (minute (parse-non-negative-integer str 19 21))
- (second (parse-non-negative-integer str 22 24)))
- (make-date 0 second minute hour date month year zone-offset)))
-
- (else
- (bad-header 'date str) ; prevent tail call
- #f))))
- (module-set! (resolve-module '(web http))
- 'parse-rfc-822-date parse-rfc-822-date))
-
-;; XXX: Work around broken proxy handling on Guile 2.2 <= 2.2.2, fixed in
-;; Guile commits 7d0d9e2c25c1e872cfc7d14ab5139915f1813d56 and
-;; 6ad28ae3bc6a6d9e95ab7d70510d12c97673a143. 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 #\[) ;<---- And here!
- (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.