file/untgz: fix race

This commit is contained in:
Matthew Flatt 2013-02-25 06:44:45 -07:00
parent 8c0291e2c6
commit d113e79fb5

View File

@ -25,20 +25,23 @@
call-with-input-file*)
in
(lambda (in)
(define in2
(define-values (in2 wait)
(cond
[(and (= (peek-byte in 0) #o037)
(= (peek-byte in 1) #o213))
(define-values (in2 out) (make-pipe 4096))
(thread
(lambda ()
(dynamic-wind
(lambda () (void))
(lambda () (gunzip-through-ports in out))
(lambda () (close-output-port out)))))
in2]
[else in]))
(untar in2 #:dest dest #:strip-count strip-count #:filter filter))))
(define t
(thread
(lambda ()
(dynamic-wind
(lambda () (void))
(lambda () (gunzip-through-ports in out))
(lambda () (close-output-port out))))))
(values in2 (lambda () (thread-wait t)))]
[else (values in void)]))
(begin0
(untar in2 #:dest dest #:strip-count strip-count #:filter filter)
(wait)))))