mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +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
;; 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
;; 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)
(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)
"Read an HTTP header line, including any continuation lines, and
return the combined string without its final CRLF or LF. Raise a
'bad-header' exception if the line does not end in CRLF or LF, or if EOF
is reached."
"Read an HTTP header line and return it without its final CRLF or LF.
Raise a 'bad-header' exception if the line does not end in CRLF or LF,
or if EOF is reached."
(match (%read-line port)
(((? string? line) . #\newline)
;; '%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
;; tolerate LF-only endings.
(let ((line (if (string-suffix? "\r" line)
(string-drop-right line 1)
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)))
(if (string-suffix? "\r" line)
(string-drop-right line 1)
line))
((line . _) ;EOF or missing delimiter
(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; -*-
;;;;
;;;; 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
;;;; 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")
(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 "Content-Encoding" '(content-encoding))