rewrite ensure-writable-dir to not be racy

* module/system/base/compile.scm (ensure-writable-dir): Rewrite to not
  be racy.

diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 7d46713b272a62479983b1d7aeee17f182660f19..1b6e73f32f066155597a9ba1b5f05be5a6b52e6f 100644 (file)
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -68,16 +68,27 @@
       x
       (lookup-language x)))
 
-;; Throws an exception if `dir' is not writable. The double-stat is OK,
-;; as this is only used during compilation.
+;; Throws an exception if `dir' is not writable.  The mkdir occurs
+;; before the check, so that we avoid races (possibly due to parallel
+;; compilation).
+;;
 (define (ensure-writable-dir dir)
-  (if (file-exists? dir)
-      (if (access? dir W_OK)
-          #t
-          (error "directory not writable" dir))
-      (begin
-        (ensure-writable-dir (dirname dir))
-        (mkdir dir))))
+  (catch 'system-error
+    (lambda ()
+      (mkdir dir))
+    (lambda (k subr fmt args rest)
+      (let ((errno (and (pair? rest) (car rest))))
+        (cond
+         ((eqv? errno EEXIST)
+          (let ((st (stat dir)))
+            (if (or (not (eq? (stat:type st) 'directory))
+                    (not (access? dir W_OK)))
+                (error "directory not writable" dir))))
+         ((eqv? errno ENOENT)
+          (ensure-writable-dir (dirname dir))
+          (ensure-writable-dir dir))
+         (else
+          (throw k subr fmt args rest)))))))
 
 ;;; This function is among the trickiest I've ever written. I tried many
 ;;; variants. In the end, simple is best, of course.