summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorMike Gran <spk121@yahoo.com>2021-03-11 19:42:33 -0800
committerMike Gran <spk121@yahoo.com>2021-03-11 19:42:33 -0800
commit0f983e3db0c43ad7c89f57ea84f792ede373ba0c (patch)
treea56172dd2fac12e2ba9d9eeafeabfd3ea95cad56 /module
parenta744f98dcc294ab2cbe1cb5ce4efa66665f4e03f (diff)
downloadguile-0f983e3db0c43ad7c89f57ea84f792ede373ba0c.tar.gz
Handle CRLF and Unicode line endings in read-line
* libguile/rdelim.c (scm_read_line): handle CRLF, LS and PS * module/ice-9/suspendable-ports.scm (read-line): handle CRLF, LS, and PS * module/web/http.scm (read-header-line): take advantage of CRLF in read-line (read-header): don't need to test for \return * test-suite/tests/rdelim.test: new tests for read-line CRLF, LS and PS * doc/ref/api-io.texi: update doc for read-line
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/suspendable-ports.scm77
-rw-r--r--module/web/http.scm14
2 files changed, 80 insertions, 11 deletions
diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm
index f5f005cca..ba8d225f5 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -1,5 +1,5 @@
;;; Ports, implemented in Scheme
-;;; Copyright (C) 2016, 2019 Free Software Foundation, Inc.
+;;; Copyright (C) 2016, 2018, 2021 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
@@ -689,10 +689,81 @@
(define* (read-line #:optional (port (current-input-port))
(handle-delim 'trim))
- (read-delimited "\n" port handle-delim))
+ (let* ((line/delim (%read-line port))
+ (line (car line/delim))
+ (delim (cdr line/delim)))
+ (case handle-delim
+ ((trim) line)
+ ((split) line/delim)
+ ((concat) (if (and (string? line) (char? delim))
+ (string-append line (string delim))
+ line))
+ ((peek) (if (char? delim)
+ (unread-char delim port))
+ line)
+ (else
+ (error "unexpected handle-delim value: " handle-delim)))))
(define* (%read-line port)
- (read-line port 'split))
+ (let ((LINE_BUFFER_SIZE 256))
+ (let ((strings #f)
+ (result #f)
+ (buf (make-string LINE_BUFFER_SIZE #\nul))
+ (delim #f)
+ (index 0)
+ (cr #f)
+ (go #t))
+ (cond
+ ((not (input-port? port))
+ (error "Not an input port." port))
+ (else
+ (while go
+ (cond
+ ((>= index LINE_BUFFER_SIZE)
+ (set! strings (cons (substring buf 0 index)
+ (or strings '())))
+ (set! index 0))
+ (else
+ (let ((c (read-char port)))
+ (cond
+ ((or (eof-object? c)
+ (char=? c #\x2028) ; U+2028 LINE SEPARATOR
+ (char=? c #\x2029)) ; U+2029 PARAGRAPH SEPARATOR
+ (set! cr #f)
+ (set! delim c))
+ ((char=? c #\newline)
+ (set! delim c))
+ ((char=? c #\return)
+ (set! cr #t)
+ (string-set! buf index c)
+ (set! index (1+ index)))
+ (else
+ (set! cr #f)
+ (string-set! buf index c)
+ (set! index (1+ index)))))))
+
+ (if (or (eof-object? delim)
+ (char? delim))
+ (set! go #f)))
+ (let ((line (if (not strings)
+ ;; A short string.
+ (if cr
+ (substring buf 0 (1- index))
+ (substring buf 0 index))
+ ;; Else, aggregate the intermediary results.
+ (begin
+ (if cr
+ (set! strings (cons (substring buf 0 (1- index)) strings))
+ (set! strings (cons (substring buf 0 index) strings)))
+ (apply string-append (reverse strings))))))
+
+ (if (and (eof-object? delim)
+ (zero? (string-length line)))
+ (cons the-eof-object the-eof-object)
+ ;; Else
+ (if cr
+ (cons line "\r\n")
+ (cons line delim)))))))))
(define* (put-string port str #:optional (start 0)
(count (- (string-length str) start)))
diff --git a/module/web/http.scm b/module/web/http.scm
index 4276e1744..32a3093f1 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -157,13 +157,12 @@ The default writer will call ‘put-string’."
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) . "\r\n")
+ line)
(((? 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.
- (if (string-suffix? "\r" line)
- (string-drop-right line 1)
- line))
+ ;; We are more tolerant than the RFC in that we tolerate LF-only
+ ;; endings.
+ line)
((line . _) ;EOF or missing delimiter
(bad-header 'read-header-line line))))
@@ -184,8 +183,7 @@ was known but the value was invalid.
Returns the end-of-file object for both values if the end of the message
body was reached (i.e., a blank line)."
(let ((line (read-header-line port)))
- (if (or (string-null? line)
- (string=? line "\r"))
+ (if (string-null? line)
(values *eof* *eof*)
(let* ((delim (or (string-index line #\:)
(bad-header '%read line)))