bug#32126: call-with-temporary-directory rarely cleans up after itself

bug#32126: call-with-temporary-directory rarely cleans up after itself

[Leo Famulari]

[-- Attachment #1: Type: text/plain, Size: 826 bytes --]

While testing something, I noticed that temporary directories created
with ((guix utils) call-with-temporary-directory) were not being
deleted.

This procedure is documented to delete the directories after execution:

"Call PROC with a name of a temporary directory; close the directory and
delete it when leaving the dynamic extent of this call."

It uses rmdir, which is documented as follows: "Remove the existing
directory named by path. The directory must be empty for this to
succeed." [0]

I think this is a case where one expects the directory to be deleted as
with `rm -rf`, regardless of whether or not it is empty.

Should we alter the call-with-temporary-directory procedure to use
((guix build utils) delete-file-recursively)?

[0]
https://www.gnu.org/software/guile/manual/html_node/File-System.html#index-rmdir

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

bug#32126: call-with-temporary-directory rarely cleans up after itself

[Ludovic Courtès]

Hi Leo,

Leo Famulari <leo@famulari.name> skribis:

> Should we alter the call-with-temporary-directory procedure to use
> ((guix build utils) delete-file-recursively)?

Yes, definitely.  Note that you can alter (guix utils) without fear of a
full rebuild, so you can go ahead and do that in ‘master’.

Thanks,
Ludo’.

bug#32126: call-with-temporary-directory rarely cleans up after itself

[Leo Famulari]

[-- Attachment #1.1: Type: text/plain, Size: 455 bytes --]

Here's a patch that copies the ((guix build utils)
delete-file-recursively) procedure and uses it in ((guix utils)
call-with-temporary-directory).

However, with the patch there is an error in the test 'gexp->script
#:module-path':

------
actual-value: #f
actual-error:
+ (system-error
+   "lstat"
+   "~A: ~S"
+   ("No such file or directory"
+    "/tmp/guix-directory.6CrC8B/guix/base32.scm")
+   (2))
result: FAIL
------

Continuing to investigate...

[-- Attachment #1.2: 0001-utils-Really-clean-up-temporary-directories.patch --]
[-- Type: text/plain, Size: 2846 bytes --]

From e3181f30ca0711e79aab9d71d798344dfb4636b5 Mon Sep 17 00:00:00 2001
From: Leo Famulari <leo@famulari.name>
Date: Wed, 11 Jul 2018 20:24:29 -0400
Subject: [PATCH] utils: Really clean up temporary directories.

* guix/utils.scm (delete-file-recursively): New variable.
(call-with-temporary-directory): Use DELETE-FILE-RECURSIVELY instead of
RMDIR.
---
 guix/utils.scm | 29 ++++++++++++++++++++++++++++-
 1 file changed, 28 insertions(+), 1 deletion(-)

diff --git a/guix/utils.scm b/guix/utils.scm
index f934b6ed1..9e260c90c 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -33,6 +33,7 @@
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-39)
   #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 ftw)
   #:autoload   (rnrs io ports) (make-custom-binary-input-port)
   #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
   #:use-module (guix memoization)
@@ -620,6 +621,32 @@ call."
         (false-if-exception (close out))
         (false-if-exception (delete-file template))))))
 
+;; Copied from (guix build utils)
+(define* (delete-file-recursively dir
+                                  #:key follow-mounts?)
+  "Delete DIR recursively, like `rm -rf', without following symlinks.  Don't
+follow mount points either, unless FOLLOW-MOUNTS? is true.  Report but ignore
+errors."
+  (let ((dev (stat:dev (lstat dir))))
+    (file-system-fold (lambda (dir stat result)    ; enter?
+                        (or follow-mounts?
+                            (= dev (stat:dev stat))))
+                      (lambda (file stat result)   ; leaf
+                        (delete-file file))
+                      (const #t)                   ; down
+                      (lambda (dir stat result)    ; up
+                        (rmdir dir))
+                      (const #t)                   ; skip
+                      (lambda (file stat errno result)
+                        (format (current-error-port)
+                                "warning: failed to delete ~a: ~a~%"
+                                file (strerror errno)))
+                      #t
+                      dir
+
+                      ;; Don't follow symlinks.
+                      lstat)))
+
 (define (call-with-temporary-directory proc)
   "Call PROC with a name of a temporary directory; close the directory and
 delete it when leaving the dynamic extent of this call."
@@ -631,7 +658,7 @@ delete it when leaving the dynamic extent of this call."
       (lambda ()
         (proc tmp-dir))
       (lambda ()
-        (false-if-exception (rmdir tmp-dir))))))
+        (false-if-exception (delete-file-recursively tmp-dir))))))
 
 (define (with-atomic-file-output file proc)
   "Call PROC with an output port for the file that is going to replace FILE.
-- 
2.18.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

bug#32126: call-with-temporary-directory rarely cleans up after itself

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 709 bytes --]

