diff options
author | Mike Gran <spk121@yahoo.com> | 2021-03-11 19:42:33 -0800 |
---|---|---|
committer | Mike Gran <spk121@yahoo.com> | 2021-03-11 19:42:33 -0800 |
commit | 0f983e3db0c43ad7c89f57ea84f792ede373ba0c (patch) | |
tree | a56172dd2fac12e2ba9d9eeafeabfd3ea95cad56 /module | |
parent | a744f98dcc294ab2cbe1cb5ce4efa66665f4e03f (diff) | |
download | guile-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.scm | 77 | ||||
-rw-r--r-- | module/web/http.scm | 14 |
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))) |