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:
Ludovic Courtès 2017-03-15 10:40:51 +01:00
parent bc551cf32b
commit 81a0f1cdf1
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 20 additions and 20 deletions

View File

@ -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))

View File

@ -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)