mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-02 23:50:47 +02:00
Code Activity

Revert "web: Add support for HTTP header continuation lines."

Browse source 
Fixes <https://bugs.gnu.org/36350>.

This reverts commit 73cde5ed72.
This commit is contained in:
Mark H Weaver 2019-06-24 10:24:28 -04:00
parent f2c11dc181
commit e1225d013e
2 changed files with 8 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

31
module/web/http.scm
View file

@ -1,6 +1,6 @@
;;; HTTP messages ;;; HTTP messages
;; Copyright (C) 2010-2017, 2019 Free Software Foundation, Inc. ;; Copyright (C) 2010-2017 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -152,35 +152,18 @@ The default writer will call ‘put-string’."
(lambda (val port) (lambda (val port)
(put-string port val))))) (put-string port val)))))
(define spaces-and-tabs
(char-set #\space #\tab))
(define (space-or-tab? c)
(case c
((#\space #\tab) #t)
(else #f)))
(define (read-header-line port) (define (read-header-line port)
"Read an HTTP header line, including any continuation lines, and "Read an HTTP header line and return it without its final CRLF or LF.
return the combined string without its final CRLF or LF. Raise a Raise a 'bad-header' exception if the line does not end in CRLF or LF,
'bad-header' exception if the line does not end in CRLF or LF, or if EOF or if EOF is reached."
is reached."
(match (%read-line port) (match (%read-line port)
(((? string? line) . #\newline) (((? string? line) . #\newline)
;; '%read-line' does not consider #\return a delimiter; so if it's ;; '%read-line' does not consider #\return a delimiter; so if it's
;; there, remove it. We are more tolerant than the RFC in that we ;; there, remove it. We are more tolerant than the RFC in that we
;; tolerate LF-only endings. ;; tolerate LF-only endings.
(let ((line (if (string-suffix? "\r" line) (if (string-suffix? "\r" line)
(string-drop-right line 1) (string-drop-right line 1)
line))) line))
;; If the next character is a space or tab, then there's at least
;; one continuation line. Read the continuation lines by calling
;; 'read-header-line' recursively, and append them to this header
;; line, folding the leading spaces and tabs to a single space.
(if (space-or-tab? (lookahead-char port))
(string-append line " " (string-trim (read-header-line port)
spaces-and-tabs))
line)))
((line . _) ;EOF or missing delimiter ((line . _) ;EOF or missing delimiter
(bad-header 'read-header-line line)))) (bad-header 'read-header-line line))))

11
test-suite/tests/web-http.test
View file

@ -1,6 +1,6 @@
;;;; web-http.test --- HTTP library -*- mode: scheme; coding: utf-8; -*- ;;;; web-http.test --- HTTP library -*- mode: scheme; coding: utf-8; -*-
;;;; ;;;;
;;;; Copyright (C) 2010-2011, 2014-2017, 2019 Free Software Foundation, Inc. ;;;; Copyright (C) 2010-2011, 2014-2017 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -242,15 +242,6 @@
(pass-if-round-trip "Cache-Control: acme-cache-extension=100 quux\r\n") (pass-if-round-trip "Cache-Control: acme-cache-extension=100 quux\r\n")
(pass-if-round-trip "Cache-Control: acme-cache-extension=\"100, quux\"\r\n") (pass-if-round-trip "Cache-Control: acme-cache-extension=\"100, quux\"\r\n")
(let ((str "Cache-Control: acme-cache-extension=\"100,\r\n\t foo,\r\n quux\"\r\n")
(val '(cache-control . ((acme-cache-extension . "100, foo, quux")))))
(pass-if-equal "continuation lines"
val
(call-with-values (lambda ()
(read-header (open-input-string str)))
(lambda (sym val)
(cons sym val)))))
(pass-if-parse connection "close" '(close)) (pass-if-parse connection "close" '(close))
(pass-if-parse connection "Content-Encoding" '(content-encoding)) (pass-if-parse connection "Content-Encoding" '(content-encoding))