zlib: Fix memory leak due to revealed ports not being GC'd.

Fixes <https://bugs.gnu.org/28784>.

This mostly reverts 81a0f1cdf1, which
introduced a regression: revealed ports are *never* GC'd (contrary to
what Guile's manual suggests).

In addition to the revert, 'close-procedure' now explicitly swallows
EBADF errors when 'close-port' is called.

* guix/zlib.scm (close-procedure): New procedure.
(make-gzip-input-port)[gzfile]: Use 'fileno' instead of 'port->fdes'.
Use 'close-procedure' instead of 'gzclose'.
(make-gzip-output-port): Likewise.
* tests/zlib.scm ("compression/decompression pipe"): Use 'port-closed?'
to determine whether PARENT has been closed.
This commit is contained in:
Ludovic Courtès 2017-10-11 15:14:16 +02:00
parent 5781c7dd27
commit 85a2b58987
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 30 additions and 20 deletions

View file

@ -149,6 +149,31 @@ (define %default-compression-level
;; Z_DEFAULT_COMPRESSION.
-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."
(let-syntax ((ignore-EBADF
(syntax-rules ()
((_ exp)
(catch 'system-error
(lambda ()
exp)
(lambda args
(unless (= EBADF (system-error-errno args))
(apply throw args))))))))
(lambda ()
(catch 'zlib-error
(lambda ()
;; 'gzclose' closes the underlying file descriptor. 'close-port'
;; calls close(2) and gets EBADF, which we swallow.
(gzclose gzfile)
(ignore-EBADF (close-port port)))
(lambda args
;; Make sure PORT is closed despite the zlib error.
(ignore-EBADF (close-port port))
(apply throw args))))))
(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.
PORT is automatically closed when the resulting port is closed. BUFFER-SIZE
@ -158,11 +183,7 @@ (define* (make-gzip-input-port port #:key (buffer-size %default-buffer-size))
(define gzfile
(match (drain-input port)
("" ;PORT's buffer is empty
;; 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"))
(gzdopen (fileno port) "r"))
(_
;; 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
@ -177,8 +198,7 @@ (define (read! bv start count)
(gzbuffer! gzfile buffer-size))
(make-custom-binary-input-port "gzip-input" read! #f #f
(lambda ()
(gzclose gzfile))))
(close-procedure gzfile port)))
(define* (make-gzip-output-port port
#:key
@ -190,7 +210,7 @@ (define* (make-gzip-output-port port
(define gzfile
(begin
(force-output port) ;empty PORT's buffer
(gzdopen (port->fdes port)
(gzdopen (fileno port)
(string-append "w" (number->string level)))))
(define (write! bv start count)
@ -200,8 +220,7 @@ (define (write! bv start count)
(gzbuffer! gzfile buffer-size))
(make-custom-binary-output-port "gzip-output" write! #f #f
(lambda ()
(gzclose gzfile))))
(close-procedure gzfile port)))
(define* (call-with-gzip-input-port port proc
#:key (buffer-size %default-buffer-size))

View file

@ -57,16 +57,7 @@ (define-module (test-zlib)
(match (waitpid pid)
((_ . status)
(and (zero? status)
;; 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))))
(port-closed? parent)
(bytevector=? received data))))))))))))
(test-end)