Hello,

Leo Famulari <leo@famulari.name> skribis:

> However, with the patch there is an error in the test 'gexp->script
> #:module-path':
>
> ------
> actual-value: #f
> actual-error:
> + (system-error
> +   "lstat"
> +   "~A: ~S"
> +   ("No such file or directory"
> +    "/tmp/guix-directory.6CrC8B/guix/base32.scm")
> +   (2))
> result: FAIL
> ------

Funny.  That test turned out to work thanks to the brokenness of
‘call-with-temporary-directory’: since it’s a monadic return, the actual
code was executed after we’d left the ‘call-with-temporary-directory’
extent, yet it expected to be able to access files from that temporary
directory.

This change fixes it:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 2712 bytes --]

diff --git a/tests/gexp.scm b/tests/gexp.scm
index 83fe81154..31c7ce22f 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -948,7 +948,7 @@
       (return (and (zero? (close-pipe pipe))
                    (= (expt n 2) (string->number str)))))))
 
-(test-assertm "gexp->script #:module-path"
+(test-assert "gexp->script #:module-path"
   (call-with-temporary-directory
    (lambda (directory)
      (define str
@@ -961,23 +961,24 @@
                         (define-public %fake! ,str))
                 port)))
 
-     (mlet* %store-monad ((exp -> (with-imported-modules '((guix base32))
-                                    (gexp (begin
-                                            (use-modules (guix base32))
-                                            (write (list %load-path
-                                                         %fake!))))))
-                          (drv    (gexp->script "guile-thing" exp
-                                                #:guile %bootstrap-guile
-                                                #:module-path (list directory)))
-                          (out -> (derivation->output-path drv))
-                          (done   (built-derivations (list drv))))
-       (let* ((pipe  (open-input-pipe out))
-              (data  (read pipe)))
-         (return (and (zero? (close-pipe pipe))
-                      (match data
-                        ((load-path str*)
-                         (and (string=? str* str)
-                              (not (member directory load-path))))))))))))
+     (run-with-store %store
+       (mlet* %store-monad ((exp -> (with-imported-modules '((guix base32))
+                                      (gexp (begin
+                                              (use-modules (guix base32))
+                                              (write (list %load-path
+                                                           %fake!))))))
+                            (drv    (gexp->script "guile-thing" exp
+                                                  #:guile %bootstrap-guile
+                                                  #:module-path (list directory)))
+                            (out -> (derivation->output-path drv))
+                            (done   (built-derivations (list drv))))
+         (let* ((pipe  (open-input-pipe out))
+                (data  (read pipe)))
+           (return (and (zero? (close-pipe pipe))
+                        (match data
+                          ((load-path str*)
+                           (and (string=? str* str)
+                                (not (member directory load-path)))))))))))))
 
 (test-assertm "program-file"
   (let* ((n      (random (expt 2 50)))

[-- Attachment #3: Type: text/plain, Size: 557 bytes --]


> From e3181f30ca0711e79aab9d71d798344dfb4636b5 Mon Sep 17 00:00:00 2001
> From: Leo Famulari <leo@famulari.name>
> Date: Wed, 11 Jul 2018 20:24:29 -0400
> Subject: [PATCH] utils: Really clean up temporary directories.
>
> * guix/utils.scm (delete-file-recursively): New variable.
> (call-with-temporary-directory): Use DELETE-FILE-RECURSIVELY instead of
> RMDIR.

Instead of duplicating ‘delete-file-recursively’, you can take it
directly from (guix build utils).  There’s already a #:use-module clause
at the top.

Thanks,
Ludo’.

bug#32126: call-with-temporary-directory rarely cleans up after itself

[Leo Famulari]

[-- Attachment #1: Type: text/plain, Size: 462 bytes --]

On Thu, Jul 12, 2018 at 05:37:18PM +0200, Ludovic Courtès wrote:
> Hi Leo,
> 
> Leo Famulari <leo@famulari.name> skribis:
> 
> > Should we alter the call-with-temporary-directory procedure to use
> > ((guix build utils) delete-file-recursively)?
> 
> Yes, definitely.  Note that you can alter (guix utils) without fear of a
> full rebuild, so you can go ahead and do that in ‘master’.

Great, pushed as 27f7cbc91d1963118e44b14d04fcc669c9618176.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]