mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +02:00
Code Activity

Prevent TOCTTOU bugs in suspendable ports

Browse source 
* 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:
Andy Wingo 2017-02-08 11:22:22 +01:00
parent ecdff904cb
commit 8a4774dec8
1 changed files with 86 additions and 81 deletions
Download patch file Download diff file Expand all files Collapse all files

167
module/ice-9/suspendable-ports.scm
View file

@ -124,10 +124,9 @@
(and (eq? (peek-byte port) (bytevector-u8-ref bom 0)) (and (eq? (peek-byte port) (bytevector-u8-ref bom 0))
(call-with-values (lambda () (call-with-values (lambda ()
(fill-input port (bytevector-length bom))) (fill-input port (bytevector-length bom)))
(lambda (buf buffered) (lambda (buf cur buffered)
(and (<= (bytevector-length bom) buffered) (and (<= (bytevector-length bom) buffered)
(let ((bv (port-buffer-bytevector buf)) (let ((bv (port-buffer-bytevector buf)))
(cur (port-buffer-cur buf)))
(let lp ((i 1)) (let lp ((i 1))
(if (= i (bytevector-length bom)) (if (= i (bytevector-length bom))
(begin (begin
@ -160,10 +159,10 @@
(clear-stream-start-for-bom-read port io-mode) (clear-stream-start-for-bom-read port io-mode)
(let* ((buf (port-read-buffer port)) (let* ((buf (port-read-buffer port))
(cur (port-buffer-cur buf)) (cur (port-buffer-cur buf))
(buffered (- (port-buffer-end buf) cur))) (buffered (max (- (port-buffer-end buf) cur) 0)))
(cond (cond
((or (<= minimum-buffering buffered) (port-buffer-has-eof? buf)) ((or (<= minimum-buffering buffered) (port-buffer-has-eof? buf))
(values buf buffered)) (values buf cur buffered))
(else (else
(unless (input-port? port) (unless (input-port? port)
(error "not an input port" port)) (error "not an input port" port))
@ -186,13 +185,13 @@
(cond (cond
((zero? read) ((zero? read)
(set-port-buffer-has-eof?! buf #t) (set-port-buffer-has-eof?! buf #t)
(values buf buffered)) (values buf 0 buffered))
(else (else
(let ((buffered (+ buffered read))) (let ((buffered (+ buffered read)))
(set-port-buffer-end! buf buffered) (set-port-buffer-end! buf buffered)
(if (< buffered minimum-buffering) (if (< buffered minimum-buffering)
(lp buffered) (lp buffered)
(values buf buffered))))))))))))))) (values buf 0 buffered)))))))))))))))
(define* (force-output #:optional (port (current-output-port))) (define* (force-output #:optional (port (current-output-port)))
(unless (and (output-port? port) (not (port-closed? port))) (unless (and (output-port? port) (not (port-closed? port)))
@ -215,9 +214,8 @@
(if (<= count buffered) (if (<= count buffered)
(kfast buf (port-buffer-bytevector buf) cur buffered) (kfast buf (port-buffer-bytevector buf) cur buffered)
(call-with-values (lambda () (fill-input port count)) (call-with-values (lambda () (fill-input port count))
(lambda (buf buffered) (lambda (buf cur buffered)
(kslow buf (port-buffer-bytevector buf) (port-buffer-cur buf) (kslow buf (port-buffer-bytevector buf) cur buffered))))))
buffered))))))
(define (peek-byte port) (define (peek-byte port)
(peek-bytes port 1 (peek-bytes port 1
@ -258,7 +256,7 @@
(define (take-already-buffered) (define (take-already-buffered)
(let* ((buf (port-read-buffer port)) (let* ((buf (port-read-buffer port))
(cur (port-buffer-cur buf)) (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)))) (port-buffer-take! 0 buf cur (min count buffered))))
(define (trim-and-return len) (define (trim-and-return len)
(if (zero? len) (if (zero? len)
@ -268,12 +266,12 @@
partial))) partial)))
(define (buffer-and-fill pos) (define (buffer-and-fill pos)
(call-with-values (lambda () (fill-input port 1 'binary)) (call-with-values (lambda () (fill-input port 1 'binary))
(lambda (buf buffered) (lambda (buf cur buffered)
(if (zero? buffered) (if (zero? buffered)
(begin (begin
(set-port-buffer-has-eof?! buf #f) (set-port-buffer-has-eof?! buf #f)
(trim-and-return pos)) (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)))) (min (- count pos) buffered))))
(if (= pos count) (if (= pos count)
ret ret
@ -302,9 +300,15 @@
(error "not an output port" port)) (error "not an output port" port))
(when (and (eq? (port-buffer-cur buf) end) (port-random-access? port)) (when (and (eq? (port-buffer-cur buf) end) (port-random-access? port))
(flush-input port)) (flush-input port))
(bytevector-u8-set! bv end byte) (cond
(set-port-buffer-end! buf (1+ end)) ((= end (bytevector-length bv))
(when (= (1+ end) (bytevector-length bv)) (flush-output port)))) ;; 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) (define* (put-bytevector port src #:optional (start 0)
(count (- (bytevector-length src) start))) (count (- (bytevector-length src) start)))
@ -315,7 +319,7 @@
(size (bytevector-length bv)) (size (bytevector-length bv))
(cur (port-buffer-cur buf)) (cur (port-buffer-cur buf))
(end (port-buffer-end buf)) (end (port-buffer-end buf))
(buffered (- end cur))) (buffered (max (- end cur) 0)))
(when (and (eq? cur end) (port-random-access? port)) (when (and (eq? cur end) (port-random-access? port))
(flush-input port)) (flush-input port))
(cond (cond
@ -425,71 +429,73 @@
(else 0))) (else 0)))
(else 1))) (else 1)))
(define (peek-char-and-len/utf8 port first-byte) (define (peek-char-and-next-cur/utf8 port buf cur first-byte)
(define (bad-utf8 len)
(if (eq? (port-conversion-strategy port) 'substitute)
(values #\xFFFD len)
(decoding-error "peek-char" port)))
(if (< first-byte #x80) (if (< first-byte #x80)
(values (integer->char first-byte) 1) (values (integer->char first-byte) buf (+ cur 1))
(call-with-values (lambda () (call-with-values (lambda ()
(fill-input port (fill-input port
(cond (cond
((<= #xc2 first-byte #xdf) 2) ((<= #xc2 first-byte #xdf) 2)
((= (logand first-byte #xf0) #xe0) 3) ((= (logand first-byte #xf0) #xe0) 3)
(else 4)))) (else 4))))
(lambda (buf buffering) (lambda (buf cur buffering)
(let* ((bv (port-buffer-bytevector buf)) (let ((bv (port-buffer-bytevector buf)))
(cur (port-buffer-cur buf)))
(define (bad-utf8) (define (bad-utf8)
(let ((len (bad-utf8-len bv cur buffering first-byte))) (let ((len (bad-utf8-len bv cur buffering first-byte)))
(when (zero? len) (error "internal error")) (when (zero? len) (error "internal error"))
(if (eq? (port-conversion-strategy port) 'substitute) (if (eq? (port-conversion-strategy port) 'substitute)
(values #\xFFFD len) (values #\xFFFD buf (+ cur len))
(decoding-error "peek-char" port)))) (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) (define (peek-char-and-next-cur/iso-8859-1 port buf cur first-byte)
(values (integer->char first-byte) 1)) (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 lp ((prev-input-size 0))
(let ((input-size (1+ prev-input-size))) (let ((input-size (1+ prev-input-size)))
(call-with-values (lambda () (fill-input port input-size)) (call-with-values (lambda () (fill-input port input-size))
(lambda (buf buffered) (lambda (buf cur buffered)
(cond (cond
((< buffered input-size) ((< buffered input-size)
;; Buffer failed to fill; EOF, possibly premature. ;; Buffer failed to fill; EOF, possibly premature.
(cond (cond
((zero? prev-input-size) ((zero? prev-input-size)
(values the-eof-object 0)) (values the-eof-object buf cur))
((eq? (port-conversion-strategy port) 'substitute) ((eq? (port-conversion-strategy port) 'substitute)
(values #\xFFFD prev-input-size)) (values #\xFFFD buf (+ cur prev-input-size)))
(else (else
(decoding-error "peek-char" port)))) (decoding-error "peek-char" port))))
((port-decode-char port (port-buffer-bytevector buf) ((port-decode-char port (port-buffer-bytevector buf)
(port-buffer-cur buf) input-size) cur input-size)
=> (lambda (char) => (lambda (char)
(values char input-size))) (values char buf (+ cur input-size))))
(else (else
(lp input-size)))))))) (lp input-size))))))))
(define (peek-char-and-len port) (define (peek-char-and-next-cur port)
(let ((first-byte (peek-byte port))) (define (have-byte buf bv cur buffered)
(if (not first-byte) (let ((first-byte (bytevector-u8-ref bv cur)))
(values the-eof-object 0) (case (%port-encoding port)
(case (%port-encoding port) ((UTF-8)
((UTF-8) (peek-char-and-next-cur/utf8 port buf cur first-byte))
(peek-char-and-len/utf8 port first-byte)) ((ISO-8859-1)
((ISO-8859-1) (peek-char-and-next-cur/iso-8859-1 port buf cur first-byte))
(peek-char-and-len/iso-8859-1 port first-byte)) (else
(else (peek-char-and-next-cur/iconv port)))))
(peek-char-and-len/iconv port first-byte)))))) (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* (peek-char #:optional (port (current-input-port)))
(define (slow-path) (define (slow-path)
(call-with-values (lambda () (peek-char-and-len port)) (call-with-values (lambda () (peek-char-and-next-cur port))
(lambda (char len) (lambda (char buf cur)
char))) char)))
(define (fast-path buf bv cur buffered) (define (fast-path buf bv cur buffered)
(let ((u8 (bytevector-u8-ref bv cur)) (let ((u8 (bytevector-u8-ref bv cur))
@ -532,15 +538,14 @@
(advance-port-position! (port-buffer-position buf) char) (advance-port-position! (port-buffer-position buf) char)
char) char)
(define (slow-path) (define (slow-path)
(call-with-values (lambda () (peek-char-and-len port)) (call-with-values (lambda () (peek-char-and-next-cur port))
(lambda (char len) (lambda (char buf cur)
(let ((buf (port-read-buffer port))) (set-port-buffer-cur! buf cur)
(set-port-buffer-cur! buf (+ (port-buffer-cur buf) len)) (if (eq? char the-eof-object)
(if (eq? char the-eof-object) (begin
(begin (set-port-buffer-has-eof?! buf #f)
(set-port-buffer-has-eof?! buf #f) char)
char) (finish buf char)))))
(finish buf char))))))
(define (fast-path buf bv cur buffered) (define (fast-path buf bv cur buffered)
(let ((u8 (bytevector-u8-ref bv cur)) (let ((u8 (bytevector-u8-ref bv cur))
(enc (%port-encoding port))) (enc (%port-encoding port)))
@ -559,29 +564,29 @@
(lambda (buf bv cur buffered) (slow-path)))) (lambda (buf bv cur buffered) (slow-path))))
(define-inlinable (port-fold-chars/iso-8859-1 port proc seed) (define-inlinable (port-fold-chars/iso-8859-1 port proc seed)
(let fold-buffer ((buf (port-read-buffer port)) (let* ((buf (port-read-buffer port))
(seed seed)) (cur (port-buffer-cur buf)))
(let ((bv (port-buffer-bytevector buf)) (let fold-buffer ((buf buf) (cur cur) (seed seed))
(end (port-buffer-end buf))) (let ((bv (port-buffer-bytevector buf))
(let fold-chars ((cur (port-buffer-cur buf)) (end (port-buffer-end buf)))
(seed seed)) (let fold-chars ((cur cur) (seed seed))
(cond (cond
((= end cur) ((= end cur)
(call-with-values (lambda () (fill-input port)) (call-with-values (lambda () (fill-input port))
(lambda (buf buffered) (lambda (buf cur buffered)
(if (zero? buffered) (if (zero? buffered)
(call-with-values (lambda () (proc the-eof-object seed)) (call-with-values (lambda () (proc the-eof-object seed))
(lambda (seed done?) (lambda (seed done?)
(if done? seed (fold-buffer buf seed)))) (if done? seed (fold-buffer buf cur seed))))
(fold-buffer buf seed))))) (fold-buffer buf cur seed)))))
(else (else
(let ((ch (integer->char (bytevector-u8-ref bv cur))) (let ((ch (integer->char (bytevector-u8-ref bv cur)))
(cur (1+ cur))) (cur (1+ cur)))
(set-port-buffer-cur! buf cur) (set-port-buffer-cur! buf cur)
(advance-port-position! (port-buffer-position buf) ch) (advance-port-position! (port-buffer-position buf) ch)
(call-with-values (lambda () (proc ch seed)) (call-with-values (lambda () (proc ch seed))
(lambda (seed done?) (lambda (seed done?)
(if done? seed (fold-chars cur seed))))))))))) (if done? seed (fold-chars cur seed))))))))))))
(define-inlinable (port-fold-chars port proc seed) (define-inlinable (port-fold-chars port proc seed)
(case (%port-encoding port) (case (%port-encoding port)