zlib: Don't rely on EBADF being ignored by 'fport_close'.
In 2.2, 'fport_close' no longer swallows EBADF and instead raises a 'system-error' for this. This commit adjusts for 2.2. * guix/zlib.scm (close-procedure): Remove. (make-gzip-input-port): Use 'port->fdes' instead of 'fileno'. Use 'gzclose' instead of 'close-procedure'. (make-gzip-output-port): Likewise. * tests/zlib.scm ("compression/decompression pipe"): Don't check whether PARENT is closed using 'port-closed?'. Instead, use 'seek' on the underlying FD and check for EBADF.
This commit is contained in:
parent
bc551cf32b
commit
81a0f1cdf1
@ -149,21 +149,6 @@ the number of uncompressed bytes written, a strictly positive integer."
|
|||||||
;; Z_DEFAULT_COMPRESSION.
|
;; Z_DEFAULT_COMPRESSION.
|
||||||
-1)
|
-1)
|
||||||
|
|
||||||
(define (close-procedure gzfile port)
|
|
||||||
"Return a procedure that closes GZFILE, ensuring its underlying PORT is
|
|
||||||
closed even if closing GZFILE triggers an exception."
|
|
||||||
(lambda ()
|
|
||||||
(catch 'zlib-error
|
|
||||||
(lambda ()
|
|
||||||
;; 'gzclose' closes the underlying file descriptor. 'close-port'
|
|
||||||
;; calls close(2), gets EBADF, which is ignores.
|
|
||||||
(gzclose gzfile)
|
|
||||||
(close-port port))
|
|
||||||
(lambda args
|
|
||||||
;; Make sure PORT is closed despite the zlib error.
|
|
||||||
(close-port port)
|
|
||||||
(apply throw args)))))
|
|
||||||
|
|
||||||
(define* (make-gzip-input-port port #:key (buffer-size %default-buffer-size))
|
(define* (make-gzip-input-port port #:key (buffer-size %default-buffer-size))
|
||||||
"Return an input port that decompresses data read from PORT, a file port.
|
"Return an input port that decompresses data read from PORT, a file port.
|
||||||
PORT is automatically closed when the resulting port is closed. BUFFER-SIZE
|
PORT is automatically closed when the resulting port is closed. BUFFER-SIZE
|
||||||
@ -173,7 +158,11 @@ buffered input, which would be lost (and is lost anyway)."
|
|||||||
(define gzfile
|
(define gzfile
|
||||||
(match (drain-input port)
|
(match (drain-input port)
|
||||||
("" ;PORT's buffer is empty
|
("" ;PORT's buffer is empty
|
||||||
(gzdopen (fileno port) "r"))
|
;; Since 'gzclose' will eventually close the file descriptor beneath
|
||||||
|
;; PORT, we increase PORT's revealed count and never call 'close-port'
|
||||||
|
;; on PORT since we would get EBADF if 'gzclose' already closed it (on
|
||||||
|
;; 2.0 EBADF is swallowed by 'fport_close' but on 2.2 it is raised).
|
||||||
|
(gzdopen (port->fdes port) "r"))
|
||||||
(_
|
(_
|
||||||
;; This is unrecoverable but it's better than having the buffered input
|
;; This is unrecoverable but it's better than having the buffered input
|
||||||
;; be lost, leading to unclear end-of-file or corrupt-data errors down
|
;; be lost, leading to unclear end-of-file or corrupt-data errors down
|
||||||
@ -188,7 +177,8 @@ buffered input, which would be lost (and is lost anyway)."
|
|||||||
(gzbuffer! gzfile buffer-size))
|
(gzbuffer! gzfile buffer-size))
|
||||||
|
|
||||||
(make-custom-binary-input-port "gzip-input" read! #f #f
|
(make-custom-binary-input-port "gzip-input" read! #f #f
|
||||||
(close-procedure gzfile port)))
|
(lambda ()
|
||||||
|
(gzclose gzfile))))
|
||||||
|
|
||||||
(define* (make-gzip-output-port port
|
(define* (make-gzip-output-port port
|
||||||
#:key
|
#:key
|
||||||
@ -200,7 +190,7 @@ port is closed."
|
|||||||
(define gzfile
|
(define gzfile
|
||||||
(begin
|
(begin
|
||||||
(force-output port) ;empty PORT's buffer
|
(force-output port) ;empty PORT's buffer
|
||||||
(gzdopen (fileno port)
|
(gzdopen (port->fdes port)
|
||||||
(string-append "w" (number->string level)))))
|
(string-append "w" (number->string level)))))
|
||||||
|
|
||||||
(define (write! bv start count)
|
(define (write! bv start count)
|
||||||
@ -210,7 +200,8 @@ port is closed."
|
|||||||
(gzbuffer! gzfile buffer-size))
|
(gzbuffer! gzfile buffer-size))
|
||||||
|
|
||||||
(make-custom-binary-output-port "gzip-output" write! #f #f
|
(make-custom-binary-output-port "gzip-output" write! #f #f
|
||||||
(close-procedure gzfile port)))
|
(lambda ()
|
||||||
|
(gzclose gzfile))))
|
||||||
|
|
||||||
(define* (call-with-gzip-input-port port proc
|
(define* (call-with-gzip-input-port port proc
|
||||||
#:key (buffer-size %default-buffer-size))
|
#:key (buffer-size %default-buffer-size))
|
||||||
|
@ -57,7 +57,16 @@
|
|||||||
(match (waitpid pid)
|
(match (waitpid pid)
|
||||||
((_ . status)
|
((_ . status)
|
||||||
(and (zero? status)
|
(and (zero? status)
|
||||||
(port-closed? parent)
|
|
||||||
|
;; PORT itself isn't closed but its underlying file
|
||||||
|
;; descriptor must have been closed by 'gzclose'.
|
||||||
|
(catch 'system-error
|
||||||
|
(lambda ()
|
||||||
|
(seek (fileno parent) 0 SEEK_CUR)
|
||||||
|
#f)
|
||||||
|
(lambda args
|
||||||
|
(= EBADF (system-error-errno args))))
|
||||||
|
|
||||||
(bytevector=? received data))))))))))))
|
(bytevector=? received data))))))))))))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
Loading…
Reference in New Issue
Block a user