[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 04/05: Prevent TOCTTOU bugs in suspendable ports
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 04/05: Prevent TOCTTOU bugs in suspendable ports |
|
Date: |
Wed, 8 Feb 2017 09:12:13 -0500 (EST) |
wingo pushed a commit to branch master
in repository guile.
commit 8a4774dec8368def01af4126e77797468b0ce6de
Author: Andy Wingo <address@hidden>
Date: Wed Feb 8 11:22:22 2017 +0100
Prevent TOCTTOU bugs in suspendable ports
* module/ice-9/suspendable-ports.scm: Prevent TOCTTOU bugs by
additionally returning the buffer and offset when we compute an
amount-buffered.
---
module/ice-9/suspendable-ports.scm | 167 +++++++++++++++++++------------------
1 file changed, 86 insertions(+), 81 deletions(-)
diff --git a/module/ice-9/suspendable-ports.scm
b/module/ice-9/suspendable-ports.scm
index bc84a4a..8ff0ba0 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -124,10 +124,9 @@
(and (eq? (peek-byte port) (bytevector-u8-ref bom 0))
(call-with-values (lambda ()
(fill-input port (bytevector-length bom)))
- (lambda (buf buffered)
+ (lambda (buf cur buffered)
(and (<= (bytevector-length bom) buffered)
- (let ((bv (port-buffer-bytevector buf))
- (cur (port-buffer-cur buf)))
+ (let ((bv (port-buffer-bytevector buf)))
(let lp ((i 1))
(if (= i (bytevector-length bom))
(begin
@@ -160,10 +159,10 @@
(clear-stream-start-for-bom-read port io-mode)
(let* ((buf (port-read-buffer port))
(cur (port-buffer-cur buf))
- (buffered (- (port-buffer-end buf) cur)))
+ (buffered (max (- (port-buffer-end buf) cur) 0)))
(cond
((or (<= minimum-buffering buffered) (port-buffer-has-eof? buf))
- (values buf buffered))
+ (values buf cur buffered))
(else
(unless (input-port? port)
(error "not an input port" port))
@@ -186,13 +185,13 @@
(cond
((zero? read)
(set-port-buffer-has-eof?! buf #t)
- (values buf buffered))
+ (values buf 0 buffered))
(else
(let ((buffered (+ buffered read)))
(set-port-buffer-end! buf buffered)
(if (< buffered minimum-buffering)
(lp buffered)
- (values buf buffered)))))))))))))))
+ (values buf 0 buffered)))))))))))))))
(define* (force-output #:optional (port (current-output-port)))
(unless (and (output-port? port) (not (port-closed? port)))
@@ -215,9 +214,8 @@
(if (<= count buffered)
(kfast buf (port-buffer-bytevector buf) cur buffered)
(call-with-values (lambda () (fill-input port count))
- (lambda (buf buffered)
- (kslow buf (port-buffer-bytevector buf) (port-buffer-cur buf)
- buffered))))))
+ (lambda (buf cur buffered)
+ (kslow buf (port-buffer-bytevector buf) cur buffered))))))
(define (peek-byte port)
(peek-bytes port 1
@@ -258,7 +256,7 @@
(define (take-already-buffered)
(let* ((buf (port-read-buffer port))
(cur (port-buffer-cur buf))
- (buffered (- (port-buffer-end buf) cur)))
+ (buffered (max (- (port-buffer-end buf) cur) 0)))
(port-buffer-take! 0 buf cur (min count buffered))))
(define (trim-and-return len)
(if (zero? len)
@@ -268,12 +266,12 @@
partial)))
(define (buffer-and-fill pos)
(call-with-values (lambda () (fill-input port 1 'binary))
- (lambda (buf buffered)
+ (lambda (buf cur buffered)
(if (zero? buffered)
(begin
(set-port-buffer-has-eof?! buf #f)
(trim-and-return pos))
- (let ((pos (port-buffer-take! pos buf (port-buffer-cur buf)
+ (let ((pos (port-buffer-take! pos buf cur
(min (- count pos) buffered))))
(if (= pos count)
ret
@@ -302,9 +300,15 @@
(error "not an output port" port))
(when (and (eq? (port-buffer-cur buf) end) (port-random-access? port))
(flush-input port))
- (bytevector-u8-set! bv end byte)
- (set-port-buffer-end! buf (1+ end))
- (when (= (1+ end) (bytevector-length bv)) (flush-output port))))
+ (cond
+ ((= end (bytevector-length bv))
+ ;; Multiple threads racing; race to flush, then retry.
+ (flush-output port)
+ (put-u8 port byte))
+ (else
+ (bytevector-u8-set! bv end byte)
+ (set-port-buffer-end! buf (1+ end))
+ (when (= (1+ end) (bytevector-length bv)) (flush-output port))))))
(define* (put-bytevector port src #:optional (start 0)
(count (- (bytevector-length src) start)))
@@ -315,7 +319,7 @@
(size (bytevector-length bv))
(cur (port-buffer-cur buf))
(end (port-buffer-end buf))
- (buffered (- end cur)))
+ (buffered (max (- end cur) 0)))
(when (and (eq? cur end) (port-random-access? port))
(flush-input port))
(cond
@@ -425,71 +429,73 @@
(else 0)))
(else 1)))
-(define (peek-char-and-len/utf8 port first-byte)
- (define (bad-utf8 len)
- (if (eq? (port-conversion-strategy port) 'substitute)
- (values #\xFFFD len)
- (decoding-error "peek-char" port)))
+(define (peek-char-and-next-cur/utf8 port buf cur first-byte)
(if (< first-byte #x80)
- (values (integer->char first-byte) 1)
+ (values (integer->char first-byte) buf (+ cur 1))
(call-with-values (lambda ()
(fill-input port
(cond
((<= #xc2 first-byte #xdf) 2)
((= (logand first-byte #xf0) #xe0) 3)
(else 4))))
- (lambda (buf buffering)
- (let* ((bv (port-buffer-bytevector buf))
- (cur (port-buffer-cur buf)))
+ (lambda (buf cur buffering)
+ (let ((bv (port-buffer-bytevector buf)))
(define (bad-utf8)
(let ((len (bad-utf8-len bv cur buffering first-byte)))
(when (zero? len) (error "internal error"))
(if (eq? (port-conversion-strategy port) 'substitute)
- (values #\xFFFD len)
+ (values #\xFFFD buf (+ cur len))
(decoding-error "peek-char" port))))
- (decode-utf8 bv cur buffering first-byte values bad-utf8))))))
+ (decode-utf8 bv cur buffering first-byte
+ (lambda (char len)
+ (values char buf (+ cur len)))
+ bad-utf8))))))
-(define (peek-char-and-len/iso-8859-1 port first-byte)
- (values (integer->char first-byte) 1))
+(define (peek-char-and-next-cur/iso-8859-1 port buf cur first-byte)
+ (values (integer->char first-byte) buf (+ cur 1)))
-(define (peek-char-and-len/iconv port first-byte)
+(define (peek-char-and-next-cur/iconv port)
(let lp ((prev-input-size 0))
(let ((input-size (1+ prev-input-size)))
(call-with-values (lambda () (fill-input port input-size))
- (lambda (buf buffered)
+ (lambda (buf cur buffered)
(cond
((< buffered input-size)
;; Buffer failed to fill; EOF, possibly premature.
(cond
((zero? prev-input-size)
- (values the-eof-object 0))
+ (values the-eof-object buf cur))
((eq? (port-conversion-strategy port) 'substitute)
- (values #\xFFFD prev-input-size))
+ (values #\xFFFD buf (+ cur prev-input-size)))
(else
(decoding-error "peek-char" port))))
((port-decode-char port (port-buffer-bytevector buf)
- (port-buffer-cur buf) input-size)
+ cur input-size)
=> (lambda (char)
- (values char input-size)))
+ (values char buf (+ cur input-size))))
(else
(lp input-size))))))))
-(define (peek-char-and-len port)
- (let ((first-byte (peek-byte port)))
- (if (not first-byte)
- (values the-eof-object 0)
- (case (%port-encoding port)
- ((UTF-8)
- (peek-char-and-len/utf8 port first-byte))
- ((ISO-8859-1)
- (peek-char-and-len/iso-8859-1 port first-byte))
- (else
- (peek-char-and-len/iconv port first-byte))))))
+(define (peek-char-and-next-cur port)
+ (define (have-byte buf bv cur buffered)
+ (let ((first-byte (bytevector-u8-ref bv cur)))
+ (case (%port-encoding port)
+ ((UTF-8)
+ (peek-char-and-next-cur/utf8 port buf cur first-byte))
+ ((ISO-8859-1)
+ (peek-char-and-next-cur/iso-8859-1 port buf cur first-byte))
+ (else
+ (peek-char-and-next-cur/iconv port)))))
+ (peek-bytes port 1 have-byte
+ (lambda (buf bv cur buffered)
+ (if (< 0 buffered)
+ (have-byte buf bv cur buffered)
+ (values the-eof-object buf cur)))))
(define* (peek-char #:optional (port (current-input-port)))
(define (slow-path)
- (call-with-values (lambda () (peek-char-and-len port))
- (lambda (char len)
+ (call-with-values (lambda () (peek-char-and-next-cur port))
+ (lambda (char buf cur)
char)))
(define (fast-path buf bv cur buffered)
(let ((u8 (bytevector-u8-ref bv cur))
@@ -532,15 +538,14 @@
(advance-port-position! (port-buffer-position buf) char)
char)
(define (slow-path)
- (call-with-values (lambda () (peek-char-and-len port))
- (lambda (char len)
- (let ((buf (port-read-buffer port)))
- (set-port-buffer-cur! buf (+ (port-buffer-cur buf) len))
- (if (eq? char the-eof-object)
- (begin
- (set-port-buffer-has-eof?! buf #f)
- char)
- (finish buf char))))))
+ (call-with-values (lambda () (peek-char-and-next-cur port))
+ (lambda (char buf cur)
+ (set-port-buffer-cur! buf cur)
+ (if (eq? char the-eof-object)
+ (begin
+ (set-port-buffer-has-eof?! buf #f)
+ char)
+ (finish buf char)))))
(define (fast-path buf bv cur buffered)
(let ((u8 (bytevector-u8-ref bv cur))
(enc (%port-encoding port)))
@@ -559,29 +564,29 @@
(lambda (buf bv cur buffered) (slow-path))))
(define-inlinable (port-fold-chars/iso-8859-1 port proc seed)
- (let fold-buffer ((buf (port-read-buffer port))
- (seed seed))
- (let ((bv (port-buffer-bytevector buf))
- (end (port-buffer-end buf)))
- (let fold-chars ((cur (port-buffer-cur buf))
- (seed seed))
- (cond
- ((= end cur)
- (call-with-values (lambda () (fill-input port))
- (lambda (buf buffered)
- (if (zero? buffered)
- (call-with-values (lambda () (proc the-eof-object seed))
- (lambda (seed done?)
- (if done? seed (fold-buffer buf seed))))
- (fold-buffer buf seed)))))
- (else
- (let ((ch (integer->char (bytevector-u8-ref bv cur)))
- (cur (1+ cur)))
- (set-port-buffer-cur! buf cur)
- (advance-port-position! (port-buffer-position buf) ch)
- (call-with-values (lambda () (proc ch seed))
- (lambda (seed done?)
- (if done? seed (fold-chars cur seed)))))))))))
+ (let* ((buf (port-read-buffer port))
+ (cur (port-buffer-cur buf)))
+ (let fold-buffer ((buf buf) (cur cur) (seed seed))
+ (let ((bv (port-buffer-bytevector buf))
+ (end (port-buffer-end buf)))
+ (let fold-chars ((cur cur) (seed seed))
+ (cond
+ ((= end cur)
+ (call-with-values (lambda () (fill-input port))
+ (lambda (buf cur buffered)
+ (if (zero? buffered)
+ (call-with-values (lambda () (proc the-eof-object seed))
+ (lambda (seed done?)
+ (if done? seed (fold-buffer buf cur seed))))
+ (fold-buffer buf cur seed)))))
+ (else
+ (let ((ch (integer->char (bytevector-u8-ref bv cur)))
+ (cur (1+ cur)))
+ (set-port-buffer-cur! buf cur)
+ (advance-port-position! (port-buffer-position buf) ch)
+ (call-with-values (lambda () (proc ch seed))
+ (lambda (seed done?)
+ (if done? seed (fold-chars cur seed))))))))))))
(define-inlinable (port-fold-chars port proc seed)
(case (%port-encoding port)