suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

unzip: avoid blocking on break exception

Browse Source 
The `dynamic-wind` that causes problems dos not appear to be needed.

Closes #3703
This commit is contained in:
Matthew Flatt 2021-03-03 08:18:31 -07:00
parent 1e56ca9cc1
commit 71b7f21fdb
2 changed files with 51 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
pkgs/racket-test/tests/file/unzip.rkt
View File

@ -39,7 +39,31 @@
(lambda (skip s evt) (lambda args 'void))
void))
(inflate infinite-voids out))
=error> "non-character in an unsupported context"))
=error> "non-character in an unsupported context")
;; Check that a blocked input port can be interrupted:
(test (let ()
(define zip
(bytes-append
#"PK\3\4\24\0\0\0\b\0\35FbR\237b\371AO\0\0\0x\0\0\0\5\0\34\0x.rkt"
#"UT\t\0\3j^>`l^>`ux\v\0\1\4\365\1\0\0\4\0\0\0\0S\316I\314KW(JL\316N-\321OJ,"
#"N\345\342\322HIM\313\314KU\320HS\250\320\344RP\320\310LS\320(KM."
#"\311/\262W\250P0\4\211\201\200\2066LX7'5/\275$\3\242\34\n0\244`r\352\371"
#"\331@6\0PK\1\2\36\3\24\0\0\0\b\0\35FbR\237b\371AO\0\0\0x\0\0\0\5\0"
#"\30\0\0\0\0\0\1\0\0\0\244\201\0\0\0\0x.rktUT\5\0\3j^>`ux\v\0\1\4\365\1"
#"\0\0\4\0\0\0\0PK\5\6\0\0\0\0\1\0\1\0K\0\0\0\216\0\0\0\0\0"))
(define-values (i o) (make-pipe))
(void (write-bytes (subbytes zip 0 100) o))
(let ([t (thread
(lambda ()
(with-handlers ([exn:break? void])
(call-with-unzip i void))))])
(sync (system-idle-evt))
(break-thread t)
(sync t)
'done))
=> 'done))
(provide tests)
(module+ main (tests))

53
racket/collects/file/unzip.rkt
View File

@ -201,38 +201,35 @@
[in0 (if (bitwise-bit-set? bits 3)
in
(make-limited-input-port in compressed #f))])
(dynamic-wind
void
(lambda ()
(define-values (in t)
(if (zero? compression)
(values in0 #f)
(make-filter-input-port inflate in0)))
(define-values (in t)
(if (zero? compression)
(values in0 #f)
(make-filter-input-port inflate in0)))
(if preserve-timestamps?
(read-entry filename dir? in (and (not dir?)
(msdos-date+time->seconds date time utc?)))
(read-entry filename dir? in))
(if preserve-timestamps?
(read-entry filename dir? in (and (not dir?)
(msdos-date+time->seconds date time utc?)))
(read-entry filename dir? in))
;; Read until the end of the deflated stream when compressed size unknown
(when (bitwise-bit-set? bits 3)
(let loop () (unless (eof-object? (read-bytes 1024 in)) (loop))))
;; Read until the end of the deflated stream when compressed size unknown
(when (bitwise-bit-set? bits 3)
(let loop () (unless (eof-object? (read-bytes 1024 in)) (loop))))
(when t (kill-thread t)))
(when t (kill-thread t))
(lambda ()
;; appnote VI-C : if bit 3 is set, then the file data
;; is immediately followed by a data descriptor
;; appnote 4.3.9.3 : the value 0x08074b50 may appear
;; as a data descriptor signature immediately
;; following the file data
(if (bitwise-bit-set? bits 3)
;; Read possibly signed data descriptor
(let ([maybe-signature (read-int 4)])
(skip-bytes (if (= maybe-signature #x08074b50) 12 8)
in))
(skip-bytes (- (+ mark compressed) (file-position in)) in)))))
(void))))
;; appnote VI-C : if bit 3 is set, then the file data
;; is immediately followed by a data descriptor
;; appnote 4.3.9.3 : the value 0x08074b50 may appear
;; as a data descriptor signature immediately
;; following the file data
(if (bitwise-bit-set? bits 3)
;; Read possibly signed data descriptor
(let ([maybe-signature (read-int 4)])
(skip-bytes (if (= maybe-signature #x08074b50) 12 8)
in))
(skip-bytes (- (+ mark compressed) (file-position in)) in))
(void)))))
;; find-central-directory : input-port nat -> nat nat nat
(define (find-central-directory in size)