>From 77afc0fcdd79dc08f8bea3b1ae4a30d97e0be721 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 3 Feb 2013 18:51:26 +0100 Subject: [PATCH] Implement fix for #568 by making ##sys#scan-buffer-line aware of the edge case. Invert data fetching logic to prevent having to put all this complicated stuff in the read-line handler of each port type. The hacky workaround for chicken-install introduced by 2a2656cacadd3791c11d24b57742c1b37370a24c is reverted. --- NEWS | 2 ++ library.scm | 71 ++++++++++++++++++++++++++++++++++++------------------ posixunix.scm | 59 +++++++++++++++++++-------------------------- setup-download.scm | 5 +--- tcp.scm | 52 ++++++++++++++++++--------------------- 5 files changed, 100 insertions(+), 89 deletions(-) diff --git a/NEWS b/NEWS index ad77c58..8fbaefd 100644 --- a/NEWS +++ b/NEWS @@ -4,6 +4,8 @@ - csc: added "-oi"/"-ot" options as alternatives to "-emit-inline-file" and "-emit-type-file", respectively; "-n" has been deprecated. +- Core libraries + - read-line no longer returns trailing CRs in rare cases on TCP ports (#568) 4.8.1 diff --git a/library.scm b/library.scm index 3cabd3d..c53c884 100644 --- a/library.scm +++ b/library.scm @@ -3545,17 +3545,13 @@ EOF (end (if limit (fx+ pos limit) size))) (if (fx>= pos size) #!eof - (##sys#scan-buffer-line - buf - (if (fx> end size) size end) - pos - (lambda (pos2 next) - (when (not (eq? pos2 next)) - (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ) - (let ((dest (##sys#make-string (fx- pos2 pos)))) - (##core#inline "C_substring_copy" buf dest pos pos2 0) - (##sys#setislot p 10 next) - dest) ) ) ) ) ) + (receive (next line) + (##sys#scan-buffer-line + buf (if (fx> end size) size end) pos + (lambda (pos) (values #f pos #f) ) ) + (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ; lineno + (##sys#setislot p 10 next) + line) ) ) ) (lambda (p) ; read-buffered (let ((pos (##sys#slot p 10)) (string (##sys#slot p 12)) @@ -3567,18 +3563,47 @@ EOF buffered)))) ))) -; Invokes the eol handler when EOL or EOS is reached. -(define (##sys#scan-buffer-line buf limit pos k) - (let loop ((pos2 pos)) - (if (fx>= pos2 limit) - (k pos2 pos2) - (let ((c (##core#inline "C_subchar" buf pos2))) - (cond ((eq? c #\newline) (k pos2 (fx+ pos2 1))) - ((and (eq? c #\return) - (fx> limit (fx+ pos2 1)) - (eq? (##core#inline "C_subchar" buf (fx+ pos2 1)) #\newline) ) - (k pos2 (fx+ pos2 2)) ) - (else (loop (fx+ pos2 1))) ) ) ) ) ) +;; Invokes the eos handler when EOS is reached to get more data. +;; The eos-handler is responsible for stopping, either when EOF is hit or +;; a user-supplied limit is reached (ie, it's indistinguishable from EOF) +(define (##sys#scan-buffer-line buf limit start-pos eos-handler) + (define (copy&append buf offset pos old-line) + (let* ((old-line-len (##sys#size old-line)) + (new-line (##sys#make-string (fx+ old-line-len (fx- pos offset))))) + (##core#inline "C_substring_copy" old-line new-line 0 old-line-len 0) + (##core#inline "C_substring_copy" buf new-line offset pos old-line-len) + new-line)) + (let loop ((buf buf) + (offset start-pos) + (pos start-pos) + (limit limit) + (line "")) + (if (fx= pos limit) + (let ((line (copy&append buf offset pos line))) + (receive (buf offset limit) (eos-handler pos) + (if buf + (loop buf offset offset limit line) + (values offset line)))) + (let ((c (##core#inline "C_subchar" buf pos))) + (cond ((eq? c #\newline) + (values (fx+ pos 1) (copy&append buf offset pos line))) + ((and (eq? c #\return) ; \r\n -> drop \r from string + (fx> limit (fx+ pos 1)) + (eq? (##core#inline "C_subchar" buf (fx+ pos 1)) #\newline)) + (values (fx+ pos 2) (copy&append buf offset pos line))) + ((and (eq? c #\return) ; Edge case (#568): \r{read}[\n|xyz] + (fx= limit (fx+ pos 1))) + (let ((line (copy&append buf offset pos line))) + (receive (buf offset limit) (eos-handler pos) + (if buf + (if (eq? (##core#inline "C_subchar" buf offset) #\newline) + (values (fx+ offset 1) line) + ;; "Restore" \r we didn't copy, loop w/ new string + (loop buf offset offset limit + (##sys#string-append line "\r"))) + ;; Restore \r here, too (when we reached EOF) + (values offset (##sys#string-append line "\r")))))) + (else (loop buf offset (fx+ pos 1) limit line)) ) ) ) ) ) (define (open-input-string string) (##sys#check-string string 'open-input-string) diff --git a/posixunix.scm b/posixunix.scm index 9de549f..251c400 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -1384,40 +1384,31 @@ EOF m (loop n m start) ) ] ) ) ) (lambda (port limit) ; read-line - (let loop ([str #f]) - (let ([bumper - (lambda (cur ptr) - (let* ([cnt (fx- cur bufpos)] - [dest - (if (eq? 0 cnt) - (or str "") - (let ([dest (##sys#make-string cnt)]) - (##core#inline "C_substring_copy" - buf dest bufpos cur 0) - (##sys#setislot port 5 - (fx+ (##sys#slot port 5) cnt)) - (if str - (##sys#string-append str dest) - dest ) ) ) ] ) - (set! bufpos ptr) - (cond [(eq? cur ptr) ; no EOL encountered - (fetch) - (values dest (fx< bufpos buflen)) ] - [else ; at EOL - (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1)) - (##sys#setislot port 5 0) - (values dest #f) ] ) ) ) ] ) - (cond [(fx< bufpos buflen) - (let-values ([(dest cont?) - (##sys#scan-buffer-line buf buflen bufpos bumper)]) - (if cont? - (loop dest) - dest ) ) ] - [else - (fetch) - (if (fx< bufpos buflen) - (loop str) - #!eof) ] ) ) ) ) + (when (fx>= bufpos buflen) + (fetch)) + (if (fx>= bufpos buflen) + #!eof + (let ((limit (or limit (##sys#fudge 21)))) + (receive (next line) + (##sys#scan-buffer-line + buf + (fxmin buflen (fx+ bufpos limit)) + bufpos + (lambda (pos) + (let ((nbytes (fx- pos bufpos))) + (cond ((fx>= nbytes limit) + (values #f pos #f)) + (else + (set! limit (fx- limit nbytes)) + (fetch) + (if (fx< bufpos buflen) + (values buf bufpos + (fxmin buflen + (fx+ bufpos limit))) + (values #f bufpos #f))))))) + (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1)) + (set! bufpos next) + line)) ) ) (lambda (port) ; read-buffered (if (fx>= bufpos buflen) "" diff --git a/setup-download.scm b/setup-download.scm index 449de81..5267b22 100644 --- a/setup-download.scm +++ b/setup-download.scm @@ -402,10 +402,7 @@ (define (read-chunks in) (let get-chunks ([data '()]) - (let* ((szln (read-line in)) - ;;XXX workaround for "read-line" dropping the "\n" in certain situations - ;; (#568) - (size (string->number (string-chomp szln "\r") 16))) + (let ((size (string->number (read-line in) 16))) (cond ((not size) (error "invalid response from server - please try again")) ((zero? size) diff --git a/tcp.scm b/tcp.scm index 5072adf..d0657a4 100644 --- a/tcp.scm +++ b/tcp.scm @@ -429,34 +429,30 @@ EOF m (loop n m start) ) ) ) ) ) (lambda (p limit) ; read-line - (let loop ((str #f) - (limit (or limit (##sys#fudge 21)))) - (cond ((fx< bufindex buflen) - (##sys#scan-buffer-line - buf - (fxmin buflen limit) - bufindex - (lambda (pos2 next) - (let* ((len (fx- pos2 bufindex)) - (dest (##sys#make-string len))) - (##core#inline "C_substring_copy" buf dest bufindex pos2 0) - (set! bufindex next) - (cond ((eq? pos2 limit) ; no line-terminator, hit limit - (if str (##sys#string-append str dest) dest)) - ((eq? pos2 next) ; no line-terminator, hit buflen - (read-input) - (if (fx>= bufindex buflen) - (or str "") - (loop (if str (##sys#string-append str dest) dest) - (fx- limit len)) ) ) - (else - (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) - (if str (##sys#string-append str dest) dest)) ) ) ) ) ) - (else - (read-input) - (if (fx< bufindex buflen) - (loop str limit) - #!eof) ) ) ) ) + (when (fx>= bufindex buflen) + (read-input)) + (if (fx>= bufindex buflen) + #!eof + (let ((limit (or limit (##sys#fudge 21)))) + (receive (next line) + (##sys#scan-buffer-line + buf + (fxmin buflen (fx+ bufindex limit)) + bufindex + (lambda (pos) + (let ((nbytes (fx- pos bufindex))) + (cond ((fx>= nbytes limit) + (values #f pos #f)) + (else (read-input) + (set! limit (fx- limit nbytes)) + (if (fx< bufindex buflen) + (values buf bufindex + (fxmin buflen + (fx+ bufindex limit))) + (values #f bufindex #f))))) ) ) + (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ; lineno + (set! bufindex next) + line) )) ) (lambda (p) ; read-buffered (if (fx>= bufindex buflen) "" -- 1.8.0.1