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>.

1 files changed, 0 insertions, 129 deletions

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 0f2d5f402a..c647d00f6b 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.