summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2019-08-02 15:30:13 +0200
committerAndy Wingo <wingo@pobox.com>2019-08-02 15:30:13 +0200
commit8ee6e766b8274726b341973c4132cec137dfd013 (patch)
tree1c69dd8460e7600a6167ecd115ab7fc25f100a7e /module
parentaad64cf3813ac96a67a7e50fb6aa81fcb6a86f8a (diff)
parent043ed2ae5b7e69c6048f37fd0fd3344479c84349 (diff)
downloadguile-8ee6e766b8274726b341973c4132cec137dfd013.tar.gz
Merge from stable-2.2
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/ports.scm3
-rw-r--r--module/web/http.scm31
2 files changed, 9 insertions, 25 deletions
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index 8eee22988..dbc7ef7a7 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -1,5 +1,5 @@
;;; Ports
-;;; Copyright (C) 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2016, 2019 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 License as
@@ -31,6 +31,7 @@
%set-port-property!
current-input-port current-output-port
current-error-port current-warning-port
+ current-load-port
set-current-input-port set-current-output-port
set-current-error-port
port-mode
diff --git a/module/web/http.scm b/module/web/http.scm
index f1ca733c1..de61c9495 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -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))))