From 85a2b58987bc32e33e63bea86c1a94496b796ae9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 11 Oct 2017 15:14:16 +0200 Subject: zlib: Fix memory leak due to revealed ports not being GC'd. Fixes . This mostly reverts 81a0f1cdf12e7bcc34c1203f034a323fa8f52cf5, 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. --- guix/zlib.scm | 39 +++++++++++++++++++++++++++++---------- 1 file changed, 29 insertions(+), 10 deletions(-) (limited to 'guix/zlib.scm') diff --git a/guix/zlib.scm b/guix/zlib.scm index 3d830ef84e..955589ab48 100644 --- a/guix/zlib.scm +++ b/guix/zlib.scm @@ -149,6 +149,31 @@ the number of uncompressed bytes written, a strictly positive integer." ;; 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 @@ buffered input, which would be lost (and is lost anyway)." (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 @@ buffered input, which would be lost (and is lost anyway)." (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 @@ port is closed." (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 @@ port is closed." (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)) -- cgit v1.2.3