aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-10-11 15:14:16 +0200
committerLudovic Courtès <ludo@gnu.org>2017-10-11 15:20:50 +0200
commit85a2b58987bc32e33e63bea86c1a94496b796ae9 (patch)
treed79a3dc6c8ac09ee27cf15aa487258da1069c2b5
parent5781c7dd27b8d96cef2e54693ca3ac91f69b4bda (diff)
downloadguix-85a2b58987bc32e33e63bea86c1a94496b796ae9.tar
guix-85a2b58987bc32e33e63bea86c1a94496b796ae9.tar.gz
zlib: Fix memory leak due to revealed ports not being GC'd.
Fixes <https://bugs.gnu.org/28784>. 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.
-rw-r--r--guix/zlib.scm39
-rw-r--r--tests/zlib.scm11
2 files changed, 30 insertions, 20 deletions
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))
diff --git a/tests/zlib.scm b/tests/zlib.scm
index f71609b7c5..5455240a71 100644
--- a/tests/zlib.scm
+++ b/tests/zlib.scm
@@ -57,16 +57,7 @@
(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)