From ef86d2ff65de3f7d60233f3bedd4eb8aae89ebd6 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 23 Apr 2015 18:31:22 +0900 Subject: [PATCH] extra error checks for call-with-temp-dir --- lib/chibi/temp-file.scm | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/lib/chibi/temp-file.scm b/lib/chibi/temp-file.scm index 12c59c88..ca7d8bdc 100644 --- a/lib/chibi/temp-file.scm +++ b/lib/chibi/temp-file.scm @@ -26,10 +26,10 @@ res))))))))) (define (call-with-temp-dir template proc) - (let ((base (string-append - "/tmp/" template - "-" (number->string (current-process-id)) "-" - (number->string (exact (round (current-second)))) "-"))) + (let* ((pid (current-process-id)) + (base (string-append + "/tmp/" template "-" (number->string pid) "-" + (number->string (exact (round (current-second)))) "-"))) (let lp ((i 0)) (let ((path (string-append base (number->string i)))) (cond @@ -39,5 +39,9 @@ (lp (+ i 1))) ((create-directory path #o700) (let ((res (proc path))) - (delete-file-hierarchy path) - res))))))) + ;; sanity check for host threading issues and broken forks + (if (equal? pid (current-process-id)) + (delete-file-hierarchy path)) + res)) + (else + (error "failed to create directory" path)))))))