02/06: zlib: Don't rely on EBADF being ignored by 'fport_close'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 81a0f1cdf12e7bcc34c1203f034a323fa8f52cf5
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 15 10:40:51 2017 +0100

    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.
---
 guix/zlib.scm  | 29 ++++++++++-------------------
 tests/zlib.scm | 11 ++++++++++-
 2 files changed, 20 insertions(+), 20 deletions(-)

diff --git a/guix/zlib.scm b/guix/zlib.scm
index 7442012..3d830ef 100644
--- a/guix/zlib.scm
+++ b/guix/zlib.scm
@@ -149,21 +149,6 @@ 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."
-  (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))
   "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
@@ -173,7 +158,11 @@ buffered input, which would be lost (and is lost anyway)."
   (define gzfile
     (match (drain-input port)
       (""                                         ;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
        ;; 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))
 
   (make-custom-binary-input-port "gzip-input" read! #f #f
-                                 (close-procedure gzfile port)))
+                                 (lambda ()
+                                   (gzclose gzfile))))
 
 (define* (make-gzip-output-port port
                                 #:key
@@ -200,7 +190,7 @@ port is closed."
   (define gzfile
     (begin
       (force-output port)                         ;empty PORT's buffer
-      (gzdopen (fileno port)
+      (gzdopen (port->fdes port)
                (string-append "w" (number->string level)))))
 
   (define (write! bv start count)
@@ -210,7 +200,8 @@ port is closed."
     (gzbuffer! gzfile buffer-size))
 
   (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
                                     #:key (buffer-size %default-buffer-size))
diff --git a/tests/zlib.scm b/tests/zlib.scm
index 5455240..f71609b 100644
--- a/tests/zlib.scm
+++ b/tests/zlib.scm
@@ -57,7 +57,16 @@
               (match (waitpid pid)
                 ((_ . 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))))))))))))
 
 (test-end)