From mboxrd@z Thu Jan 1 00:00:00 1970 From: Ricardo Wurmus Subject: Re: HTTP server invalid date header Date: Fri, 29 Apr 2016 22:15:10 +0200 Message-ID: <87twikw4s1.fsf@elephly.net> References: <877ffgphrb.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:40694) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1awEpV-0000BV-7K for guix-devel@gnu.org; Fri, 29 Apr 2016 16:16:08 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1awEpI-0005QZ-Mw for guix-devel@gnu.org; Fri, 29 Apr 2016 16:15:55 -0400 In-reply-to: <877ffgphrb.fsf@gnu.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: "guix-devel@gnu.org" --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Ludovic Courtès writes: > Ricardo Wurmus skribis: > >> I tested JUnit previously with the log4j-api package, but I cannot >> submit this right now due to a bug(?) in Guile’s HTTP client, which >> makes it impossible for me to download the sources of its dependencies, >> such as this one: >> >> http://central.maven.org/maven2/org/osgi/org.osgi.core/6.0.0/org.osgi.core-6.0.0-sources.jar >> ERROR: Bad Date header: Wed, 30 Jul 2014 3:47:42 GMT > > ISTR you were working on a workaround for this issue. What’s the > status? I got it fixed (after wasting a lot of time wondering why it would not work as I had patched the wrong file), but the fix isn’t really pretty. It’s attached. > Once this is done, and since you did not get feedback, I would suggest > committing these packages. Okay! ~~ Ricardo --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-build-Accept-dates-with-space-padded-hour-field.patch >From c98ca436bafe8077edaf3125b529ea32fbd48611 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 29 Apr 2016 22:12:24 +0200 Subject: [PATCH] build: Accept dates with space-padded hour field. * guix/build/download.scm: Replace "parse-rfc-822-date" from the (web http) module. --- guix/build/download.scm | 73 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) diff --git a/guix/build/download.scm b/guix/build/download.scm index fec4cec..3b2901b 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -426,6 +426,79 @@ port if PORT is a TLS session record port." (module-define! (resolve-module '(web client)) 'shutdown (const #f)) + +;; XXX: 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))) + ((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 , present in Guile ;; up to 2.0.11. (unless (or (> (string->number (major-version)) 2) -- 2.7.3 --=-=-=--