Ticket #568: 0001-Implement-fix-for-568-by-making-sys-scan-buffer-line.patch
| File 0001-Implement-fix-for-568-by-making-sys-scan-buffer-line.patch, 9.8 KB (added by , 11 years ago) |
|---|
-
NEWS
From 77afc0fcdd79dc08f8bea3b1ae4a30d97e0be721 Mon Sep 17 00:00:00 2001 From: Peter Bex <peter.bex@xs4all.nl> 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 b 4 4 - csc: added "-oi"/"-ot" options as alternatives to "-emit-inline-file" 5 5 and "-emit-type-file", respectively; "-n" has been deprecated. 6 6 7 - Core libraries 8 - read-line no longer returns trailing CRs in rare cases on TCP ports (#568) 7 9 8 10 4.8.1 9 11 -
library.scm
diff --git a/library.scm b/library.scm index 3cabd3d..c53c884 100644
a b EOF 3545 3545 (end (if limit (fx+ pos limit) size))) 3546 3546 (if (fx>= pos size) 3547 3547 #!eof 3548 (##sys#scan-buffer-line 3549 buf 3550 (if (fx> end size) size end) 3551 pos 3552 (lambda (pos2 next) 3553 (when (not (eq? pos2 next)) 3554 (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ) 3555 (let ((dest (##sys#make-string (fx- pos2 pos)))) 3556 (##core#inline "C_substring_copy" buf dest pos pos2 0) 3557 (##sys#setislot p 10 next) 3558 dest) ) ) ) ) ) 3548 (receive (next line) 3549 (##sys#scan-buffer-line 3550 buf (if (fx> end size) size end) pos 3551 (lambda (pos) (values #f pos #f) ) ) 3552 (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ; lineno 3553 (##sys#setislot p 10 next) 3554 line) ) ) ) 3559 3555 (lambda (p) ; read-buffered 3560 3556 (let ((pos (##sys#slot p 10)) 3561 3557 (string (##sys#slot p 12)) … … EOF 3567 3563 buffered)))) 3568 3564 ))) 3569 3565 3570 ; Invokes the eol handler when EOL or EOS is reached. 3571 (define (##sys#scan-buffer-line buf limit pos k) 3572 (let loop ((pos2 pos)) 3573 (if (fx>= pos2 limit) 3574 (k pos2 pos2) 3575 (let ((c (##core#inline "C_subchar" buf pos2))) 3576 (cond ((eq? c #\newline) (k pos2 (fx+ pos2 1))) 3577 ((and (eq? c #\return) 3578 (fx> limit (fx+ pos2 1)) 3579 (eq? (##core#inline "C_subchar" buf (fx+ pos2 1)) #\newline) ) 3580 (k pos2 (fx+ pos2 2)) ) 3581 (else (loop (fx+ pos2 1))) ) ) ) ) ) 3566 ;; Invokes the eos handler when EOS is reached to get more data. 3567 ;; The eos-handler is responsible for stopping, either when EOF is hit or 3568 ;; a user-supplied limit is reached (ie, it's indistinguishable from EOF) 3569 (define (##sys#scan-buffer-line buf limit start-pos eos-handler) 3570 (define (copy&append buf offset pos old-line) 3571 (let* ((old-line-len (##sys#size old-line)) 3572 (new-line (##sys#make-string (fx+ old-line-len (fx- pos offset))))) 3573 (##core#inline "C_substring_copy" old-line new-line 0 old-line-len 0) 3574 (##core#inline "C_substring_copy" buf new-line offset pos old-line-len) 3575 new-line)) 3576 (let loop ((buf buf) 3577 (offset start-pos) 3578 (pos start-pos) 3579 (limit limit) 3580 (line "")) 3581 (if (fx= pos limit) 3582 (let ((line (copy&append buf offset pos line))) 3583 (receive (buf offset limit) (eos-handler pos) 3584 (if buf 3585 (loop buf offset offset limit line) 3586 (values offset line)))) 3587 (let ((c (##core#inline "C_subchar" buf pos))) 3588 (cond ((eq? c #\newline) 3589 (values (fx+ pos 1) (copy&append buf offset pos line))) 3590 ((and (eq? c #\return) ; \r\n -> drop \r from string 3591 (fx> limit (fx+ pos 1)) 3592 (eq? (##core#inline "C_subchar" buf (fx+ pos 1)) #\newline)) 3593 (values (fx+ pos 2) (copy&append buf offset pos line))) 3594 ((and (eq? c #\return) ; Edge case (#568): \r{read}[\n|xyz] 3595 (fx= limit (fx+ pos 1))) 3596 (let ((line (copy&append buf offset pos line))) 3597 (receive (buf offset limit) (eos-handler pos) 3598 (if buf 3599 (if (eq? (##core#inline "C_subchar" buf offset) #\newline) 3600 (values (fx+ offset 1) line) 3601 ;; "Restore" \r we didn't copy, loop w/ new string 3602 (loop buf offset offset limit 3603 (##sys#string-append line "\r"))) 3604 ;; Restore \r here, too (when we reached EOF) 3605 (values offset (##sys#string-append line "\r")))))) 3606 (else (loop buf offset (fx+ pos 1) limit line)) ) ) ) ) ) 3582 3607 3583 3608 (define (open-input-string string) 3584 3609 (##sys#check-string string 'open-input-string) -
posixunix.scm
diff --git a/posixunix.scm b/posixunix.scm index 9de549f..251c400 100644
a b EOF 1384 1384 m 1385 1385 (loop n m start) ) ] ) ) ) 1386 1386 (lambda (port limit) ; read-line 1387 (let loop ([str #f]) 1388 (let ([bumper 1389 (lambda (cur ptr) 1390 (let* ([cnt (fx- cur bufpos)] 1391 [dest 1392 (if (eq? 0 cnt) 1393 (or str "") 1394 (let ([dest (##sys#make-string cnt)]) 1395 (##core#inline "C_substring_copy" 1396 buf dest bufpos cur 0) 1397 (##sys#setislot port 5 1398 (fx+ (##sys#slot port 5) cnt)) 1399 (if str 1400 (##sys#string-append str dest) 1401 dest ) ) ) ] ) 1402 (set! bufpos ptr) 1403 (cond [(eq? cur ptr) ; no EOL encountered 1404 (fetch) 1405 (values dest (fx< bufpos buflen)) ] 1406 [else ; at EOL 1407 (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1)) 1408 (##sys#setislot port 5 0) 1409 (values dest #f) ] ) ) ) ] ) 1410 (cond [(fx< bufpos buflen) 1411 (let-values ([(dest cont?) 1412 (##sys#scan-buffer-line buf buflen bufpos bumper)]) 1413 (if cont? 1414 (loop dest) 1415 dest ) ) ] 1416 [else 1417 (fetch) 1418 (if (fx< bufpos buflen) 1419 (loop str) 1420 #!eof) ] ) ) ) ) 1387 (when (fx>= bufpos buflen) 1388 (fetch)) 1389 (if (fx>= bufpos buflen) 1390 #!eof 1391 (let ((limit (or limit (##sys#fudge 21)))) 1392 (receive (next line) 1393 (##sys#scan-buffer-line 1394 buf 1395 (fxmin buflen (fx+ bufpos limit)) 1396 bufpos 1397 (lambda (pos) 1398 (let ((nbytes (fx- pos bufpos))) 1399 (cond ((fx>= nbytes limit) 1400 (values #f pos #f)) 1401 (else 1402 (set! limit (fx- limit nbytes)) 1403 (fetch) 1404 (if (fx< bufpos buflen) 1405 (values buf bufpos 1406 (fxmin buflen 1407 (fx+ bufpos limit))) 1408 (values #f bufpos #f))))))) 1409 (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1)) 1410 (set! bufpos next) 1411 line)) ) ) 1421 1412 (lambda (port) ; read-buffered 1422 1413 (if (fx>= bufpos buflen) 1423 1414 "" -
setup-download.scm
diff --git a/setup-download.scm b/setup-download.scm index 449de81..5267b22 100644
a b 402 402 403 403 (define (read-chunks in) 404 404 (let get-chunks ([data '()]) 405 (let* ((szln (read-line in)) 406 ;;XXX workaround for "read-line" dropping the "\n" in certain situations 407 ;; (#568) 408 (size (string->number (string-chomp szln "\r") 16))) 405 (let ((size (string->number (read-line in) 16))) 409 406 (cond ((not size) 410 407 (error "invalid response from server - please try again")) 411 408 ((zero? size) -
tcp.scm
diff --git a/tcp.scm b/tcp.scm index 5072adf..d0657a4 100644
a b EOF 429 429 m 430 430 (loop n m start) ) ) ) ) ) 431 431 (lambda (p limit) ; read-line 432 (let loop ((str #f) 433 (limit (or limit (##sys#fudge 21)))) 434 (cond ((fx< bufindex buflen) 435 (##sys#scan-buffer-line 436 buf 437 (fxmin buflen limit) 438 bufindex 439 (lambda (pos2 next) 440 (let* ((len (fx- pos2 bufindex)) 441 (dest (##sys#make-string len))) 442 (##core#inline "C_substring_copy" buf dest bufindex pos2 0) 443 (set! bufindex next) 444 (cond ((eq? pos2 limit) ; no line-terminator, hit limit 445 (if str (##sys#string-append str dest) dest)) 446 ((eq? pos2 next) ; no line-terminator, hit buflen 447 (read-input) 448 (if (fx>= bufindex buflen) 449 (or str "") 450 (loop (if str (##sys#string-append str dest) dest) 451 (fx- limit len)) ) ) 452 (else 453 (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) 454 (if str (##sys#string-append str dest) dest)) ) ) ) ) ) 455 (else 456 (read-input) 457 (if (fx< bufindex buflen) 458 (loop str limit) 459 #!eof) ) ) ) ) 432 (when (fx>= bufindex buflen) 433 (read-input)) 434 (if (fx>= bufindex buflen) 435 #!eof 436 (let ((limit (or limit (##sys#fudge 21)))) 437 (receive (next line) 438 (##sys#scan-buffer-line 439 buf 440 (fxmin buflen (fx+ bufindex limit)) 441 bufindex 442 (lambda (pos) 443 (let ((nbytes (fx- pos bufindex))) 444 (cond ((fx>= nbytes limit) 445 (values #f pos #f)) 446 (else (read-input) 447 (set! limit (fx- limit nbytes)) 448 (if (fx< bufindex buflen) 449 (values buf bufindex 450 (fxmin buflen 451 (fx+ bufindex limit))) 452 (values #f bufindex #f))))) ) ) 453 (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ; lineno 454 (set! bufindex next) 455 line) )) ) 460 456 (lambda (p) ; read-buffered 461 457 (if (fx>= bufindex buflen) 462 458 ""
