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

[Leo Famulari <leo@famulari.name>]

[-- 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 --]