mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
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.
This commit is contained in:
parent
ecdff904cb
commit
8a4774dec8
1 changed files with 86 additions and 81 deletions
|
@ -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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue